Feature: add opts_list for interoperability with options(),withr (#19)

* feat: add opts_list for interoperability with options(),withr

* fix: check links

* feat: add parameter to configure missing option names behavior

DESCRIPTION

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

NAMESPACE

@@ -1,6 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(as.list,options_env)
+S3method(as_check_names_fn,"function")
+S3method(as_check_names_fn,character)
 S3method(conditionCall,options_error)
 S3method(define_option,character)
 S3method(define_option,option_spec)
@@ -43,6 +45,7 @@ export(opt_source)
 export(option_name_default)
 export(option_spec)
 export(opts)
+export(opts_list)
 export(set_envvar_name_fn)
 export(set_option_name_fn)
 importFrom(utils,capture.output)

NEWS.md

@@ -1,3 +1,9 @@
+# options 0.3.0
+
+* Introduces `opts_list()`, a utility for producing a list of option values with
+  appropriate global option names that can be used more readily with 
+  `options()` and `withr::with_options()`. (@dgkf #19)
+
 # options 0.2.0
 
 * Fixes `opts()`, which would previously return default values after being

R/naming.R

@@ -155,3 +155,46 @@ envvar_name_generic <- function(package, option) {
   parts <- c(package, option)
   paste(gsub("[^A-Z0-9]", "_", toupper(parts)), collapse = "_")
 }
+
+
+as_check_names_fn <- function(x) {
+  UseMethod("as_check_names_fn")
+}
+
+#' @export
+as_check_names_fn.character <- function(x) {
+  switch(
+    x[[1]],
+    "warn" = check_names_warn_missing,
+    "error" = check_names_stop_missing,
+    "asis" = identity
+  )
+}
+
+#' @export
+as_check_names_fn.function <- function(x) {
+  x
+}
+
+check_names_warn_missing <- function(optnames, env = parent.frame()) {
+  valid <- names(get_options_spec(env))
+  if (length(miss <- setdiff(optnames, valid)) > 0) {
+    warning(
+      "Option name(s) not found in environment: ",
+      paste0("'", miss, "'", collapse = ", ")
+    )
+  }
+}
+
+check_names_stop_missing <- function(optnames, env = parent.frame()) {
+  valid <- names(get_options_spec(env))
+  if (length(miss <- setdiff(optnames, valid)) > 0) {
+    stop(
+      "Option name(s) not found in environment: ",
+      paste0("'", miss, "'", collapse = ", ")
+    )
+  }
+}
+
+check_names_asis <- function(optnames, env = parent.frame()) {
+}

R/options_get.R

@@ -5,8 +5,14 @@
 #' @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 passed to an optional `option_fn`. See
-#'   [`option_spec()`] for details.
+#' @param ... See specific functions to see behavior.
+#' @param opts A `list` of values, for use in functions that accept `...`
+#'   arguments. In rare cases where your argument names conflict with other
+#'   named arguments to these functions, you can specify them directly using
+#'   this parameter.
+#' @param check_names (experimental) A behavior used when checking option
+#'   names against specified options. Expects one of `"asis"`, `"warn"` or
+#'   `"stop"`.
 #'
 #' @param add,after,scope Passed to [on.exit], with alternative defaults.
 #'   `scope` is passed to the [on.exit] `envir` parameter to disambiguate it
@@ -19,7 +25,8 @@ NULL
 
 #' @describeIn opt
 #'
-#' Retrieve an option
+#' Retrieve an option. Additional `...` arguments passed to an optional
+#' `option_fn`. See [`option_spec()`] for details.
 #'
 #' @return For `opt()` and `opts()`; the result of the option (or a list of
 #'   results), either the value from a global option, the result of processing
@@ -61,7 +68,8 @@ opt <- function(x, default, env = parent.frame(), ...) {
 
 #' @describeIn opt
 #'
-#' Set an option's value
+#' Set an option's value. Additional `...` arguments passed to
+#' [`get_option_spec()`].
 #'
 #' @param value A new value to update the associated global option
 #'
@@ -84,7 +92,7 @@ opt_set <- function(x, value, env = parent.frame(), ...) {
 
 #' @describeIn opt
 #'
-#' An alias for [opt_set]
+#' An alias for [`opt_set()`]
 #'
 #' @export
 `opt<-` <- function(x, ..., value) {
@@ -208,17 +216,21 @@ opts.character <- function(xs, env = parent.frame()) {
 
 #' @describeIn opt
 #'
-#' Set an option only in the local frame
+#' Set an option only in the local frame. Additional `...` arguments passed to
+#' [`on.exit()`].
 #'
 #' @note
 #' Local options are set with [on.exit], which can be prone to error if
 #' subsequent calls are not called with `add = TRUE` (masking existing
 #' [on.exit] callbacks). A more rigorous alternative might make use of
-#' [withr::defer].
+#' [`withr::defer`].
 #'
 #'     old <- opt_set("option", value)
 #'     withr::defer(opt_set("option", old))
 #'
+#' If you'd prefer to use this style, see [`opts_list()`], which is designed
+#' to work nicely with \code{\link[withr]{withr}}.
+#'
 opt_set_local <- function(
     x,
     value,
@@ -233,3 +245,48 @@ opt_set_local <- function(
   do.call(base::on.exit, on_exit_args, envir = scope)
   invisible(old)
 }
+
+
+#' @describeIn opt
+#'
+#' Produce a named list of namespaced option values, for use with [`options()`]
+#' and \code{\link[withr]{withr}}. Additional `...` arguments used to provide
+#' named option values.
+#'
+#' @examples
+#' define_options("print quietly", quiet = TRUE)
+#'
+#' print.example <- function(x, ...) if (!opt("quiet")) NextMethod()
+#' example <- structure("Hello, World!", class = "example")
+#' print(example)
+#'
+#' # using base R options to manage temporary options
+#' orig_opts <- options(opts_list(quiet = FALSE))
+#' print(example)
+#' options(orig_opts)
+#'
+#' @examplesIf length(find.package("withr")) > 0L
+#' # using `withr` to manage temporary options
+#' withr::with_options(opts_list(quiet = FALSE), print(example))
+#'
+#' @export
+opts_list <- function(
+  ...,
+  env = parent.frame(),
+  check_names = c("asis", "warn", "error"),
+  opts = list(...)
+) {
+  env <- get_options_env(as_env(env), inherits = TRUE)
+  spec <- get_options_spec(env)
+
+  as_check_names_fn(check_names)(names(opts))
+  names(opts) <- vcapply(names(opts), function(name) {
+    if (name %in% names(spec)) {
+      spec[[name]]$option_name
+    } else {
+      name
+    }
+  })
+
+  opts
+}

tests/testthat/test-opts_list.R

@@ -0,0 +1,51 @@
+test_that("opts_list produces an option of namespaced option names", {
+  e <- new.env(parent = baseenv())
+
+  expect_silent(with(e, options::define_options(
+    "option quiet",
+    quiet = TRUE
+  )))
+
+  l <- expect_silent(with(e, options::opts_list(quiet = FALSE)))
+
+  expect_match(names(l), ".+\\.quiet")
+  expect_type(l, "list")
+  expect_equal(l[[1]], FALSE)
+})
+
+test_that("opts_list returns raw name if not part of namespaced option spec", {
+  e <- new.env(parent = baseenv())
+  expect_silent(with(e, options::define_options(
+    "option quiet",
+    quiet = TRUE
+  )))
+
+  l <- expect_silent(with(e, options::opts_list(quiet = FALSE, max.print = 10)))
+
+  expect_match(names(l)[[1]], ".+\\.quiet")
+  expect_true("max.print" %in% names(l))
+})
+
+test_that("opts_list emit warnings when names missing with check_names warn", {
+  e <- new.env(parent = baseenv())
+  expect_silent(with(e, options::define_options(
+    "option quiet",
+    quiet = TRUE
+  )))
+
+  expect_warning(with(e, {
+    options::opts_list(quiet = FALSE, max.print = 10, check_names = "warn")
+  }))
+})
+
+test_that("opts_list emit error when names missing with check_names stop", {
+  e <- new.env(parent = baseenv())
+  expect_silent(with(e, options::define_options(
+    "option quiet",
+    quiet = TRUE
+  )))
+
+  expect_error(with(e, {
+    options::opts_list(quiet = FALSE, max.print = 10, check_names = "stop")
+  }))
+})