Write up options options

[hadley]

# Problems to solve:
# 1. Getting values:
#    1. Consistent naming scheme that pairs well with auto-complete
#    2. Defines a default value in one place
#    3. Provides fallback to deprecated options (possibly in other packages)
#    4. Can vary defaults (e.g. quiet in tests)
#    5. Messages user about important defaults
#    6. Can use env vars if needed
# 2. Setting values:
#    1. Consistent naming scheme that pairs well with auto-complete
#    2. Should be able to generate deprecation warnings
#    3. Helpers to reduce need for custom `local_`/`with_` wrappers
# 3. Documentation
#    1. Document options where they're used
#    2. Provide a central list of all options for a package

# Get only ----------------------------------------------------------------
# This is the current state of the art

option_foo <- function() {
  getOption("package_foo", 10)
}

option_foo()
options(package_foo = 10)


# Complex getters ---------------------------------------------------------
# Some examples of where our option getters do more work

# Fallback to deprecated option in same package
option_foo <- function() {
  getOption("package_foo") %||% getOption("package_old") %||% 10
}
# Fallback to deprecated option in different package
option_foo <- function() {
  getOption("package_foo") %||% getOption("other_foo") %||% 10
}
# Deprecate this option
option_foo <- function() {
  lifecycle::deprecate_warn("1.0.0", "option_foo()", "option_bar()")
  getOption("package_foo", 10)
}
# Also look in an env var
option_foo <- function() {
  getOption("package_foo") %||% get_env("PACKAGE_FOO") %||% 10
}
# Vary option in tests
option_foo <- function() {
  if (is_testing()) {
    getOption("package_foo", 0)
  } else {
    getOption("package_foo", 10)
  }
}
# Inform user that we're using a default
option_foo <- function() {
  default <- 10
  if (!has_option("package_foo")) {
    inform("Using `package_foo` option with default of {default}")
  }
  getOption("package_foo", default)
}

# Get + set ----------------------------------------------------------------
# I don't know if we've done this anywhere but any obvious next step
# would be to also provide a function for setting the option.

option_foo_get <- function() {
  getOption("package_foo", 10)
}
option_foo_set <- function(val) {
  invisible(options(package_foo = val)$package_foo)
}

option_foo_get()
option_foo_set(10)

# Since _get() called more often could consider breaking symmetry
# and calling it option_foo().

# Can't do this because there has to be an argument
option_foo() <- 20

# One function to get and set ---------------------------------------------

option_foo <- function(val) {
  if (missing(val)) {
    getOption("package_foo", 10)
  } else {
    options(package_foo = val)
  }
}
option_foo()
option_foo(20)

# Could organise multiple options into a list - list name MUST include
# package name to avoid too frequent clashes. Could also consider
# options_package since that would autocomplete from options.

package_options <- list(
  foo = function(val) {
    if (missing(val)) {
      getOption("package_foo", 10)
    } else {
      options(package_foo = val)
    }
  }
)
package_options$foo()
package_options$foo(20)

# Active bindings ---------------------------------------------------------

makeActiveBinding("option_foo", function(val) {
  if (missing(val)) {
    getOption("package_foo", 10)
  } else {
    options(package_foo = val)
    # Has to return value so x <- y <- z isn't surprising
    invisible(val)
  }
}, globalenv())

option_foo
option_foo <- 20

# https://github.com/r-lib/withr/issues/87
local_bindings(option_foo = 20)
with_bindings(option_foo = 20, option_foo)

# I'm assuming it works like
old <- option_foo
on.exit(option_foo <- old)
body
# Bit if of misuse of local_bindings

local_options(options_foo = 10, {
  print(option_foo)
})


local_options(pkg::options$foo = 10, {
  print(option_foo)
})


# Could arrange active bindings into an environment

package_options <- new_environment()
env_bind_active(package_options,
  foo = function(val) {
    if (missing(val)) {
      getOption("package_foo", 10)
    } else {
      options(package_foo = val)
      # Has to return value so x <- y <- z isn't surprising
      invisible(val)
    }
  }
)
package_options$foo
package_options$foo <- 20

with_option("rlang", foo = 20, bar = 20, {
  rlang_options$foo + rlang_options$bar
})