route some spec updating calls

Author: ‘topepo’

R/mars.R

@@ -161,21 +161,23 @@ multi_predict._earth <-
         object$fit$call[[i]] <- eval_tidy(object$fit$call[[i]])
     }
 
-    msg <- 
-      c("x" = "Please use {.code keepxy = TRUE} as an option to enable submodel 
+    msg <-
+      c("x" = "Please use {.code keepxy = TRUE} as an option to enable submodel
                      predictions with earth.")
     if (any(names(object$fit$call) == "keepxy")) {
-       if (!isTRUE(object$fit$call$keepxy))
-         cli::cli_abort(msg)
+      if (!isTRUE(object$fit$call$keepxy)) {
+        cli::cli_abort(msg)
+      }
     } else {
       cli::cli_abort(msg)
     }
 
     if (is.null(type)) {
-      if (object$spec$mode == "classification")
+      if (object$spec$mode == "classification") {
         type <- "class"
-      else
+      } else {
         type <- "numeric"
+      }
     }
 
     res <-

R/misc.R

@@ -418,21 +418,21 @@ check_outcome <- function(y, spec) {
 #' @export
 #' @keywords internal
 #' @rdname add_on_exports
-check_final_param <- function(x) {
+check_final_param <- function(x, call = rlang::caller_env()) {
   if (is.null(x)) {
     return(invisible(x))
   }
   if (!is.list(x) & !tibble::is_tibble(x)) {
-    cli::cli_abort("The parameter object should be a list or tibble.")
+    cli::cli_abort("The parameter object should be a list or tibble.", call = call)
   }
   if (tibble::is_tibble(x) && nrow(x) > 1) {
-    cli::cli_abort("The parameter tibble should have a single row.")
+    cli::cli_abort("The parameter tibble should have a single row.", call = call)
   }
   if (tibble::is_tibble(x)) {
     x <- as.list(x)
   }
   if (length(names) == 0 || any(names(x) == "")) {
-    cli::cli_abort("All values in {.arg parameters} should have a name.")
+    cli::cli_abort("All values in {.arg parameters} should have a name.", call = call)
   }
 
   invisible(x)
@@ -441,7 +441,7 @@ check_final_param <- function(x) {
 #' @export
 #' @keywords internal
 #' @rdname add_on_exports
-update_main_parameters <- function(args, param) {
+update_main_parameters <- function(args, param, call = rlang::caller_env()) {
   if (length(param) == 0) {
     return(args)
   }
@@ -454,7 +454,8 @@ update_main_parameters <- function(args, param) {
   extra_args <- names(param)[has_extra_args]
   if (any(has_extra_args)) {
     cli::cli_abort(
-      "Argument{?s} {.arg {extra_args}} {?is/are} not a main argument."
+      "Argument{?s} {.arg {extra_args}} {?is/are} not a main argument.",
+      call = call
     )
   }
   param <- param[!has_extra_args]

R/update.R

@@ -64,10 +64,10 @@ update_spec <- function(object, parameters, args_enquo_list, fresh, cls, ...,
   eng_args <- update_engine_parameters(object$eng_args, fresh, ...)
 
   if (!is.null(parameters)) {
-    parameters <- check_final_param(parameters)
+    parameters <- check_final_param(parameters, call = call)
   }
 
-  args <- update_main_parameters(args_enquo_list, parameters)
+  args <- update_main_parameters(args_enquo_list, parameters, call = call)
 
   if (fresh) {
     object$args <- args

tests/testthat/_snaps/update.md

@@ -196,31 +196,31 @@
     Code
       expr1 %>% update(param_tibb)
     Condition
-      Error in `update_main_parameters()`:
+      Error in `update()`:
       ! Argument `nlambda` is not a main argument.
 
 ---
 
     Code
       expr1 %>% update(param_list)
     Condition
-      Error in `update_main_parameters()`:
+      Error in `update()`:
       ! Argument `nlambda` is not a main argument.
 
 ---
 
     Code
       expr1 %>% update(parameters = "wat")
     Condition
-      Error in `check_final_param()`:
+      Error in `update()`:
       ! The parameter object should be a list or tibble.
 
 ---
 
     Code
       expr1 %>% update(parameters = tibble::tibble(wat = "wat"))
     Condition
-      Error in `update_main_parameters()`:
+      Error in `update()`:
       ! Argument `wat` is not a main argument.
 
 ---