transition to cli for errors/warnings/messages (#513)

* transition rlang prompts to cli * use cli inline markup in error messages * note change in NEWS
tidymodels · Nov 1, 2023 · 8a2a5b0 · 8a2a5b0
1 parent fe3d3fc
commit 8a2a5b0
Show file tree

Hide file tree

Showing 30 changed files with 602 additions and 483 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -36,6 +36,7 @@ Depends:
     R (>= 3.5.0)
 Imports:
     broom,
+    cli,
     dplyr (>= 0.7.0),
     generics,
     ggplot2,

diff --git a/NAMESPACE b/NAMESPACE
@@ -37,6 +37,11 @@ export(t_stat)
 export(t_test)
 export(visualise)
 export(visualize)
+importFrom(cli,cli_abort)
+importFrom(cli,cli_inform)
+importFrom(cli,cli_warn)
+importFrom(cli,no)
+importFrom(cli,qty)
 importFrom(dplyr,across)
 importFrom(dplyr,any_of)
 importFrom(dplyr,bind_rows)
@@ -63,18 +68,15 @@ importFrom(methods,hasArg)
 importFrom(purrr,compact)
 importFrom(rlang,"!!")
 importFrom(rlang,":=")
-importFrom(rlang,abort)
 importFrom(rlang,caller_env)
 importFrom(rlang,enquo)
 importFrom(rlang,eval_tidy)
 importFrom(rlang,f_lhs)
 importFrom(rlang,f_rhs)
 importFrom(rlang,get_expr)
-importFrom(rlang,inform)
 importFrom(rlang,new_formula)
 importFrom(rlang,quo)
 importFrom(rlang,sym)
-importFrom(rlang,warn)
 importFrom(stats,as.formula)
 importFrom(stats,dchisq)
 importFrom(stats,df)

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,9 @@
 # infer v1.0.5.9000 (development version)
 
+* Updated infrastructure for errors, warnings, and messages (#513). Most of these changes will not be visible to users, though:
+     - Many longer error messages are now broken up into several lines.
+     - For references to help-files, users can now click on the error message's text to navigate to the cited documentation.
+
 # infer v1.0.5
 
 * Implemented support for permutation hypothesis tests for paired data via the 

diff --git a/R/assume.R b/R/assume.R
@@ -148,10 +148,10 @@
 #' @export
 assume <- function(x, distribution, df = NULL, ...) {
   if (!inherits(x, "infer")) {
-    abort(paste0(
-      "The `x` argument must be the output of a core infer function, ",
-      "likely `specify()` or `hypothesize()`."
-    ))
+    cli_abort(
+      "The {.arg x} argument must be the output of a core infer function, \\
+       likely {.fun specify} or {.fun hypothesize}."
+    )
   }
 
   # check that `distribution` aligns with what is expected from
@@ -187,7 +187,7 @@ check_distribution <- function(x, distribution, df, ..., call = caller_env()) {
   dist <- tolower(distribution)
 
   if (!dist %in% c("f", "chisq", "t", "z")) {
-     abort(
+     cli_abort(
       'The distribution argument must be one of "Chisq", "F", "t", or "z".',
       call = call
     )
@@ -210,40 +210,39 @@ check_distribution <- function(x, distribution, df, ..., call = caller_env()) {
       msg_tail <- "no explanatory variable."
     }
 
-     abort(glue(
-      'The supplied distribution "{distribution}" is not well-defined for a ',
-      "{get_stat_type_desc(attr(x, 'type_desc_response'))} response ",
-      "variable ({response_name(x)}) and ", msg_tail
-     ), call = call)
+     cli_abort(
+      'The supplied distribution {.val {distribution}} is not well-defined for a \\
+      {get_stat_type_desc(attr(x, "type_desc_response"))} response \\
+      variable ({response_name(x)}) and {msg_tail}', call = call)
   }
 
   if (!is.numeric(df) && !is.null(df)) {
-     abort(glue(
-      "`assume()` expects the `df` argument to be a numeric vector, ",
-      "but you supplied a {list(class(df))} object."
-    ), call = call)
+     cli_abort(
+      "{.fun assume} expects the {.arg df} argument to be a numeric vector, \\
+       but you supplied a {list(class(df))} object.",
+      call = call
+     )
   }
 
   if (length(list(...)) != 0) {
-    plural <- length(list(...)) != 1
     dots <- list(...)
 
-    abort(glue(
-      "`assume()` ignores the dots `...` argument, though the ",
-      "argument{if (plural) 's' else ''} `{list(dots)}` ",
-      "{if (plural) 'were' else 'was'} supplied. Did you forget to ",
-      "concatenate the `df` argument with `c()`?"
-    ), call = call)
+    cli_abort(c(
+      "{.fun assume} ignores the dots `...` argument, though the \\
+       {qty(dots)}argument{?s} {.field {names(dots)}} {?was/were} supplied. ",
+       i = "Did you forget to concatenate the {.arg df} argument with {.fun c}?"),
+      call = call
+    )
   }
 
   if (dist_df_length(distribution) != length(df) && !is.null(df)) {
-    plural <- length(df) != 1
-    abort(glue(
-      '{distribution_desc(distribution)} distribution requires ',
-      '{dist_df_length(distribution)} degrees of freedom argument',
-      '{if (!plural) "s" else ""}, but {length(df)} ',
-      '{if (plural) "were" else "was"} supplied.'
-    ), call = call)
+
+    cli_abort(
+      '{distribution_desc(distribution)} distribution requires \\
+       {dist_df_length(distribution)} degrees of freedom argument{?s}, \\
+       but {length(df)} {?was/were} supplied.',
+      call = call
+    )
   }
 
   df <- determine_df(x, dist, df)
@@ -314,12 +313,12 @@ process_df <- function(df) {
 determine_df <- function(x, dist, df) {
 
   if (!is.null(df) && !all(round(df) %in% round(acceptable_dfs(x)))) {
-    inform(glue(
-      "Message: The supplied `df` argument does not match its ",
-      "expected value. If this is unexpected, ensure that your calculation ",
-      "for `df` is correct (see `?assume` for recognized values) or ",
-      "supply `df = NULL` to `assume()`."
-    ))
+    cli_inform(
+      "Message: The supplied {.arg df} argument does not match its \\
+       expected value. If this is unexpected, ensure that your calculation \\
+       for {.arg df} is correct (see {.help [{.fun assume}](infer::assume)} for \\
+       recognized values) or supply {.code df = NULL} to {.fun assume}."
+    )
 
     return(df)
   }

diff --git a/R/calculate.R b/R/calculate.R
@@ -128,16 +128,19 @@ calculate <- function(x,
 
 check_if_mlr <- function(x, fn, call = caller_env()) {
   if (fn == "calculate") {
-    suggestion <- paste0("When working with multiple explanatory",
-                         " variables, use fit() instead.")
+    suggestion <-
+       "When working with multiple explanatory variables, use \\
+        {.help [{.fun fit}](infer::fit.infer)} instead."
   } else {
     suggestion <- ""
   }
 
   if (is_mlr(x)) {
-    abort(glue(
-      "Multiple explanatory variables are not supported in {fn}(). {suggestion}"
-    ), call = call)
+    cli_abort(
+      c("Multiple explanatory variables are not supported in {.fun {fn}}.",
+        i = suggestion),
+      call = call
+    )
   }
 }
 
@@ -168,10 +171,11 @@ check_input_vs_stat <- function(x, stat, call = caller_env()) {
     unlist()
 
   if (is.null(possible_stats)) {
-    abort(paste0(
-      "The infer team has not implemented test statistics for the ",
-      "supplied variable types."
-    ), call = call)
+    cli_abort(
+      "The infer team has not implemented test statistics for the \\
+       supplied variable types.",
+      call = call
+    )
   }
 
   if (!stat %in% possible_stats) {
@@ -185,11 +189,12 @@ check_input_vs_stat <- function(x, stat, call = caller_env()) {
       msg_tail <- "no explanatory variable."
     }
 
-    abort(glue(
-      "{get_stat_desc(stat)} is not well-defined for a ",
-      "{get_stat_type_desc(response_type)} response variable ",
-      "({response_name(x)}) and ", msg_tail
-    ), call = call)
+    cli_abort(
+      "{get_stat_desc(stat)} is not well-defined for a \\
+       {get_stat_type_desc(response_type)} response variable \\
+       ({response_name(x)}) and {msg_tail}",
+      call = call
+    )
   }
 
   if (is_hypothesized(x)) {
@@ -198,10 +203,11 @@ check_input_vs_stat <- function(x, stat, call = caller_env()) {
                     hypothesis == attr(x, "null"))
 
     if (nrow(stat_nulls) == 0) {
-      abort(glue(
-        'The supplied statistic `stat = "{stat}"` is incompatible with the ',
-        'supplied hypothesis `null = "{attr(x, "null")}"`.'
-      ), call = call)
+      cli_abort(
+        'The supplied statistic `stat = "{stat}"` is incompatible with the \\
+         supplied hypothesis `null = "{attr(x, "null")}"`.',
+        call = call
+      )
     }
   }
 
@@ -229,13 +235,13 @@ message_on_excessive_null <- function(x, stat = "mean", fn) {
     null_type <- attr(x, "null")
     null_param <- attr(x, "params")
 
-    inform(glue(
-      "Message: The {null_type} null hypothesis ",
-      "{if (null_type == 'point') {paste0('`', names(null_param), ' = ', unname(null_param), '` ')} else {''}}",
-      "does not inform calculation of the observed ",
-      "{if (fn == 'calculate') {paste0('statistic (', tolower(get_stat_desc(stat)), ') ')} else {'fit '}}",
-      "and will be ignored."
-    ))
+    cli_inform(
+      "Message: The {null_type} null hypothesis \\
+       {if (null_type == 'point') {paste0('`', names(null_param), ' = ', unname(null_param), '` ')} else {''}} \\
+       does not inform calculation of the observed \\
+       {if (fn == 'calculate') {paste0('statistic (', tolower(get_stat_desc(stat)), ') ')} else {'fit '}} \\
+       and will be ignored."
+    )
   }
 
   x
@@ -251,10 +257,10 @@ warn_on_insufficient_null <- function(x, stat, ...) {
     attr(x, "null") <- "point"
     attr(x, "params") <- assume_null(x, stat)
 
-    warn(glue(
-      "{get_stat_desc(stat)} requires a null ",
-      "hypothesis to calculate the observed statistic. \nOutput assumes ",
-      "the following null value{print_params(x)}."
+    cli_warn(c(
+      "{get_stat_desc(stat)} requires a null \\
+       hypothesis to calculate the observed statistic.",
+       "Output assumes the following null value{print_params(x)}."
     ))
   }
 

diff --git a/R/fit.R b/R/fit.R
@@ -162,11 +162,12 @@ check_family <- function(object, ..., call = caller_env()) {
   response_type <- attr(object, "type_desc_response")
 
   if (response_type == "mult") {
-    abort(paste0(
-      "infer does not support fitting models for categorical response variables ",
-      "with more than two levels. Please see `multinom_reg()` from the ",
-      "parsnip package."
-    ), call = call)
+    cli_abort(c(
+      "infer does not support fitting models for categorical response variables \\
+       with more than two levels.",
+      i = "Please see {.fun multinom_reg} from the parsnip package."),
+      call = call
+    )
   }
 
   dots <- list(...)