transition erroring code to use cli (#1230)

* import rlang

* add cli to Imports

* transition `stop()` to `cli::cli_abort()`

* transition `warning()` to `cli::cli_warn()`

* transition `message()` to `cli::cli_inform()`

* transition `rlang::inform()` to `cli::cli_inform()`

DESCRIPTION

@@ -543,6 +543,7 @@ Depends:
     R (>= 3.5)
 Imports:
     backports,
+    cli,
     dplyr (>= 1.0.0),
     generics (>= 0.0.2),
     glue,

NAMESPACE

@@ -299,6 +299,7 @@ export(glance)
 export(tidy)
 export(tidy_irlba)
 import(dplyr)
+import(rlang)
 importFrom(generics,augment)
 importFrom(generics,glance)
 importFrom(generics,tidy)

R/aaa-documentation-helper.R

@@ -26,11 +26,10 @@ return_evalrd <- function(..., .method, .pre = NULL, .post = NULL) {
     not_found <- setdiff(pull_from_modeltests, glos_env$column_glossary$column)
 
     if (length(not_found) > 0) {
-      not_found <- paste(not_found, collapse = ", ")
-      stop(
-        glue(
-          "Tried to use modeltests documentation for: {not_found} column(s) ",
-          "but could not find any."
+      cli::cli_abort(
+        c(
+          "Tried to use modeltests documentation for: {not_found} column{?s}.",
+          "i" = "No documentation could be found."
         )
       )
     }
@@ -67,11 +66,10 @@ return_evalrd <- function(..., .method, .pre = NULL, .post = NULL) {
   written <- purrr::map_lgl(cols_exps, stringr::str_detect, string = result)
   missing_cols <- standard_cols[!written]
   if (length(missing_cols) != 0) {
-    cols_message <- glue(
-      'The return_{.method} input "{missing_cols}" did not ',
-      "result in any documentation being written. \n"
+    cli::cli_inform(
+      "The {.code return_{.method}} input {.val {missing_cols}} did not 
+       result in any documentation being written."
     )
-    message(cols_message)
   }
 
   result

R/broom-package.R

@@ -20,6 +20,8 @@
 #' @importFrom purrr map_df set_names possibly
 #' @importFrom tibble tibble as_tibble
 #' @importFrom tidyr pivot_longer pivot_wider
+#' 
+#' @import rlang
 #'
 #' @importFrom utils head
 #' @importFrom glue glue

R/data-frame.R

@@ -1,17 +1,15 @@
 #' @export
 glance.data.frame <- function(x, ...) {
-  stop(
-    "There is no glance method for data frames. ",
-    "Did you mean `tibble::glimpse()`?",
-    call. = FALSE
-  )
+  cli::cli_abort(c(
+      "There is no {.fn glance} method for data frames.",
+      "i" = "Did you mean {.fn tibble::glimpse}?"
+  ))
 }
 
 #' @export
 glance.tbl_df <- function(x, ...) {
-  stop(
-    "There is no glance method for tibbles. ",
-    "Did you mean `tibble::glimpse()`?",
-    call. = FALSE
-  )
+  cli::cli_abort(c(
+      "There is no glance method for tibbles.",
+      "i" = "Did you mean {.fn tibble::glimpse}?"
+  ))
 }

R/deprecated-0-7-0.R

@@ -154,7 +154,9 @@ tidy.data.frame <- function(x, ..., na.rm = TRUE, trim = 0.1) {
 #' @export
 #' @family deprecated
 augment.data.frame <- function(x, data, ...) {
-  stop(paste("augment's first argument should be a model, not a data.frame"))
+  cli::cli_abort(
+    "{.arg x} should be a model, not a {.cls data.frame}."
+  )
 }
 
 
@@ -275,7 +277,10 @@ fix_data_frame <- function(x, newnames = NULL, newcol = "term") {
   )
 
   if (!is.null(newnames) && length(newnames) != ncol(x)) {
-    stop("newnames must be NULL or have length equal to number of columns")
+    cli::cli_abort(
+      "{.arg newnames} must be {.code NULL} or have length
+       equal to the number of columns."
+    )
   }
 
   if (all(rownames(x) == seq_len(nrow(x)))) {

R/drc.R

@@ -102,7 +102,7 @@ glance.drc <- function(x, ...) {
 augment.drc <- function(x, data = NULL, newdata = NULL,
                         se_fit = FALSE, conf.int = FALSE, conf.level = 0.95, ...) {
   if (is.null(data) && is.null(newdata)) {
-    stop("Must specify either `data` or `newdata` argument.", call. = FALSE)
+    cli::cli_abort("Must specify either {.arg data} or {.arg newdata} argument.")
   }
 
   # drc doesn't like tibbles

R/ergm.R

@@ -82,7 +82,10 @@ tidy.ergm <- function(x, conf.int = FALSE, conf.level = 0.95,
   if (exponentiate) {
     if (is.null(x$glm) ||
       (x$glm$family$link != "logit" && x$glm$family$link != "log")) {
-      warning("Exponentiating but model didn't use log or logit link.")
+      cli::cli_warn(
+        "Coefficients will be exponentiated, but the model didn't 
+         use a {.code log} or {.code logit} link."
+      )
     }
 
     ret <- exponentiate(ret)
@@ -152,9 +155,12 @@ glance.ergm <- function(x, deviance = FALSE, mcmc = FALSE, ...) {
 
   if (mcmc) {
     if (isTRUE(x$MPLE_is_MLE)) {
-      message(
-        "Though `glance` was supplied `mcmc = TRUE`, the model was not fitted",
-        "using MCMC, so the corresponding columns will be omitted."
+      cli::cli_inform(
+        c(
+          "Though {.fn glance} was supplied {.code mcmc = TRUE}, the model was not
+           fitted using MCMC,",
+          "i" = "The corresponding columns will be omitted."
+        )
       )
     }
 

R/fixest.R

@@ -104,11 +104,11 @@ augment.fixest <- function(
     type.residuals = c("response", "deviance", "pearson", "working"),
     ...) {
   if (!x$method %in% c("feols", "feglm", "femlm")) {
-    stop(
-      "augment is only supported for fixest models estimated with ",
-      "feols, feglm, or femlm\n",
-      "  (supplied model used ", x$method, ")"
-    )
+    cli::cli_abort(c(
+      "augment is only supported for fixest models estimated with
+       {.fn feols}, {.fn feglm}, or {.fn femlm}.",
+      "i" = "Supplied model used {.fn {x$method}}."
+    ))
   }
   type.predict <- match.arg(type.predict)
   type.residuals <- match.arg(type.residuals)
@@ -119,7 +119,9 @@ augment.fixest <- function(
     df <- newdata
   }
   if (is.null(df)) {
-    stop("Must specify either `data` or `newdata` argument.", call. = FALSE)
+    cli::cli_abort(
+      "Must specify either a {.arg data} or {.arg newdata} argument."
+    )
   }
   df <- as_augment_tibble(df)
   if (is.null(newdata)) {

R/geepack.R

@@ -58,10 +58,10 @@ tidy.geeglm <- function(x, conf.int = FALSE, conf.level = .95,
   if (exponentiate) {
     if (is.null(x$family) ||
       (x$family$link != "logit" && x$family$link != "log")) {
-      warning(paste(
-        "Exponentiating coefficients, but model did not use",
-        "a log or logit link function"
-      ))
+      cli::cli_warn(
+        "Coefficients will be exponentiated, but the model didn't 
+         use a {.code log} or {.code logit} link."
+      )
     }
 
     ret <- exponentiate(ret)

R/joinerml.R

@@ -79,7 +79,7 @@ tidy.mjoint <- function(x, component = "survival", conf.int = FALSE,
   component <- rlang::arg_match(component, c("survival", "longitudinal"))
   if (!is.null(boot_se)) {
     if (!inherits(x = boot_se, "bootSE")) {
-      stop("`boot_se` argument must be a `bootSE` object.", call. = FALSE)
+      cli::cli_abort("{.arg boot_se} must be a {.cls bootSE} object.")
     }
   }
 
@@ -141,17 +141,21 @@ augment.mjoint <- function(x, data = x$data, ...) {
   check_ellipses("newdata", "augment", "mjoint", ...)
 
   if (is.null(data)) {
-    stop(
-      "`data` argument is NULL. Try specifying `data` manually.",
-      call. = FALSE
+    cli::cli_abort(
+      c(
+        "{.arg data} argument is {.code NULL}.",
+        "i" = "Try specifying {.arg data} manually."
+      )
     )
   }
 
   if (length(data) > 1) {
     if (!do.call(all.equal, data)) {
-      stop(
-        "List of 'data' extracted from 'x' does not",
-        "include equal data frames."
+      cli::cli_abort(
+        c(
+          "List of {.arg data} extracted from {.arg x} does not include equal
+           data frames."
+        )
       )
     }
     data <- data[[1]]

R/lfe.R

@@ -66,7 +66,11 @@ tidy.felm <- function(x, conf.int = FALSE, conf.level = .95, fe = FALSE, se.type
   # warn users about deprecated "robust" argument
   dots <- list(...)
   if (!is.null(dots$robust)) {
-    warning('\nThe "robust" argument has been deprecated in tidy.felm and will be ignored. Please use the "se.type" argument instead.\n')
+    cli::cli_warn(c(
+      "The {.arg robust} argument has been deprecated in {.fn tidy.felm} and 
+       will be ignored.",
+      "i" = "Please use the {.arg se.type} argument instead."
+    ))
   }
 
   # match SE args
@@ -83,7 +87,10 @@ tidy.felm <- function(x, conf.int = FALSE, conf.level = .95, fe = FALSE, se.type
   } else {
     # catch potential user error, asking for clusters where none exist
     if (se.type == "cluster" && is.null(x$clustervar)) {
-      warning("Clustered SEs requested, but weren't calculated in underlying model object. Reverting to default SEs.\n")
+      cli::cli_warn(c(
+        "Clustered SEs requested, but weren't calculated in underlying model object.",
+        "i" = "Reverting to default SEs."
+      ))
       se.type <- NULL
     }
 
@@ -203,10 +210,7 @@ augment.felm <- function(x, data = model.frame(x), ...) {
   has_multi_response <- length(x$lhs) > 1
 
   if (has_multi_response) {
-    stop(
-      "Augment does not support linear models with multiple responses.",
-      call. = FALSE
-    )
+    cli::cli_abort("{.fn felm} models with multiple responses are not supported.")
   }
   df <- as_augment_tibble(data)
   mutate(df, .fitted = as.vector(x$fitted.values), .resid = as.vector(x$residuals))
@@ -233,12 +237,9 @@ glance.felm <- function(x, ...) {
   has_multi_response <- length(x$lhs) > 1
 
   if (has_multi_response) {
-    stop(
-      "Glance does not support linear models with multiple responses.",
-      call. = FALSE
-    )
+    cli::cli_abort("{.fn felm} models with multiple responses are not supported.")
   }
-
+  
   s <- summary(x)
 
   as_glance_tibble(

R/list-svd.R

@@ -40,7 +40,7 @@
 #' @family list tidiers
 tidy_svd <- function(x, matrix = "u", ...) {
   if (length(matrix) > 1) {
-    stop("Must specify a single matrix to tidy.")
+    cli::cli_abort("Must specify a single matrix to tidy.")
   }
 
   if (matrix == "u") {

R/list-xyz.R

@@ -25,16 +25,15 @@
 #'
 tidy_xyz <- function(x, ...) {
   if (!is.matrix(x$z)) {
-    stop("To tidy an xyz list, `z` must be a matrix.", call. = FALSE)
+    cli::cli_abort("{.arg z} must be a matrix.")
   }
 
   if (length(x$x) != nrow(x$z) || length(x$y) != ncol(x$z)) {
-    stop(
-      "To tidy an xyz list, the length of element `x` must equal the number ",
-      "the number of rows of element `z`, and the length of element `y` must ",
-      "equal the number of columns of element `z`.",
-      call. = FALSE
-    )
+    cli::cli_abort(c(
+      "To tidy an xyz list, the length of element {.code x} must equal the
+       number of rows of element {.code z}, and the length of element
+       {.code y} must equal the number of columns of element {.code z}."
+    ))
   }
 
   as_tibble(data.frame(

R/list.R

@@ -33,7 +33,7 @@ tidy.list <- function(x, ...) {
   } else if (all(svd_elems %in% names(x))) {
     tidy_svd(x, ...)
   } else {
-    stop("No tidy method recognized for this list.", call. = FALSE)
+    cli::cli_abort("No {.fn tidy} method recognized for this list.")
   }
 }
 
@@ -45,6 +45,6 @@ glance.list <- function(x, ...) {
   if (all(optim_elems %in% names(x))) {
     glance_optim(x, ...)
   } else {
-    stop("No glance method recognized for this list.", call. = FALSE)
+    cli::cli_abort("No {.fn glance} method recognized for this list.")
   }
 }

R/lmtest.R

@@ -114,8 +114,16 @@ glance.coeftest <- function(x, ...) {
       logLik = sprintf("%.3f", logLik(x)), AIC = AIC(x),
       BIC = BIC(x), nobs = nobs(x)
     )
-    rlang::inform("Original model not retained as part of coeftest object. For additional model summary information (r.squared, df, etc.), consider passing `glance.coeftest()` an object where the underlying model has been saved, i.e.`lmtest::coeftest(..., save = TRUE)`.",
-      .frequency = "once", .frequency_id = "glance_coeftest_inform"
+    cli::cli_inform(
+      c(
+        "Original model not retained as part of coeftest object.",
+        "i" = "For additional model summary information (r.squared, df, etc.),
+           consider passing {.fn glance.coeftest} an object where the 
+           underlying model has been saved, i.e. 
+           {.code lmtest::coeftest(..., save = TRUE)}."
+      ),
+      .frequency = "once",
+      .frequency_id = "glance_coeftest_inform"
     )
   }
 

R/margins.R

@@ -87,7 +87,7 @@ tidy.margins <- function(x, conf.int = FALSE, conf.level = 0.95, ...) {
           error = function(e) {
             mutate(
               ., dplyr::across(dplyr::all_of(at_vars), as.character),
-              message("Warning: `at.value` column coerced to character.")
+              cli::cli_warn("The {.field at.value} column was coerced to character.")
             ) %>%
               tidyr::pivot_longer(dplyr::all_of(at_vars), names_to = "at.variable", values_to = "at.value")
           }

R/mass-polr.R

@@ -70,8 +70,10 @@ tidy.polr <- function(x, conf.int = FALSE, conf.level = 0.95,
     if (length(p) == length(terms)) {
       ret <- dplyr::left_join(ret, tibble::tibble(term = terms, p.value = p), by = "term")
     } else {
-      message("p-values can presently only be returned for models that contain
-              no categorical variables with more than two levels")
+      cli::cli_inform(
+        "p-values can presently only be returned for models that contain
+         no categorical variables with more than two levels."
+      )
       ret$p.value <- NA
     }
   }

R/mclust.R

@@ -107,7 +107,7 @@ augment.Mclust <- function(x, data = NULL, ...) {
   if (is.null(data)) {
     data <- x$data
   } else if (!(is.data.frame(data) || is.matrix(data))) {
-    stop("`data` must be a data frame or matrix.", call. = FALSE)
+    cli::cli_abort("{.arg data} must be a data frame or matrix.")
   }
 
   as_augment_tibble(data) %>%

R/mediation.R

@@ -36,10 +36,11 @@ tidy.mediate <- function(x, conf.int = FALSE, conf.level = .95, ...) {
   check_ellipses("exponentiate", "tidy", "mediate", ...)
 
   if (inherits(x, "psych")) {
-    stop(
-      "No tidy method for objects of class `mediate` from the `psych` package. ",
-      "The `tidy.mediate` method is intended for `mediate` objects from the `mediation` package."
-    )
+    cli::cli_abort(c(
+      "No tidy method for objects of class {.cls mediate} from the {.pkg psych} package.",
+      "i" = "The {.fn tidy.mediate} method is intended for {.cls mediate} objects 
+             from the {.pkg mediation} package."
+    ))
   }
 
   d0 <- d1 <- z0 <- z1 <- d0.sims <- d1.sims <- z0.sims <- NULL