feat: adding option_fn field to option_spec

.github/workflows/check-full.yaml → .github/workflows/check-standard.yaml

@@ -1,9 +1,5 @@
 # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
-#
-# NOTE: This workflow is overkill for most R packages and
-# check-standard.yaml is likely a better choice.
-# usethis::use_github_action("check-standard") will install it.
 on:
   push:
     branches: [main, master]
@@ -12,6 +8,8 @@ on:
 
 name: R-CMD-check
 
+permissions: read-all
+
 jobs:
   R-CMD-check:
     runs-on: ${{ matrix.config.os }}
@@ -23,26 +21,17 @@ jobs:
       matrix:
         config:
           - {os: macos-latest,   r: 'release'}
-
           - {os: windows-latest, r: 'release'}
-          # Use 3.6 to trigger usage of RTools35
-          - {os: windows-latest, r: '3.6'}
-          # use 4.1 to check with rtools40's older compiler
-          - {os: windows-latest, r: '4.1'}
-
           - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
           - {os: ubuntu-latest,   r: 'oldrel-1'}
-          - {os: ubuntu-latest,   r: 'oldrel-2'}
-          - {os: ubuntu-latest,   r: 'oldrel-3'}
-          - {os: ubuntu-latest,   r: 'oldrel-4'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 
@@ -60,3 +49,4 @@ jobs:
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: options
 Title: Simple, Consistent Package Options
-Version: 0.1.0
+Version: 0.1.0.9000
 Authors@R:
     person(
       "Doug",
@@ -38,5 +38,5 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Config/testthat/edition: 3

NEWS.md

@@ -1,3 +1,15 @@
+# options 0.2.0
+
+* Adds an optional `option_fn` parameter to `option_spec`, allowing for the 
+  stored option values to be processed, or to produce side-effects when 
+  accessed. (@dgkf #12)
+
+## Breaking Changes
+
+* The result of `opt_source()` when a value is derived from an environment
+  variable was changed from `"envir"` to `"envvar"` to be more consistent with
+  the rest of the package's messaging about sources. (@dgkf #12)
+
 # options 0.1.0
 
 * Adds various utility functions for modifying options: `opt_set()`, `opt()<-`

R/options_env.R

@@ -28,14 +28,17 @@ get_options_env <- function(env, ...) {
   UseMethod("get_options_env")
 }
 
+#' @name options_env
 get_options_env.options_env <- function(env, ...) {
   env
 }
 
+#' @name options_env
 get_options_env.options_list <- function(env, ...) {
   attr(env, "environment")
 }
 
+#' @name options_env
 get_options_env.default <- function(env, ..., inherits = FALSE) {
   if (!options_initialized(env, inherits = inherits)) {
     init_options_env(env = env)
@@ -75,6 +78,7 @@ as_options_list <- function(x, ...) {
   UseMethod("as_options_list")
 }
 
+#' @name options_env
 as_options_list.options_env <- function(x, ...) {
   res <- structure(as.list(x), class = c("options_list", "list"))
 

R/options_get.R

@@ -5,7 +5,8 @@
 #' @param value A new value for the associated global option
 #' @param default A default value if the option is not set
 #' @param env An environment, namespace or package name to pull options from
-#' @param ... Additional arguments unused
+#' @param ... Additional arguments passed to an optional `option_fn`. See
+#'   [`option_spec()`] for details.
 #'
 #' @param add,after,scope Passed to [on.exit], with alternative defaults.
 #'   `scope` is passed to the [on.exit] `envir` parameter to disambiguate it
@@ -31,16 +32,28 @@ NULL
 #'
 #' @export
 opt <- function(x, default, env = parent.frame(), ...) {
-  optenv  <- get_options_env(as_env(env), inherits = TRUE)
+  optenv <- get_options_env(as_env(env), inherits = TRUE)
   spec <- get_option_spec(x, env = optenv)
 
-  switch(
-    opt_source(spec, env = optenv),
-    "envir"   = spec$envvar_fn(Sys.getenv(spec$envvar_name), spec$envvar_name),
-    "option"  = getOption(spec$option_name),
+  source <- opt_source(spec, env = optenv)
+  value <- switch(source,
+    "envvar" = spec$envvar_fn(Sys.getenv(spec$envvar_name), spec$envvar_name),
+    "option" = getOption(spec$option_name),
     "default" = get_option_default_value(x, optenv),
-    if (missing(default)) stop(sprintf("option '%s' not found.", x))
-    else default
+    if (missing(default)) {
+      stop(sprintf("option '%s' not found.", x))
+    } else {
+      default
+    }
+  )
+
+  spec$option_fn(
+    value,
+    x = x,
+    default = default,
+    env = env,
+    ...,
+    source = source
   )
 }
 
@@ -58,7 +71,9 @@ opt <- function(x, default, env = parent.frame(), ...) {
 #' @export
 opt_set <- function(x, value, env = parent.frame(), ...) {
   spec <- get_option_spec(x, env = as_env(env), inherits = TRUE, ...)
-  if (is.null(spec)) return(invisible(NULL))
+  if (is.null(spec)) {
+    return(invisible(NULL))
+  }
 
   args <- list(value)
   names(args) <- spec$option_name
@@ -84,7 +99,7 @@ opt_set <- function(x, value, env = parent.frame(), ...) {
 #' behaviors.
 #'
 #' @return For [opt_source]; the source that is used for a specific option,
-#'   one of `"option"`, `"envir"` or `"default"`.
+#'   one of `"option"`, `"envvar"` or `"default"`.
 #'
 #' @examples
 #' define_options("Whether execution should emit console output", quiet = FALSE)
@@ -108,13 +123,13 @@ opt_source <- function(x, env = parent.frame()) {
 
   # determine whether option is set in various places
   opt_sources <- list(
-    option  = function(x) x$option_name %in% names(.Options),
-    envir   = function(x) !is.na(Sys.getenv(x$envvar_name, unset = NA)),
+    option = function(x) x$option_name %in% names(.Options),
+    envvar = function(x) !is.na(Sys.getenv(x$envvar_name, unset = NA)),
     default = function(x) !(is.name(x$expr) && nchar(x$expr) == 0)
   )
 
   # TODO: priority possibly configurable per-option in the future
-  sources <- c("option", "envir", "default")
+  sources <- c("option", "envvar", "default")
 
   for (origin in sources) {
     if (opt_sources[[origin]](x)) {
@@ -169,10 +184,8 @@ opts.list <- function(xs, env = parent.frame()) {
     }
 
     old
-
   } else if (list_is_all_unnamed(xs)) {
     as_options_list(env)[as.character(xs)]
-
   } else {
     stop(paste0(
       "lists provided to `opts()` must either have no names, or names for ",
@@ -203,14 +216,13 @@ opts.character <- function(xs, env = parent.frame()) {
 #'     withr::defer(opt_set("option", old))
 #'
 opt_set_local <- function(
-  x,
-  value,
-  env = parent.frame(),
-  ...,
-  add = TRUE,
-  after = FALSE,
-  scope = parent.frame()
-) {
+    x,
+    value,
+    env = parent.frame(),
+    ...,
+    add = TRUE,
+    after = FALSE,
+    scope = parent.frame()) {
   old <- opt_set(x, value, env = env)
   opt_set_call <- as.call(list(quote(opt_set), x, value = old, env = env))
   on_exit_args <- list(opt_set_call, ..., add = add, after = after)

R/options_spec.R

@@ -5,6 +5,49 @@
 #' name, as well as a description. This information defines the operating
 #' behavior of the option.
 #'
+#' @details
+#'
+#' # Processing Functions
+#'
+#' Parameters `option_fn` and `envvar_fn` allow for customizing the way values
+#' are interpreted and processed before being returned by [`opt`] functions.
+#'
+#' ## `envvar_fn`
+#'
+#' When a value is retrieved from an environment variable, the string value
+#' contained in the environment variable is first processed by `envvar_fn`.
+#'
+#' An `envvar_fn` accepts only a single positional argument, and should have a
+#' signature such as:
+#'
+#' ```r
+#' function(value)
+#' ```
+#'
+#' ## `option_fn`
+#'
+#' Regardless of how a value is produced - either retrieved from an environment
+#' variable, option, a stored default value or from a default provided to an
+#' [`opt`] accessor function - it is then further processed by `option_fn`.
+#'
+#' The first argument provided to `option_fn` will always be the retrieved
+#' value. The remaining parameters in the signature should be considered
+#' experimental. In addition to the value, the arguments provided to [`opt()`],
+#' as well as an additional `source` parameter from [`opt_source()`] may be
+#' used.
+#'
+#' **Stable**
+#'
+#' ```
+#' function(value, ...)
+#' ```
+#'
+#' **Experimental**
+#'
+#' ```
+#' function(value, x, default, env, ..., source)
+#' ```
+#'
 #' @param name A string representing the internal name for the option. This is
 #'   the short form `<option>` used within a namespace and relates to, for
 #'   example, `<package>.<option>` global R option.
@@ -23,8 +66,12 @@
 #'   functions which fall back to `option_name_default` and
 #'   `envvar_name_default`, and can be configured using `set_option_name_fn`
 #'   and `set_envvar_name_fn`.
+#' @param option_fn A function to use for processing an option value before
+#'   being returned from the [opt] accessor functions. For further details see
+#'   section "Processing Functions".
 #' @param envvar_fn A function to use for parsing environment variable values.
-#'   Defaults to `envvar_eval_or_raw()`.
+#'   Defaults to `envvar_eval_or_raw()`. For further details see section
+#'   "Processing Functions".
 #' @param quoted A logical value indicating whether the `default` argument
 #'   should be treated as a quoted expression or as a value.
 #' @param eager A logical value indicating whether the `default` argument should
@@ -46,6 +93,7 @@ option_spec <- function(
   desc = NULL,
   option_name = get_option_name_fn(envir),
   envvar_name = get_envvar_name_fn(envir),
+  option_fn = function(value, ...) value,
   envvar_fn = envvar_eval_or_raw(),
   quoted = FALSE,
   eager = FALSE,
@@ -72,6 +120,7 @@ option_spec <- function(
       desc = desc,
       option_name = option_name,
       envvar_name = envvar_name,
+      option_fn = option_fn,
       envvar_fn = envvar_fn,
       envir = envir
     ),
@@ -174,6 +223,8 @@ format_value <- function(x, ..., fmt = NULL) {
   UseMethod("format_value")
 }
 
+#' @method format_value default
+#' @name format_value
 format_value.default <- function(x, ..., fmt = options_fmts()) {
   if (isS4(x))
     UseMethod("format_value", structure(list(), class = "S4"))

R/utils.R

@@ -24,14 +24,17 @@ vcapply <- function(..., FUN.VALUE = character(1L)) {  # nolint object_name_lint
   vapply(..., FUN.VALUE = FUN.VALUE)
 }
 
+#' @keywords internal
 as_env <- function(x) {
   UseMethod("as_env")
 }
 
+#' @keywords internal
 as_env.character <- function(x) {
   getNamespace(x)
 }
 
+#' @keywords internal
 as_env.environment <- function(x) {
   x
 }
@@ -44,10 +47,12 @@ list_is_all_unnamed <- function(x) {
   is.null(names(x)) || all(names(x) == "")
 }
 
+#' @keywords internal
 raise <- function(x, ...) {
   UseMethod("raise")
 }
 
+#' @keywords internal
 raise.character <- function(x, ...) {
   x <- switch(x,
     "print" = , "info" = , "message" = message,
@@ -58,6 +63,7 @@ raise.character <- function(x, ...) {
   raise.function(x, ...)
 }
 
+#' @keywords internal
 raise.function <- function(x, msg, ...) {
   args <- list(msg, ...)