-
Notifications
You must be signed in to change notification settings - Fork 14
/
check.R
131 lines (120 loc) · 3.32 KB
/
check.R
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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
#' Check that all dots have been used
#'
#' Automatically sets exit handler to run when function terminates, checking
#' that all elements of `...` have been evaluated. If you use [on.exit()]
#' elsewhere in your function, make sure to use `add = TRUE` so that you
#' don't override the handler set up by `check_dots_used()`.
#'
#' @param action The action to take when the dots have not been used. One of
#' [rlang::abort()], [rlang::warn()], [rlang::inform()] or [rlang::signal()].
#' @param env Environment in which to look for `...` and to set up handler.
#' @export
#' @examples
#' f <- function(...) {
#' check_dots_used()
#' g(...)
#' }
#'
#' g <- function(x, y, ...) {
#' x + y
#' }
#' f(x = 1, y = 2)
#'
#' try(f(x = 1, y = 2, z = 3))
#' try(f(x = 1, y = 2, 3, 4, 5))
check_dots_used <- function(env = parent.frame(), action = abort) {
eval_bare(exit_handler(action), env)
invisible()
}
check_dots <- function(env = parent.frame(), action) {
if (.Call(ellipsis_dots_used, env)) {
return(invisible())
}
proms <- dots(env)
used <- vapply(proms, promise_forced, logical(1))
unused <- names(proms)[!used]
action_dots(
action = action,
message = paste0(length(unused), " components of `...` were not used."),
dot_names = unused,
.subclass = "rlib_error_dots_unused",
)
}
exit_handler <- function(action) {
expr(
on.exit((!!check_dots)(environment(), !!action), add = TRUE)
)
}
#' Check that all dots are unnamed
#'
#' Named arguments in ... are often a sign of misspelled argument names.
#'
#' @inheritParams check_dots_used
#' @param env Environment in which to look for `...`.
#' @export
#' @examples
#' f <- function(..., foofy = 8) {
#' check_dots_unnamed()
#' c(...)
#' }
#'
#' f(1, 2, 3, foofy = 4)
#' try(f(1, 2, 3, foof = 4))
check_dots_unnamed <- function(env = parent.frame(), action = abort) {
proms <- dots(env, auto_name = FALSE)
if (length(proms) == 0) {
return()
}
unnamed <- is.na(names(proms))
if (all(unnamed)) {
return(invisible())
}
named <- names(proms)[!unnamed]
action_dots(
action = action,
message = paste0(length(named), " components of `...` had unexpected names."),
dot_names = named,
.subclass = "rlib_error_dots_named",
)
}
#' Check that dots are unused
#'
#' Sometimes you just want to use `...` to force your users to fully name
#' the details arguments. This function warns if `...` is not empty.
#'
#' @inheritParams check_dots_used
#' @param env Environment in which to look for `...`.
#' @export
#' @examples
#' f <- function(x, ..., foofy = 8) {
#' check_dots_empty()
#' x + foofy
#' }
#'
#' try(f(1, foof = 4))
#' f(1, foofy = 4)
check_dots_empty <- function(env = parent.frame(), action = abort) {
dots <- dots(env)
if (length(dots) == 0) {
return()
}
action_dots(
action = action,
message = "`...` is not empty.",
dot_names = names(dots),
note = "These dots only exist to allow future extensions and should be empty.",
.subclass = "rlib_error_dots_nonempty"
)
}
action_dots <- function(action, message, dot_names, note = NULL, .subclass = NULL, ...) {
message <- paste_line(
message,
"",
"We detected these problematic arguments:",
paste0("* `", dot_names, "`"),
"",
note,
"Did you misspecify an argument?"
)
action(message, .subclass = c(.subclass, "rlib_error_dots"), ...)
}