#' Persistent Package Configuration
#'
#' Store the configuration of your package in the user's platform dependent
#' config file directory. The configuration persists across R sessions,
#' and can also be edited manually. Configuration files are YAML files.
#'
#' @docType package
#' @name conf
#' @importFrom assertthat assert_that
NULL
#' Class for Package Configuration
#'
#' @section Usage:
#' ```
#' cf <- conf$new(package = NULL, file = NULL, lock = NULL,
#' lock_exclusive = TRUE, lock_timeout = 1000)
#'
#' cf$get(key = NULL, default = NULL)
#' cf$set(key, value)
#' cf$delete(key)
#' cf$has(key)
#' cf$get_keys(at = NULL)
#' cf$clear()
#' cf$save(path = NULL, unlock = TRUE)
#' cf$reload()
#' cf$lock(exclusive = TRUE, timeout = Inf)
#' cf$unlock()
#' cf$get_path()
#' cf$print(...)
#' cf$format()
#' ```
#'
#' @section Arguments:
#' * `package`: Package to configure. This cannot be specified together
#' with the `file` argument. The location of the configuration file will
#' be in the platform specific configuration directory, see
#' [rappdirs::user_config_dir()]. Alternatively the `file` argument can be
#' used to specify the configuration file directly.
#' * `file`: Path to the configuration file. This cannot be specified
#' together with the `package` argument.
#' * `lock`: Logical flag, whether to lock the configuration file before
#' opening it. Locking makes sure that no other R process (that uses the
#' `conf` package) will have read or write access to it. If you lock the
#' file, then it is a good idea to unlock it as soon as you don't need it.
#' See also the `lock()` and `unlock()` methods, and the `unlock` argument
#' of the `save()` method.
#' * `lock_exclusive`: Whether to request an exclusive lock. Typically
#' you need an exclusive lock if you intend to modify the configuration
#' file. See more at [filelock::lock()].
#' * `lock_timeout`: Timeout parameter for locking, in milliseconds.
#' * `key`: The key of the record to read or write or delete, etc.
#' It is a string scalar. The key can be nested, use `:` to
#' separate the components. I.e. the key `foo:bar:foobar` denotes the
#' `foobar` element within the `bar` element within the `foo` element.
#' * `default`: The value to return if the specified key does not exist.
#' * `value`: New value of the key. Any R object that can be converted to
#' YAML using the [yaml::as.yaml()] function.
#' * `at`: A key, within which the names of the subkeys are listed.
#' * `path`: Path to save the file to. Defaults to `NULL` which means the
#' path that was used when the object was created.
#' * `unlock`: Logical flag. Whether to unlock the file, after saving.
#' If the file was not locked, then this flag does nothing.
#' * `exclusive`: Whether to create an exclusive lock. See
#' [filelock::lock()]].
#' * `timeout`: Timeout to acquire the lock. See [filelock::lock()].
#' * `...`: Extra arguments, currently ignored. This is ignored to match
#' the signature of `base::print()`.
#'
#' @section Details:
#'
#' `conf$new()` creates a new configuration object. Specify either the
#' name of the package this file belongs to, or the path of the config
#' file directly. You can also lock the file, which is a good idea if you
#' already know that you'll modify it.
#'
#' `cf$get()` queries a record in the config file. By default it returns
#' all configuration data. The YAML data will be converted to an R object
#' via the [yaml::yaml.load_file()] function. Note that this function
#' simplifies lists to vectors, if all elements are of the same type.
#'
#' `cf$set()` sets a record to a new value in the config file. The key
#' of the record can be hierarchical, and missing levels are automatically
#' created. I.e. if the configation file has a `foo` entry, but no
#' `foo:bar` entry, and key is `foo:bar:foobar`, then `bar` and below that
#' `foobar` will be created, within the existing `foo` entry. Note that
#' `cf$set()` only modifies the configuration object, and not the file on
#' disk. Call the `save()` method to modify the file. It is a good idea to
#' lock the file before opening it, if you already know that you would
#' modify it.
#'
#' `cf$delete()` deletes a record. Specifying a non-existant record does
#' nothing. It is allowed to specify a hierarchical key.
#'
#' `cf$has()` decides whether a config file has the given key.
#'
#' `cf$get_keys()` lists the names of the keys within the given key.
#'
#' `cf$clear()` removes everything from the configuration file.
#'
#' `cf$save()` writes the configuration file to the disk. By default
#' the file is unlocked after saving, if it was locked before.
#'
#' `cf$reload()` reloads the configuration.
#'
#' `cf$lock()` locks the configuration file, so other R processes will
#' have no access to it. It is good practice to lock the file immediately
#' when opening it, via the `lock` argument of the initialization. If you
#' use the `lock()` method to lock it later, consider reloading the
#' configation *after* locking it, in case another process has changed
#' it between the previous reading the locking.
#'
#' `cf$unlock()` unlocks a configuration file.
#'
#' `cf$get_path()` returns the path to the configuration file that was
#' specified when creating the `conf` object.
#'
#' `cf$print()` prints the configuration to the screen, in YAML format.
#'
#' `cf$format()` formats and returns the printout of the configuration,
#' in YAML format.
#'
#' @name conf
NULL
#' @export
#' @importFrom R6 R6Class
conf <- R6Class(
"conf",
public = list(
initialize = function(package = NULL, file = NULL, lock = FALSE,
lock_exclusive = TRUE, lock_timeout = 1000)
cf_init(self, private, package, file, lock, lock_exclusive,
lock_timeout),
get = function(key = NULL, default = NULL)
cf_get(self, private, key, default),
set = function(key, value)
cf_set(self, private, key, value),
delete = function(key)
cf_delete(self, private, key),
has = function(key)
cf_has(self, private, key),
get_keys = function(at = NULL)
cf_get_keys(self, private, at),
clear = function()
cf_clear(self, private),
save = function(path = NULL, unlock = TRUE)
cf_save(self, private, path, unlock),
reload = function()
cf_reload(self, private),
lock = function(exclusive = TRUE, timeout = Inf)
cf_lock(self, private, exclusive, timeout),
unlock = function()
cf_unlock(self, private),
get_path = function()
cf_get_path(self, private),
print = function(...)
cf_print(self, private, ...),
format = function()
cf_format(self, private)
),
private = list(
data = NULL, # The current config
path = NULL, # Path to actual file
filelock = NULL # File lock (if locked)
)
)
#' @importFrom yaml yaml.load_file
cf_init <- function(self, private, package, file, lock, lock_exclusive,
lock_timeout) {
assert_that(is_string_or_null(package))
assert_that(is_string_or_null(file))
assert_that(is_flag(lock))
if (!is.null(package) && !is.null(file)) {
stop("Only at most one of ", sQuote(package), " and ", sQuote(file),
"can be given")
}
private$path <- if (!is.null(file)) {
file
} else {
package <- package %||% environmentName(topenv(parent.frame()))
get_package_config_file(package)
}
if (lock) self$lock(exclusive = lock_exclusive, timeout = lock_timeout)
if (file.exists(private$path)) {
private$data <- yaml.load_file(private$path)
} else {
private$data <- list()
}
invisible(self)
}
cf_get <- function(self, private, key, default) {
assert_that(is_string_or_null(key))
if (is.null(key)) return(private$data)
akey <- analyze_key(key, private$data)
if (length(akey$rest)) {
default
} else if (!length(akey$common)) {
private$data
} else {
private$data[[akey$common]]
}
}
#' Set a configuration item
#'
#' First we check common part in the key and the data.
#'
#' ```
#' data key common rest car(rest) cdr(rest) ops
#' ----- --- ------ ---- --------- --------- --------------------
#' a:b:0 a:b a,b [[c(int, c)]] <- value
#' a:b:0 a:b:c a,b c c [[c(int, c)]] <- value
#' a:b:0 a:b:c:d a,b c,d c d [[c(int, c)]] <- d:value
#' a:0 a a [[c(int, c)]] <- value
#' a:0 x x x [[c(int, c)]] <- value
#' a a a [[c(int, a)]] <- value
#' ```
#'
#' Assuming that the tail of the data is a list, all we need to do is
#'
#' ```
#' data[[c(common, head(rest, 1))]] <- deep_list(tail(rest, -1), value)
#' ```
#'
#' where `deep_list` creates a deeply nested list. If `rest` is empty,
#' then we are replacing an existing element in the data list. Otherwise
#' we add a new element to the list at the specified level.
#'
#' @param self Self.
#' @param private Private self.
#' @param key Key to set.
#' @param value Value to set.
#'
#' @keywords internal
#' @importFrom utils head tail
cf_set <- function(self, private, key, value) {
assert_that(is_string(key))
akey <- analyze_key(key, private$data)
## If the element we are adding to is not a list, then we coerce it
## to a list. This is in case we want to add more members to it.
if (length(akey$common) && !is.list(private$data[[akey$common]])) {
private$data[[akey$common]] <- as.list(private$data[[akey$common]])
}
private$data[[c(akey$common, head(akey$rest, 1))]] <-
deep_list(tail(akey$rest, -1), value)
invisible(self)
}
cf_delete <- function(self, private, key) {
assert_that(is_string(key))
key_parts <- get_key_parts(key)
private$data[[key_parts]] <- NULL
invisible(self)
}
cf_has <- function(self, private, key) {
assert_that(is_string(key))
akey <- analyze_key(key, private$data)
length(akey$rest) == 0
}
cf_get_keys <- function(self, private, at) {
assert_that(is_string_or_null(at))
if (is.null(at)) {
as.character(names(private$data))
} else {
at_parts <- get_key_parts(at)
as.character(names(private$data[[at_parts]]))
}
}
cf_clear <- function(self, private) {
private$data <- list()
invisible(self)
}
cf_save <- function(self, private, path, unlock) {
assert_that(is_string_or_null(path))
assert_that(is_flag(unlock))
path <- path %||% private$path
cat(self$format(), file = path)
if (unlock) self$unlock()
invisible(self)
}
cf_reload <- function(self, private) {
private$data <- yaml.load_file(private$path)
invisible(self)
}
#' @importFrom filelock lock unlock
cf_lock <- function(self, private, exclusive, timeout) {
lock_file <- get_lock_name(private$path)
private$filelock <- lock(
lock_file,
exclusive = exclusive,
timeout = timeout
)
if (is.null(private$filelock)) {
e <- structure(
list(
message = paste0("File locking error on ", sQuote(private$path)),
call = sys.call(1)
),
class = c("file_locking_error", "error", "condition")
)
stop(e)
}
invisible(self)
}
cf_unlock <- function(self, private) {
if (!is.null(private$filelock)) unlock(private$filelock)
invisible(self)
}
cf_get_path <- function(self, private) {
private$path
}
cf_print <- function(self, private, ...) {
cat(self$format())
invisible(self)
}
#' @importFrom yaml as.yaml
cf_format <- function(self, private) {
as.yaml(private$data)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.