Throw classed error if allow_empty = FALSE (#350)

And add more context to error message with `error_arg` arguments.
r-lib · Oct 23, 2024 · e4190a9 · e4190a9
1 parent 3ad00d7
commit e4190a9
Show file tree

Hide file tree

Showing 14 changed files with 137 additions and 30 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -33,3 +33,7 @@ export(where)
 export(with_vars)
 import(rlang)
 importFrom(glue,glue)
+importFrom(rlang,enquo)
+importFrom(rlang,quo)
+importFrom(rlang,quo_name)
+importFrom(rlang,quos)
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,12 @@
 # tidyselect (development version)
 
+* `eval_select(allow_empty = FALSE)` gains a new argument to yield a better error
+  message in case of empty selection (@olivroy, #327)
+
+* `eval_select()` and `eval_relocate()` gain a new `error_arg` argument that can be specified to throw a better error message when `allow_empty = FALSE`.
+
+* `eval_select()` and `eval_relocate()` throw a classed error message when `allow_empty = FALSE` (@olivroy, #347).
+
 # tidyselect 1.2.1
 
 * Performance improvements (#337, #338, #339, #341)

diff --git a/R/eval-relocate.R b/R/eval-relocate.R
@@ -68,6 +68,7 @@ eval_relocate <- function(expr,
                           allow_rename = TRUE,
                           allow_empty = TRUE,
                           allow_predicates = TRUE,
+                          error_arg = NULL,
                           before_arg = "before",
                           after_arg = "after",
                           env = caller_env(),
@@ -78,7 +79,6 @@ eval_relocate <- function(expr,
   data <- tidyselect_data_proxy(data)
 
   expr <- as_quosure(expr, env = env)
-
   sel <- eval_select_impl(
     x = data,
     names = names(data),
@@ -89,6 +89,7 @@ eval_relocate <- function(expr,
     allow_empty = allow_empty,
     allow_predicates = allow_predicates,
     type = "relocate",
+    error_arg = error_arg, 
     error_call = error_call
   )
 
@@ -122,7 +123,8 @@ eval_relocate <- function(expr,
         env = env,
         error_call = error_call,
         allow_predicates = allow_predicates,
-        allow_rename = FALSE
+        allow_rename = FALSE,
+        error_arg = before_arg
       ),
       arg = before_arg,
       error_call = error_call
@@ -143,7 +145,8 @@ eval_relocate <- function(expr,
         env = env,
         error_call = error_call,
         allow_predicates = allow_predicates,
-        allow_rename = FALSE
+        allow_rename = FALSE,
+        error_arg = after_arg
       ),
       arg = after_arg,
       error_call = error_call

diff --git a/R/eval-select.R b/R/eval-select.R
@@ -43,6 +43,9 @@
 #'   use predicates (i.e. in `where()`). If `FALSE`, will error if `expr` uses a
 #'   predicate. Will automatically be set to `FALSE` if `data` does not
 #'   support predicates (as determined by [tidyselect_data_has_predicates()]).
+#' @param error_arg Argument names for `expr`. These
+#'   are used in error messages. (You can use `"..."` if `expr = c(...)`).
+#'   For now, this is used when `allow_empty = FALSE`.
 #' @inheritParams rlang::args_dots_empty
 #'
 #' @return A named vector of numeric locations, one for each of the
@@ -103,6 +106,12 @@
 #' # Note that the trick above works because `expr({{ arg }})` is the
 #' # same as `enquo(arg)`.
 #'
+#' # Supply `error_arg` to improve the error message in case of
+#' # unexpected empty selection:
+#' select_not_empty <- function(x, cols) {
+#'   eval_select(expr = enquo(cols), data = x, allow_empty = FALSE, error_arg = "cols")
+#' }
+#' try(select_not_empty(mtcars, cols = starts_with("vs2")))
 #'
 #' # The evaluators return a named vector of locations. Here are
 #' # examples of using these location vectors to implement `select()`
@@ -131,6 +140,7 @@ eval_select <- function(expr,
                         allow_rename = TRUE,
                         allow_empty = TRUE,
                         allow_predicates = TRUE,
+                        error_arg  = NULL,
                         error_call = caller_env()) {
   check_dots_empty()
 
@@ -148,6 +158,7 @@ eval_select <- function(expr,
     allow_rename = allow_rename,
     allow_empty = allow_empty,
     allow_predicates = allow_predicates,
+    error_arg = error_arg,
     error_call = error_call,
   )
 }
@@ -163,6 +174,7 @@ eval_select_impl <- function(x,
                              allow_rename = TRUE,
                              allow_empty = TRUE,
                              allow_predicates = TRUE,
+                             error_arg = NULL,
                              type = "select",
                              error_call = caller_env()) {
   if (!is_null(x)) {
@@ -190,6 +202,7 @@ eval_select_impl <- function(x,
       allow_empty = allow_empty,
       allow_predicates = allow_predicates,
       type = type,
+      error_arg = error_arg,
       error_call = error_call
     ),
     type = type

diff --git a/R/eval-walk.R b/R/eval-walk.R
@@ -8,12 +8,13 @@ vars_select_eval <- function(vars,
                              allow_empty = TRUE,
                              allow_predicates = TRUE,
                              type = "select",
+                             error_arg = NULL,
                              error_call) {
   wrapped <- quo_get_expr2(expr, expr)
 
   if (is_missing(wrapped)) {
     pos <- named(int())
-    check_empty(pos, allow_empty, call = error_call)
+    check_empty(pos, allow_empty, error_arg, call = error_call)
     return(pos)
   }
 
@@ -35,6 +36,7 @@ vars_select_eval <- function(vars,
       uniquely_named = uniquely_named,
       allow_rename = allow_rename,
       allow_empty = allow_empty,
+      error_arg = error_arg,
       call = error_call
     )
     return(pos)
@@ -93,6 +95,7 @@ vars_select_eval <- function(vars,
     uniquely_named = uniquely_named,
     allow_rename = allow_rename,
     allow_empty = allow_empty,
+    error_arg = error_arg,
     call = error_call
   )
 }
@@ -102,8 +105,9 @@ ensure_named <- function(pos,
                          uniquely_named = FALSE,
                          allow_rename = TRUE,
                          allow_empty = TRUE,
+                         error_arg = NULL,
                          call = caller_env()) {
-  check_empty(pos, allow_empty, call = call)
+  check_empty(pos, allow_empty, error_arg, call = call)
 
   if (!allow_rename && any(names2(pos) != "")) {
     cli::cli_abort(
@@ -125,9 +129,21 @@ ensure_named <- function(pos,
   pos
 }
 
-check_empty <- function(x, allow_empty = TRUE, call = caller_env()) {
+check_empty <- function(x, allow_empty = TRUE, error_arg = NULL, call = caller_env()) {
   if (!allow_empty && length(x) == 0) {
-    cli::cli_abort("Must select at least one item.", call = call)
+    if (is.null(error_arg)) {
+      cli::cli_abort(
+        "Must select at least one item.",
+        call = call,
+        class = "tidyselect_error_empty_selection"
+      )
+    } else {
+      cli::cli_abort(
+        "{.arg {error_arg}} must select at least one column.",
+        call = call,
+        class = "tidyselect_error_empty_selection"
+        )
+    }
   }
 }
 

diff --git a/R/utils.R b/R/utils.R
@@ -8,6 +8,7 @@ select_loc <- function(x,
                        allow_rename = TRUE,
                        allow_empty = TRUE,
                        allow_predicates = TRUE,
+                       error_arg = NULL,
                        error_call = current_env()) {
   check_dots_empty()
 
@@ -21,6 +22,7 @@ select_loc <- function(x,
     allow_rename = allow_rename,
     allow_empty = allow_empty,
     allow_predicates = allow_predicates,
+    error_arg = error_arg,
     error_call = error_call
   )
 }
@@ -51,6 +53,7 @@ relocate_loc <- function(x,
                          name_spec = NULL,
                          allow_rename = TRUE,
                          allow_empty = TRUE,
+                         error_arg = NULL,
                          before_arg = "before",
                          after_arg = "after",
                          error_call = current_env()) {
@@ -65,6 +68,7 @@ relocate_loc <- function(x,
     name_spec = name_spec,
     allow_rename = allow_rename,
     allow_empty = allow_empty,
+    error_arg = error_arg,
     before_arg = before_arg,
     after_arg = after_arg,
     error_call = error_call

diff --git a/man/eval_relocate.Rd b/man/eval_relocate.Rd
diff --git a/man/eval_select.Rd b/man/eval_select.Rd
diff --git a/man/faq-external-vector.Rd b/man/faq-external-vector.Rd
diff --git a/man/faq-selection-context.Rd b/man/faq-selection-context.Rd
diff --git a/tests/testthat/_snaps/eval-relocate.md b/tests/testthat/_snaps/eval-relocate.md
@@ -82,21 +82,34 @@
 # can forbid empty selections
 
     Code
-      (expect_error(relocate_loc(x, allow_empty = FALSE)))
+      (expect_error(relocate_loc(x, allow_empty = FALSE, error_arg = "...")))
     Output
-      <error/rlang_error>
+      <error/tidyselect_error_empty_selection>
       Error in `relocate_loc()`:
-      ! Must select at least one item.
+      ! `...` must select at least one column.
     Code
       (expect_error(relocate_loc(mtcars, integer(), allow_empty = FALSE)))
     Output
-      <error/rlang_error>
+      <error/tidyselect_error_empty_selection>
       Error in `relocate_loc()`:
       ! Must select at least one item.
     Code
       (expect_error(relocate_loc(mtcars, starts_with("z"), allow_empty = FALSE)))
     Output
-      <error/rlang_error>
+      <error/tidyselect_error_empty_selection>
+      Error in `relocate_loc()`:
+      ! Must select at least one item.
+
+---
+
+    Code
+      relocate_loc(mtcars, before = integer(), allow_empty = FALSE)
+    Condition <tidyselect_error_empty_selection>
+      Error in `relocate_loc()`:
+      ! Must select at least one item.
+    Code
+      relocate_loc(mtcars, starts_with("z"), allow_empty = FALSE)
+    Condition <tidyselect_error_empty_selection>
       Error in `relocate_loc()`:
       ! Must select at least one item.
 

diff --git a/tests/testthat/_snaps/eval-select.md b/tests/testthat/_snaps/eval-select.md
@@ -66,6 +66,24 @@
       Error in `select_loc()`:
       ! Must select at least one item.
 
+# can forbid empty selections with informative error
+
+    Code
+      select_loc(mtcars, allow_empty = FALSE, error_arg = "cols")
+    Condition
+      Error in `select_loc()`:
+      ! `cols` must select at least one column.
+    Code
+      select_loc(mtcars, integer(), allow_empty = FALSE, error_arg = "x")
+    Condition
+      Error in `select_loc()`:
+      ! `x` must select at least one column.
+    Code
+      select_loc(mtcars, starts_with("z"), allow_empty = FALSE, error_arg = "y")
+    Condition
+      Error in `select_loc()`:
+      ! `y` must select at least one column.
+
 # eval_select() errors mention correct calls
 
     Code