Merge pull request #351 from tidymodels/cli-abort-first-half

Switch from `rlang::abort()` in `parameters.R`, `grids.R` and `misc.R`

R/grids.R

@@ -135,8 +135,8 @@ make_regular_grid <- function(...,
   # check levels
   p <- length(levels)
   if (p > 1 && p != length(param_quos)) {
-    rlang::abort(
-      paste0("`levels` should have length 1 or ", length(param_quos)),
+    cli::cli_abort(
+      "{.arg levels} should have length 1 or {length(param_quos)}, not {p}.",
       call = call
     )
   }
@@ -147,8 +147,9 @@ make_regular_grid <- function(...,
     if (all(rlang::has_name(levels, names(params)))) {
       levels <- levels[names(params)]
     } else if (any(rlang::has_name(levels, names(params)))) {
-      rlang::abort(
-        "Elements of `levels` should either be all named or unnamed, not mixed.",
+      cli::cli_abort(
+        "Elements of {.arg levels} should either be all named or unnamed, 
+        not mixed.",
         call = call
       )
     }
@@ -161,7 +162,7 @@ make_regular_grid <- function(...,
     parameters <- dplyr::filter(parameters, !!filter_quo)
   }
 
-  new_param_grid(parameters)
+  new_param_grid(parameters, call = call)
 }
 
 # ------------------------------------------------------------------------------
@@ -251,14 +252,16 @@ make_random_grid <- function(...,
     parameters <- dplyr::filter(parameters, !!filter_quo)
   }
 
-  new_param_grid(parameters)
+  new_param_grid(parameters, call = call)
 }
 
 # ------------------------------------------------------------------------------
 
-new_param_grid <- function(x = new_data_frame()) {
+new_param_grid <- function(x = new_data_frame(), call = caller_env()) {
   if (!is.data.frame(x)) {
-    rlang::abort("`x` must be a data frame to construct a new grid from.")
+    cli::cli_abort(
+      "{.arg x} must be a data frame to construct a new grid from."
+    )
   }
 
   x <- vctrs::vec_unique(x)

R/misc.R

@@ -70,20 +70,21 @@ check_range <- function(x, type, trans, ..., call = caller_env()) {
       whole <-
         purrr::map_lgl(x0[known], ~ abs(.x - round(.x)) < .Machine$double.eps^0.5)
       if (!all(whole)) {
-        msg <- paste(x0[known][!whole], collapse = ", ")
-        msg <- paste0(
-          "An integer is required for the range and these do not appear to be ",
-          "whole numbers: ", msg
+        offenders <- x0[known][!whole]
+        cli::cli_abort(
+          "An integer is required for the range and these do not appear to be
+          whole numbers: {offenders}.",
+          call = call
         )
-        rlang::abort(msg, call = call)
       }
 
       x0[known] <- as.integer(x0[known])
     } else {
-      msg <- paste0(
-        "Since `type = '", type, "'`, please use that data type for the range."
+      cli::cli_abort(
+        "Since {.code type = \"{type}\"}, please use that data type for the 
+        range.",
+        call = call
       )
-      rlang::abort(msg, call = call)
     }
   }
   invisible(x0)
@@ -97,13 +98,13 @@ check_values_quant <- function(x, ..., call = caller_env()) {
   }
 
   if (!is.numeric(x)) {
-    rlang::abort("`values` must be numeric.", call = call)
+    cli::cli_abort("{.arg values} must be numeric.", call = call)
   }
   if (anyNA(x)) {
-    rlang::abort("`values` can't be `NA`.", call = call)
+    cli::cli_abort("{.arg values} can't be {.code NA}.", call = call)
   }
   if (length(x) == 0) {
-    rlang::abort("`values` can't be empty.", call = call)
+    cli::cli_abort("{.arg values} can't be empty.", call = call)
   }
 
   invisible(x)

R/parameters.R

@@ -12,11 +12,8 @@ parameters <- function(x, ...) {
 #' @export
 #' @rdname parameters
 parameters.default <- function(x, ...) {
-  rlang::abort(
-    glue(
-      "`parameters` objects cannot be created from objects ",
-      "of class `{class(x)[1]}`."
-    )
+  cli::cli_abort(
+    "{.cls parameters} objects cannot be created from {.obj_type_friendly {x}}."
   )
 }
 
@@ -34,7 +31,7 @@ parameters.param <- function(x, ...) {
 parameters.list <- function(x, ...) {
   elem_param <- purrr::map_lgl(x, inherits, "param")
   if (any(!elem_param)) {
-    rlang::abort("The objects should all be `param` objects.")
+    cli::cli_abort("The objects should all be {.cls param} objects.")
   }
   elem_name <- purrr::map_chr(x, ~ names(.x$label))
   elem_id <- names(x)
@@ -61,12 +58,14 @@ unique_check <- function(x, ..., call = caller_env()) {
   if (any(is_dup)) {
     dup_list <- x2[is_dup]
     cl <- match.call()
-    msg <- paste0(
-      "Element `", deparse(cl$x), "` should have unique values. Duplicates exist ",
-      "for item(s): ",
-      paste0("'", dup_list, "'", collapse = ", ")
+
+    cli::cli_abort(
+      c(
+        x = "Element {.field {deparse(cl$x)}} should have unique values.",
+        i = "Duplicates exist for {cli::qty(dup_list)} item{?s}: {dup_list}"
+      ),
+      call = call
     )
-    rlang::abort(msg, call = call)
   }
   invisible(TRUE)
 }
@@ -78,16 +77,18 @@ param_or_na <- function(x) {
 check_list_of_param <- function(x, ..., call = caller_env()) {
   check_dots_empty()
   if (!is.list(x)) {
-    abort("`object` must be a list of `param` objects.", call = call)
+    cli::cli_abort(
+      "{.arg object} must be a list of {.cls param} objects.",
+      call = call
+    )
   }
   is_good_boi <- map_lgl(x, param_or_na)
   if (any(!is_good_boi)) {
-    rlang::abort(
-      paste0(
-        "`object` elements in the following positions must be `NA` or a ",
-        "`param` object:",
-        paste0(which(!is_good_boi), collapse = ", ")
-      ),
+    offenders <- which(!is_good_boi)
+
+    cli::cli_abort(
+      "{.arg object} elements in the following positions must be {.code NA} or a 
+      {.cls param} object: {offenders}.",
       call = call
     )
   }
@@ -99,7 +100,7 @@ check_list_of_param <- function(x, ..., call = caller_env()) {
 #' length.
 #' @param object A list of `param` objects or NA values.
 #' @inheritParams rlang::args_dots_empty
-#' @param call The call passed on to [rlang::abort()].
+#' @param call The call passed on to [cli::cli_abort()].
 #'
 #' @return A tibble that encapsulates the input vectors into a tibble with an
 #' additional class of "parameters".
@@ -129,7 +130,7 @@ parameters_constr <- function(name,
     )
   n_elements_unique <- unique(n_elements)
   if (length(n_elements_unique) > 1) {
-    abort(
+    cli::cli_abort(
       "All inputs must contain contain the same number of elements.",
       call = call
     )
@@ -261,21 +262,21 @@ print.parameters <- function(x, ...) {
 update.parameters <- function(object, ...) {
   args <- rlang::list2(...)
   if (length(args) == 0) {
-    rlang::abort("Please supply at least one parameter object.")
+    cli::cli_abort("Please supply at least one parameter object.")
   }
   nms <- names(args)
   if (length(nms) == 0 || any(nms == "")) {
-    rlang::abort("All arguments should be named.")
+    cli::cli_abort("All arguments should be named.")
   }
 
   in_set <- nms %in% object$id
   if (!all(in_set)) {
-    msg <- paste0("'", nms[!in_set], "'", collapse = ", ")
-    msg <- paste(
-      "At least one parameter does not match any id's in the set:",
-      msg
+    offenders <- nms[!in_set]
+
+    cli::cli_abort(
+      "At least one parameter does not match any id's in the set:
+      {offenders}."
     )
-    rlang::abort(msg)
   }
   not_param <- !purrr::map_lgl(args, inherits, "param")
   not_null <- !purrr::map_lgl(args, ~ all(is.na(.x)))

R/space_filling.R

@@ -236,7 +236,7 @@ make_sfd <- function(...,
       )
   }
 
-  new_param_grid(grid)
+  new_param_grid(grid, call = call)
 }
 
 base_recycle <- function(x, size) {

tests/testthat/_snaps/constructors.md

@@ -176,55 +176,55 @@
       mixture(c(1L, 3L))
     Condition
       Error in `mixture()`:
-      ! Since `type = 'double'`, please use that data type for the range.
+      ! Since `type = "double"`, please use that data type for the range.
 
 ---
 
     Code
       mixture(c(1L, unknown()))
     Condition
       Error in `mixture()`:
-      ! Since `type = 'double'`, please use that data type for the range.
+      ! Since `type = "double"`, please use that data type for the range.
 
 ---
 
     Code
       mixture(c(unknown(), 1L))
     Condition
       Error in `mixture()`:
-      ! Since `type = 'double'`, please use that data type for the range.
+      ! Since `type = "double"`, please use that data type for the range.
 
 ---
 
     Code
       mixture(letters[1:2])
     Condition
       Error in `mixture()`:
-      ! Since `type = 'double'`, please use that data type for the range.
+      ! Since `type = "double"`, please use that data type for the range.
 
 ---
 
     Code
       mtry(c(0.1, 0.5))
     Condition
       Error in `mtry()`:
-      ! An integer is required for the range and these do not appear to be whole numbers: 0.1, 0.5
+      ! An integer is required for the range and these do not appear to be whole numbers: 0.1 and 0.5.
 
 ---
 
     Code
       mtry(c(0.1, unknown()))
     Condition
       Error in `mtry()`:
-      ! An integer is required for the range and these do not appear to be whole numbers: 0.1
+      ! An integer is required for the range and these do not appear to be whole numbers: 0.1.
 
 ---
 
     Code
       mtry(c(unknown(), 0.5))
     Condition
       Error in `mtry()`:
-      ! An integer is required for the range and these do not appear to be whole numbers: 0.5
+      ! An integer is required for the range and these do not appear to be whole numbers: 0.5.
 
 # `values` must be compatible with `range` and `inclusive`
 

tests/testthat/_snaps/grids.md

@@ -4,7 +4,7 @@
       grid_regular(mixture(), trees(), levels = 1:4)
     Condition
       Error in `grid_regular()`:
-      ! `levels` should have length 1 or 2
+      ! `levels` should have length 1 or 2, not 4.
 
 ---
 
@@ -15,7 +15,15 @@
       `size` is not an argument to `grid_regular()`.
       i Did you mean `levels`?
       Error in `parameters()`:
-      ! The objects should all be `param` objects.
+      ! The objects should all be <param> objects.
+
+---
+
+    Code
+      grid_regular(mixture(), trees(), levels = c(2, trees = 4))
+    Condition
+      Error in `grid_regular()`:
+      ! Elements of `levels` should either be all named or unnamed, not mixed.
 
 # wrong argument name
 

tests/testthat/_snaps/parameters.md

@@ -13,7 +13,8 @@
       parameters_constr(ab, c("a", "a"), ab, ab, ab)
     Condition
       Error:
-      ! Element `id` should have unique values. Duplicates exist for item(s): 'a'
+      x Element id should have unique values.
+      i Duplicates exist for item: a
 
 ---
 
@@ -22,7 +23,7 @@
       parameters_constr(ab, ab, ab, ab, ab, "not a params list")
     Condition
       Error:
-      ! `object` must be a list of `param` objects.
+      ! `object` must be a list of <param> objects.
 
 ---
 
@@ -48,7 +49,16 @@
       parameters(list(a = mtry(), a = penalty()))
     Condition
       Error in `parameters()`:
-      ! Element `id` should have unique values. Duplicates exist for item(s): 'a'
+      x Element id should have unique values.
+      i Duplicates exist for item: a
+
+---
+
+    Code
+      parameters(list(a = mtry, a = penalty()))
+    Condition
+      Error in `parameters()`:
+      ! The objects should all be <param> objects.
 
 # updating
 
@@ -66,6 +76,14 @@
       Error in `update()`:
       ! At least one parameter is not a dials parameter object or NA: penalty.
 
+---
+
+    Code
+      update(p_1, not_penalty = 1:2)
+    Condition
+      Error in `update()`:
+      ! At least one parameter does not match any id's in the set: not_penalty.
+
 ---
 
     Code
@@ -74,6 +92,14 @@
       Error in `update()`:
       ! All arguments should be named.
 
+---
+
+    Code
+      update(p_1)
+    Condition
+      Error in `update()`:
+      ! Please supply at least one parameter object.
+
 # printing
 
     Code
@@ -142,5 +168,5 @@
       parameters(tibble::as_tibble(mtcars))
     Condition
       Error in `parameters()`:
-      ! `parameters` objects cannot be created from objects of class `tbl_df`.
+      ! <parameters> objects cannot be created from a tibble.