File: optionally.R

package info (click to toggle)
r-cran-reprex 0.3.0-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 1,424 kB
  • sloc: sh: 13; makefile: 2
file content (72 lines) | stat: -rw-r--r-- 1,789 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
#' Consult an option, then default
#'
#' Arguments that appear like so in the usage:
#' ```
#' f(..., arg = opt(DEFAULT), ...)
#' ```
#' get their value according to this logic:
#' ```
#' user-specified value or, if not given,
#'   getOption("reprex.arg") or if does not exist,
#'     DEFAULT
#' ```
#' It's shorthand for:
#' ```
#' f(..., arg = getOption("reprex.arg", DEFAULT), ...)
#' ```
#' This is not an exported function and should not be called directly.
#'
#' Many of the arguments of [reprex()] use `opt()`. If you don't like the
#' official defaults, override them in your `.Rprofile`. Here's an example for
#' someone who dislikes the "Created by ..." string, always wants session info,
#' prefers to restyle their code, uses a winky face comment string, and likes
#' the tidyverse startup message.
#' ```
#' options(
#'   reprex.advertise = FALSE,
#'   reprex.si = TRUE,
#'   reprex.style = TRUE,
#'   reprex.comment = "#;-)",
#'   reprex.tidyverse_quiet = FALSE
#' )
#' ```
#' @name opt
NULL

optionally <- function(x, opt_name = NA_character_) {
  if (!is.na(opt_name)) {
    attr(x, "opt_name") <- opt_name
  }
  attr(x, "optional") <- TRUE
  x
}

opt <- optionally

arg_option <- function(arg) {
  arg_expr <- enexpr(arg)
  if (!is_symbol(arg_expr)) {
    abort("Internal error: `arg_option()` expects a symbol")
  }

  opt_name <- attr(arg, "opt_name") %||% make_opt_name(as_string(arg_expr))

  if (is_optional(arg)) {
    getOption(opt_name) %||% de_opt(arg)
  } else {
    arg
  }
}

is_optional <- function(x) isTRUE(attr(x, "optional"))

de_opt <- function(x) {
  attr(x, "optional") <- NULL
  attr(x, "opt_name") <- NULL
  x
}

make_opt_name <- function(x) {
  pkg_name <- tryCatch(ns_env_name(), error = function(e) NULL)
  paste(c(pkg_name, x), collapse = ".")
}