1#' Match an argument to a character vector
2#'
3#' @description
4#'
5#' This is equivalent to [base::match.arg()] with a few differences:
6#'
7#' * Partial matches trigger an error.
8#'
9#' * Error messages are a bit more informative and obey the tidyverse
10#'   standards.
11#'
12#' `arg_match()` derives the possible values from the
13#' [caller frame][caller_frame].
14#'
15#' @param arg A symbol referring to an argument accepting strings.
16#' @return The string supplied to `arg`.
17#' @importFrom utils adist
18#' @export
19#' @examples
20#' fn <- function(x = c("foo", "bar")) arg_match(x)
21#' fn("bar")
22#'
23#' # Throws an informative error for mismatches:
24#' try(fn("b"))
25#' try(fn("baz"))
26arg_match <- function(arg, values = NULL) {
27  arg_expr <- enexpr(arg)
28  if (!is_symbol(arg_expr)) {
29    abort("Internal error: `arg_match()` expects a symbol")
30  }
31
32  arg_nm <- as_string(arg_expr)
33
34  if (is_null(values)) {
35    fn <- caller_fn()
36    values <- fn_fmls(fn)[[arg_nm]]
37    values <- eval_bare(values, get_env(fn))
38  }
39  if (!is_character(arg)) {
40    abort(paste0(chr_quoted(arg_nm), " must be a character vector."))
41  }
42  if (length(arg) > 1 && !setequal(arg, values)) {
43    abort(arg_match_invalid_msg(arg_nm, values))
44  }
45
46  arg <- arg[[1]]
47  arg_match0(arg, values, arg_nm)
48}
49
50#' @description
51#' `arg_match0()` is a bare-bones version if performance is at a premium.
52#' It requires a string as `arg` and explicit `values`.
53#' For convenience, `arg` may also be a character vector containing
54#' every element of `values`, possibly permuted.
55#' In this case, the first element of `arg` is used.
56#'
57#' @param values The possible values that `arg` can take.
58#' @param arg_nm The label to be used for `arg` in error messages.
59#' @rdname arg_match
60#' @export
61#' @examples
62#'
63#' # Use the bare-bones version with explicit values for speed:
64#' arg_match0("bar", c("foo", "bar", "baz"))
65#'
66#' # For convenience:
67#' fn1 <- function(x = c("bar", "baz", "foo")) fn3(x)
68#' fn2 <- function(x = c("baz", "bar", "foo")) fn3(x)
69#' fn3 <- function(x) arg_match0(x, c("foo", "bar", "baz"))
70#' fn1()
71#' fn2("bar")
72#' try(fn3("zoo"))
73arg_match0 <- function(arg, values, arg_nm = as_label(substitute(arg))) {
74  .External(rlang_ext_arg_match0, arg, values, environment())
75}
76
77stop_arg_match <- function(arg, values, arg_nm) {
78  msg <- arg_match_invalid_msg(arg_nm, values)
79
80  i_partial <- pmatch(arg, values)
81  if (!is_na(i_partial)) {
82    candidate <- values[[i_partial]]
83  }
84
85  i_close <- adist(arg, values) / nchar(values)
86  if (any(i_close <= 0.5)) {
87    candidate <- values[[which.min(i_close)]]
88  }
89
90  if (exists("candidate")) {
91    candidate <- chr_quoted(candidate, "\"")
92    msg <- paste0(msg, "\n", "Did you mean ", candidate, "?")
93  }
94
95  abort(msg)
96}
97
98arg_match_invalid_msg <- function(arg_nm, values) {
99  msg <- paste0(chr_quoted(arg_nm), " must be one of ")
100  msg <- paste0(msg, chr_enumerate(chr_quoted(values, "\"")), ".")
101  msg
102}
103
104chr_quoted <- function(chr, type = "`") {
105  paste0(type, chr, type)
106}
107chr_enumerate <- function(chr, sep = ", ", final = "or") {
108  n <- length(chr)
109
110  if (n < 2) {
111    return(chr)
112  }
113
114  n <- length(chr)
115  head <- chr[seq_len(n - 1)]
116  last <- chr[length(chr)]
117
118  head <- paste(head, collapse = sep)
119
120  # Write a or b. But a, b, or c.
121  if (n > 2) {
122    paste0(head, sep, final, " ", last)
123  } else {
124    paste0(head, " ", final, " ", last)
125  }
126}
127
128#' Generate or handle a missing argument
129#'
130#' @description
131#'
132#' These functions help using the missing argument as a regular R
133#' object.
134#'
135#' * `missing_arg()` generates a missing argument.
136#'
137#' * `is_missing()` is like [base::missing()] but also supports
138#'   testing for missing arguments contained in other objects like
139#'   lists.
140#'
141#' * `maybe_missing()` is useful to pass down an input that might be
142#'   missing to another function, potentially substituting by a
143#'   default value. It avoids triggering an "argument is missing" error.
144#'
145#'
146#' @section Other ways to reify the missing argument:
147#'
148#' * `base::quote(expr = )` is the canonical way to create a missing
149#'   argument object.
150#'
151#' * `expr()` called without argument creates a missing argument.
152#'
153#' * `quo()` called without argument creates an empty quosure, i.e. a
154#'   quosure containing the missing argument object.
155#'
156#'
157#' @section Fragility of the missing argument object:
158#'
159#' The missing argument is an object that triggers an error if and
160#' only if it is the result of evaluating a symbol. No error is
161#' produced when a function call evaluates to the missing argument
162#' object. This means that expressions like `x[[1]] <- missing_arg()`
163#' are perfectly safe. Likewise, `x[[1]]` is safe even if the result
164#' is the missing object.
165#'
166#' However, as soon as the missing argument is passed down between
167#' functions through an argument, you're at risk of triggering a
168#' missing error. This is because arguments are passed through
169#' symbols. To work around this, `is_missing()` and `maybe_missing(x)`
170#' use a bit of magic to determine if the input is the missing
171#' argument without triggering a missing error.
172#'
173#' `maybe_missing()` is particularly useful for prototyping
174#' meta-programming algorithms in R. The missing argument is a likely
175#' input when computing on the language because it is a standard
176#' object in formals lists. While C functions are always allowed to
177#' return the missing argument and pass it to other C functions, this
178#' is not the case on the R side. If you're implementing your
179#' meta-programming algorithm in R, use `maybe_missing()` when an
180#' input might be the missing argument object.
181#'
182#'
183#' @section Life cycle:
184#'
185#' * `missing_arg()` and `is_missing()` are stable.
186#' * Like the rest of rlang, `maybe_missing()` is maturing.
187#'
188#' @param x An object that might be the missing argument.
189#' @export
190#' @examples
191#' # The missing argument usually arises inside a function when the
192#' # user omits an argument that does not have a default:
193#' fn <- function(x) is_missing(x)
194#' fn()
195#'
196#' # Creating a missing argument can also be useful to generate calls
197#' args <- list(1, missing_arg(), 3, missing_arg())
198#' quo(fn(!!! args))
199#'
200#' # Other ways to create that object include:
201#' quote(expr = )
202#' expr()
203#'
204#' # It is perfectly valid to generate and assign the missing
205#' # argument in a list.
206#' x <- missing_arg()
207#' l <- list(missing_arg())
208#'
209#' # Just don't evaluate a symbol that contains the empty argument.
210#' # Evaluating the object `x` that we created above would trigger an
211#' # error.
212#' # x  # Not run
213#'
214#' # On the other hand accessing a missing argument contained in a
215#' # list does not trigger an error because subsetting is a function
216#' # call:
217#' l[[1]]
218#' is.null(l[[1]])
219#'
220#' # In case you really need to access a symbol that might contain the
221#' # empty argument object, use maybe_missing():
222#' maybe_missing(x)
223#' is.null(maybe_missing(x))
224#' is_missing(maybe_missing(x))
225#'
226#'
227#' # Note that base::missing() only works on symbols and does not
228#' # support complex expressions. For this reason the following lines
229#' # would throw an error:
230#'
231#' #> missing(missing_arg())
232#' #> missing(l[[1]])
233#'
234#' # while is_missing() will work as expected:
235#' is_missing(missing_arg())
236#' is_missing(l[[1]])
237missing_arg <- function() {
238  .Call(rlang_missing_arg)
239}
240
241#' @rdname missing_arg
242#' @export
243is_missing <- function(x) {
244  missing(x) || is_reference(x, quote(expr = ))
245}
246
247#' @rdname missing_arg
248#' @param default The object to return if the input is missing,
249#'   defaults to `missing_arg()`.
250#' @export
251maybe_missing <- function(x, default = missing_arg()) {
252  if (is_missing(x)) {
253    default
254  } else {
255    x
256  }
257}
258