Merge pull request #456 from tidymodels/cli-infra

DESCRIPTION

@@ -24,7 +24,7 @@ Imports:
     generics (>= 0.1.2),
     hardhat (>= 1.3.0),
     lifecycle (>= 1.0.3),
-    rlang (>= 1.0.6),
+    rlang (>= 1.1.0),
     tibble,
     tidyselect (>= 1.2.0),
     utils,

R/aaa-metrics.R

@@ -269,10 +269,10 @@ metric_set <- function(...) {
   )) {
     make_survival_metric_function(fns)
   } else {
-    abort(paste0(
-      "Internal error: `validate_function_class()` should have ",
-      "errored on unknown classes."
-    ))
+    cli::cli_abort(
+      "{.fn validate_function_class} should have errored on unknown classes.",
+      .internal = TRUE
+    )
   }
 }
 
@@ -315,7 +315,10 @@ get_quo_label <- function(quo) {
   out <- as_label(quo)
 
   if (length(out) != 1L) {
-    abort("Internal error: `as_label(quo)` resulted in a character vector of length >1.")
+    cli::cli_abort(
+      "{.code as_label(quo)} resulted in a character vector of length >1.",
+      .internal = TRUE
+    )
   }
 
   is_namespaced <- grepl("::", out, fixed = TRUE)
@@ -538,9 +541,9 @@ make_survival_metric_function <- function(fns) {
   metric_function
 }
 
-validate_not_empty <- function(x) {
+validate_not_empty <- function(x, call = caller_env()) {
   if (is_empty(x)) {
-    abort("`metric_set()` requires at least 1 function supplied to `...`.")
+    cli::cli_abort("At least 1 function supplied to `...`.", call = call)
   }
 }
 
@@ -678,14 +681,12 @@ validate_function_class <- function(fns) {
     USE.NAMES = FALSE
   )
 
-  fn_pastable <- paste0(fn_pastable, collapse = "\n")
-
-  abort(paste0(
-    "\nThe combination of metric functions must be:\n",
-    "- only numeric metrics\n",
-    "- a mix of class metrics and class probability metrics\n\n",
-    "- a mix of dynamic and static survival metrics\n\n",
-    "The following metric function types are being mixed:\n",
+  cli::cli_abort(c(
+    "x" = "The combination of metric functions must be:",
+    "*" = "only numeric metrics.",
+    "*" = "a mix of class metrics and class probability metrics.",
+    "*" = "a mix of dynamic and static survival metrics.",
+    "i" = "The following metric function types are being mixed:",
     fn_pastable
   ))
 }
@@ -698,8 +699,11 @@ eval_safely <- function(expr, expr_nm, data = NULL, env = caller_env()) {
       eval_tidy(expr, data = data, env = env)
     },
     error = function(cnd) {
-      message <- paste0("Failed to compute `", expr_nm, "()`.")
-      abort(message, parent = cnd, call = call("metric_set"))
+      cli::cli_abort(
+        "Failed to compute {.fn {expr_nm}}.",
+        parent = cnd,
+        call = call("metric_set")
+      )
     }
   )
 }

R/aaa-new.R

@@ -66,7 +66,7 @@ new_static_survival_metric <- function(fn, direction) {
 
 new_metric <- function(fn, direction, class = NULL) {
   if (!is.function(fn)) {
-    abort("`fn` must be a function.")
+    cli::cli_abort("{.arg fn} must be a function.")
   }
 
   direction <- arg_match(

R/estimator-helpers.R

@@ -17,8 +17,9 @@ get_weights <- function(data, estimator) {
     .col_sums <- colSums(data)
     .col_sums / sum(.col_sums)
   } else {
-    msg <- paste0("`estimator` type `", estimator, "` is unknown.")
-    abort(msg)
+    cli::cli_abort(
+      "{.arg estimator} type {.val {estimator}} is unknown."
+    )
   }
 }
 

R/event-level.R

@@ -33,5 +33,5 @@ validate_event_level <- function(event_level) {
     return(invisible())
   }
 
-  abort("`event_level` must be 'first' or 'second'.")
+  cli::cli_abort("{.arg event_level} must be {.val first} or {.val second}.")
 }

R/fair-aaa.R

@@ -115,13 +115,19 @@
 #' @export
 new_groupwise_metric <- function(fn, name, aggregate, direction = "minimize") {
   if (is_missing(fn) || !inherits_any(fn, c("metric", "metric_set"))) {
-    abort("`fn` must be a metric function or metric set.")
+    cli::cli_abort(
+      "{.arg fn} must be a metric function or metric set."
+    )
   }
   if (is_missing(name) || !is_string(name)) {
-    abort("`name` must be a string.")
+    cli::cli_abort(
+      "{.arg name} must be a string."
+    )
   }
   if (is_missing(aggregate) || !is_function(aggregate)) {
-    abort("`aggregate` must be a function.")
+    cli::cli_abort(
+      "{.arg aggregate} must be a function."
+    )
   }
   arg_match(
     direction,
@@ -152,7 +158,7 @@ new_groupwise_metric <- function(fn, name, aggregate, direction = "minimize") {
                   cnd <- cnd$parent
                 }
 
-                abort(conditionMessage(cnd), call = call(name))
+                cli::cli_abort(conditionMessage(cnd), call = call(name))
               }
             )
 
@@ -173,8 +179,8 @@ new_groupwise_metric <- function(fn, name, aggregate, direction = "minimize") {
             .estimate <- aggregate(group)
 
             if (!is_bare_numeric(.estimate)) {
-              abort(
-                "`aggregate` must return a single numeric value.",
+              cli::cli_abort(
+                "{.arg aggregate} must return a single numeric value.",
                 call = call2("new_groupwise_metric")
               )
             }