From e4190a9eafb5c2fca9e8036d3d5920b1e28f1718 Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Wed, 23 Oct 2024 04:58:19 -0400 Subject: [PATCH] Throw classed error if `allow_empty = FALSE` (#350) And add more context to error message with `error_arg` arguments. --- NAMESPACE | 4 ++++ NEWS.md | 7 +++++++ R/eval-relocate.R | 9 ++++++--- R/eval-select.R | 13 +++++++++++++ R/eval-walk.R | 24 ++++++++++++++++++++---- R/utils.R | 4 ++++ man/eval_relocate.Rd | 5 +++++ man/eval_select.Rd | 11 +++++++++++ man/faq-external-vector.Rd | 11 ++++------- man/faq-selection-context.Rd | 17 +++++++---------- tests/testthat/_snaps/eval-relocate.md | 23 ++++++++++++++++++----- tests/testthat/_snaps/eval-select.md | 18 ++++++++++++++++++ tests/testthat/test-eval-relocate.R | 13 ++++++++++++- tests/testthat/test-eval-select.R | 8 ++++++++ 14 files changed, 137 insertions(+), 30 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a3a2873c..f1a57361 100644 --- 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 index 398f8ac1..0b551a14 100644 --- 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 index 45d46b62..2d1360d5 100644 --- 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 index d899cd8b..fa82c61e 100644 --- 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 index b30bc0e7..25fb65de 100644 --- 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 index 2a66b618..c5b2895e 100644 --- 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 index badfe2e2..5c08dc06 100644 --- a/man/eval_relocate.Rd +++ b/man/eval_relocate.Rd @@ -15,6 +15,7 @@ eval_relocate( allow_rename = TRUE, allow_empty = TRUE, allow_predicates = TRUE, + error_arg = NULL, before_arg = "before", after_arg = "after", env = caller_env(), @@ -59,6 +60,10 @@ use predicates (i.e. in \code{where()}). If \code{FALSE}, will error if \code{ex predicate. Will automatically be set to \code{FALSE} if \code{data} does not support predicates (as determined by \code{\link[=tidyselect_data_has_predicates]{tidyselect_data_has_predicates()}}).} +\item{error_arg}{Argument names for \code{expr}. These +are used in error messages. (You can use \code{"..."} if \code{expr = c(...)}). +For now, this is used when \code{allow_empty = FALSE}.} + \item{before_arg, after_arg}{Argument names for \code{before} and \code{after}. These are used in error messages.} diff --git a/man/eval_select.Rd b/man/eval_select.Rd index 1f3b1dc6..19d85b09 100644 --- a/man/eval_select.Rd +++ b/man/eval_select.Rd @@ -28,6 +28,7 @@ eval_select( allow_rename = TRUE, allow_empty = TRUE, allow_predicates = TRUE, + error_arg = NULL, error_call = caller_env() ) } @@ -74,6 +75,10 @@ is useful to implement purely selective behaviour.} \item{allow_empty}{If \code{TRUE} (the default), it is ok for \code{expr} to result in an empty selection. If \code{FALSE}, will error if \code{expr} yields an empty selection.} + +\item{error_arg}{Argument names for \code{expr}. These +are used in error messages. (You can use \code{"..."} if \code{expr = c(...)}). +For now, this is used when \code{allow_empty = FALSE}.} } \value{ A named vector of numeric locations, one for each of the @@ -140,6 +145,12 @@ my_function <- function(.x, .expr, ...) { # 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()` diff --git a/man/faq-external-vector.Rd b/man/faq-external-vector.Rd index 4631f226..6913c248 100644 --- a/man/faq-external-vector.Rd +++ b/man/faq-external-vector.Rd @@ -38,8 +38,7 @@ external object. \if{html}{\out{