readme.md

XXX establishes a common way to store and retrieve values across runs of an R package. This makes it easy to configure a package once for a user and continue to use the same settings afterwards.

A typical use case (inside a package), might look like:

s <- settings("my_settings.rdata")
s$set("a", 1)
s$get("a")
# [1] 1

# New R session
s <- settings("my_settings.rdata")
s$get("a") 
# [1] 1

You can also specify an application name, which allows XXX to also look in look in environmental variables (env vars) and R options. Note that settings stored in an env var will always be returned as a string (length 1 character vector).

# These would usually be done outside of R by the user
options(myapp_b = 2)
Sys.setenv("MYAPP_C" = 3)

s <- settings("my_settings.rdata", "myapp")
s$get("b")
# [1] "2"
s$get("c")
# [1] "3"

s$set("b", 1)
s$get("b")
# [1] 2
# Warning message: Setting b found in multiple 
# locations: opts, store. Using setting found in opts 

Backing stores

XXX offers three on-disk backing stores

• dcf, the debian control format, like the package DESCRIPTION file, which may only store character vectors of length one

• json, which may only store atomic vectors and lists of atomic vectors.

• rds, which may store anything

XXX also offers the transient backing store which does not persist across sessions and may store anything.

If you want to implement another backing store using a different file type, it's fairly straightforward. You just need to implement a reference class with save, load, and check_type functions. See the source code for more details.

Methods

Each backing store implements three methods:

• $set(name, value)

• $get(name, default)

• $has_key(name)

Other locations

As well as looking in the defined backing store, XXX will also look in environmental variables and package options. This is provides a standard way of using these locations across packages, and will hopefully make it easier for users.

To look in these locations, you must also provide an appname for the backing store. This ensures that each package can have it's own option namespace without worrying about conflicting with values stored by other packages. If the application is called App and setting is Name, then XXX will look for the option app_name (all lower case), and the env var APP_NAME (all upper case, although this only matters on linux).

If a value is found in multiple locations, XXX will produce a warning, and pick one based in order of environmental variable, global option and setting value. This order may change based on user feedback.

store.r

# s <- settings("my/store/here.rdata")
# s <- settings("my/store/here.json")
# s <- settings("my/store/settings.dcf")
# s <- settings("my/store/SETTINGS", type = "dcf")
# s <- settings("my/store/here.rdata", "mturk")

#' @importFrom tools file_ext
settings <- function(path = NULL, appname = NULL, type = NULL) {
  if (is.null(path)) {
    return(TransientSettings$new(appname))
  }
  
  if (is.null(type)) {
    type <- file_ext(path)
  }
  
  type <- paste(toupper(substr(type, 1, 1)), tolower(substr(type, 2, 100L)),
    sep = "")
  obj <- paste(type, "Settings", sep = "")
  
  if (!exists(obj, globalenv())) {
    stop("No backing store of type ", type, " defined.", call. = FALSE)
  }
  
  get(obj, globalenv())$new(path, appname)
}

Settings <- setRefClass("Settings", 
  fields = c("data", "path", "appname"),
  methods = list(
    initialize = function(path_ = NULL, appname_ = NULL) {
      path <<- path_
      appname <<- appname_
      
      if (!is.null(path) && file.exists(path)) {
        .self$load()
      } else {
        data <<- new.env(parent = emptyenv())
      }
    },
    get = function(name, default = NULL) {
      values <- list()
      if (!is.null(appname)) {
        # Look in environmental variables & options
        full_name <- paste(appname, name, sep = "_")

        values$env <- get_env(toupper(full_name))
        values$opts <- getOption(tolower(full_name))
      }
      
      if (has_key(name)) {
        values$store <- data[[name]]
      }
      
      if (length(values) == 0) {
        return(default)
      }

      if (length(values) > 1) {
        warning("Setting ", name, " found in multiple locations: ", 
          paste(names(values), collapse = ", "), ". Using setting ", 
          "found in ", names(values)[[1]], call. = FALSE)
      }
      values[[1]]
    },
    set = function(name, value) {
      .self$check_type(value)
      data[[name]] <<- value
      .self$save()
    },
    has_key = function(name) {
      exists(name, data)
    }
  )
)

RdsSettings <- setRefClass("RdsSettings", 
  contains = "Settings",
  methods = list(
    save = function() {
      saveRDS(data, path)
    }, 
    load = function() {
      data <<- readRDS(path)
    },
    check_type = function(value) {
    }
  )
)

TransientSettings <- setRefClass("TransientSettings",
  contains = "Settings",
  methods = list(
    initialize = function(appname_ = NULL) {
      appname <<- appname_
      data <<- new.env(parent = emptyenv())
    },
    save = function() {},
    load = function() {},
    check_type = function() {}
  )
)

#' @importFrom RJSONIO toJSON fromJSON
JsonSettings <- setRefClass("JsonSettings", 
  contains = "Settings",
  methods = list(
    save = function() {
      out <- toJSON(data)
      writeLines(out, path)
    }, 
    load = function() {
      data <<- fromJSON(path)
    },
    check_type = function(value) {
      if (is.list(value)) {
        all(vapply(value, check_type, logical(1)))
      } else {
        if (!is.atomic(value)) {
          stop("Can only store atomic vectors and lists of atomic vectors", 
            call. = FALSE)
        }
      }
      TRUE
    }
  )
)

DcfSettings <- setRefClass("DcfSettings", 
  contains = "Settings",
  methods = list(
    save = function() {
      write.dcf(data, path)
    }, 
    load = function() {
      data <<- as.list(read.dcf(path)[1, ])
    },
    check_type = function(value) {
      ok <- is.character(value) && length(value) == 1
      if (!ok) {
        stop("Can only store character vectors of length 1", call. = FALSE)
      }
    }
  )
)


get_env <- function(name) {
  value <- Sys.getenv(name)
  if (value == "") NULL else value
}