Use cli

R/arguments.R

@@ -8,11 +8,8 @@
   if (length(common_args) > 0) {
     args <- args[!(names(args) %in% common_args)]
     common_args <- paste0(common_args, collapse = ", ")
-    rlang::warn(
-      glue::glue(
-        "The following arguments cannot be manually modified ",
-        "and were removed: {common_args}."
-      )
+    cli::cli_warn(
+      "The arguments {common_args} cannot be manually modified and were removed."
     )
   }
   args
@@ -32,7 +29,7 @@
       none = rlang::expr(x),
       data.frame = rlang::expr(maybe_data_frame(x)),
       matrix = rlang::expr(maybe_matrix(x)),
-      rlang::abort(glue::glue("Invalid data type target: {target}."))
+      cli::cli_abort("Invalid data type target: {target}.")
     )
 
   fit_call <- make_call(
@@ -78,7 +75,7 @@
 set_args.cluster_spec <- function(object, ...) {
   the_dots <- enquos(...)
   if (length(the_dots) == 0) {
-    rlang::abort("Please pass at least one named argument.")
+    cli::cli_abort("Please pass at least one named argument.")
   }
   main_args <- names(object$args)
   new_args <- names(the_dots)

R/augment.R

@@ -31,7 +31,7 @@ augment.cluster_fit <- function(x, new_data, ...) {
       stats::predict(x, new_data = new_data)
     )
   } else {
-    rlang::abort(paste("Unknown mode:", x$spec$mode))
+    cli::cli_abort("Unknown mode: {x$spec$mode}")
   }
   as_tibble(ret)
 }

R/control.R

@@ -37,10 +37,10 @@ check_control <- function(x, call = rlang::caller_env()) {
     abs(x - round(x)) < tol
   }
   if (!int_check(x$verbosity)) {
-    rlang::abort("verbosity should be an integer.", call = call)
+    cli::cli_abort("verbosity should be an integer.", call = call)
   }
   if (!is.logical(x$catch)) {
-    rlang::abort("catch should be a logical.", call = call)
+    cli::cli_abort("catch should be a logical.", call = call)
   }
   x
 }

R/convert_data.R

@@ -42,7 +42,9 @@
   remove_intercept = TRUE
 ) {
   if (!(composition %in% c("data.frame", "matrix"))) {
-    rlang::abort("`composition` should be either 'data.frame' or 'matrix'.")
+    cli::cli_abort(
+      "{.arg composition} should be {.cls data.frame} or {.cls matrix}."
+    )
   }
 
   ## Assemble model.frame call from call arguments
@@ -59,7 +61,7 @@
 
   w <- as.vector(model.weights(mod_frame))
   if (!is.null(w) && !is.numeric(w)) {
-    rlang::abort("`weights` must be a numeric vector")
+    cli::cli_abort("The {.arg weights} must be a numeric vector.")
   }
 
   # TODO: Do we actually use the offset when fitting?
@@ -124,15 +126,11 @@
   good_args <- c("subset", "weights")
   good_names <- names(x) %in% good_args
   if (any(!good_names)) {
-    rlang::abort(
-      glue::glue(
-        "These argument(s) cannot be used to create the data: ",
-        glue::glue_collapse(
-          glue::glue("`{names(x)[!good_names]}`"),
-          sep = ", "
-        ),
-        ". Possible arguments are: ",
-        glue::glue_collapse(glue::glue("`{good_args}`"), sep = ", ")
+    cli::cli_abort(
+      c(
+        "The argument{?s} {.code {names(x)[!good_names]}} cannot be used
+        to create the data.",
+        "i" = "Possible arguments are: {.code {good_args}}."
       )
     )
   }
@@ -159,7 +157,7 @@
 #' @keywords internal
 .convert_x_to_form_fit <- function(x, weights = NULL, remove_intercept = TRUE) {
   if (is.vector(x)) {
-    rlang::abort("`x` cannot be a vector.")
+    cli::cli_abort("{.arg x} cannot be a vector.")
   }
 
   if (remove_intercept) {
@@ -182,10 +180,10 @@
 
   if (!is.null(weights)) {
     if (!is.numeric(weights)) {
-      rlang::abort("`weights` must be a numeric vector")
+      cli::cli_abort("The {.arg weights} must be a numeric vector.")
     }
     if (length(weights) != nrow(x)) {
-      rlang::abort(glue::glue("`weights` should have {nrow(x)} elements"))
+      cli::cli_abort("{.arg weights} should have {nrow(x)} elements.")
     }
   }
 
@@ -219,7 +217,9 @@
   composition = "data.frame"
 ) {
   if (!(composition %in% c("data.frame", "matrix"))) {
-    rlang::abort("`composition` should be either 'data.frame' or 'matrix'.")
+    cli::cli_abort(
+      "{.arg composition} should be either {.code data.frame} or {.code matrix}."
+    )
   }
 
   mod_terms <- object$terms

R/engines.R

@@ -42,11 +42,15 @@
         .groups = "drop"
       )
   if (nrow(info) == 0) {
-    rlang::abort(glue::glue("No known engines for `{cls}()`."), call = call)
+    cli::cli_abort("No known engines for {.fn {cls}}.", call = call)
   }
-  msg <- paste0(info$msg, collapse = ", ")
-  msg <- paste("Missing engine. Possible mode/engine combinations are:", msg)
-  rlang::abort(msg, call = call)
+  cli::cli_abort(
+    c(
+      "Missing engine.",
+      "i" = "Possible mode/engine combinations are: {info$msg}."
+    ),
+    call = call
+  )
 }
 
 load_libs <- function(x, quiet, attach = FALSE) {
@@ -86,11 +90,8 @@
     if (any(!is_inst)) {
       missing_pkg <- x$method$libs[!is_inst]
       missing_pkg <- paste0(missing_pkg, collapse = ", ")
-      rlang::abort(
-        glue::glue(
-          "This engine requires some package installs: ",
-          glue::glue_collapse(glue::glue("'{missing_pkg}'"), sep = ", ")
-        ),
+      cli::cli_abort(
+        "This engine requires installing {.pkg {missing_pkg}}.",
         call = call
       )
     }

R/extract.R

@@ -52,5 +52,5 @@
   if (any(names(x) == "fit")) {
     return(x$fit)
   }
-  rlang::abort("Internal error: The model fit does not have an engine fit.")
+  cli::cli_abort("Internal error: The model fit does not have an engine fit.")
 }

R/extract_cluster_assignment.R

@@ -69,10 +69,10 @@ extract_cluster_assignment <- function(object, ...) {
 
 #' @export
 extract_cluster_assignment.cluster_spec <- function(object, ...) {
-  rlang::abort(
-    paste(
+  cli::cli_abort(
+    c(
       "This function requires a fitted model.",
-      "Please use `fit()` on your cluster specification."
+      "i" = "Please use {.fn fit} on your cluster specification."
     )
   )
 }
@@ -121,20 +121,20 @@ extract_cluster_assignment.hclust <- function(
   args <- list(...)
 
   if (!is.null(args[["h"]])) {
-    rlang::abort(
-      paste(
-        "Using `h` argument is not supported.",
-        "Please use `cut_height` instead."
+    cli::cli_abort(
+      c(
+        "Using {.arg h} argument is not supported.",
+        "i" = "Please use {.arg cut_height} instead."
       ),
       call = call
     )
   }
 
   if (!is.null(args[["k"]])) {
-    rlang::abort(
-      paste(
-        "Using `k` argument is not supported.",
-        "Please use `num_clusters` instead."
+    cli::cli_abort(
+      c(
+        "Using {.arg k} argument is not supported.",
+        "i" = "Please use {.arg num_clusters} instead."
       ),
       call = call
     )
@@ -149,8 +149,8 @@ extract_cluster_assignment.hclust <- function(
   }
 
   if (is.null(num_clusters) && is.null(cut_height)) {
-    rlang::abort(
-      "Please specify either `num_clusters` or `cut_height`.",
+    cli::cli_abort(
+      "Please specify either {.arg num_clusters} or {.arg cut_height}.",
       call = call
     )
   }

R/extract_fit_summary.R

@@ -28,10 +28,10 @@ extract_fit_summary.cluster_spec <- function(
   ...,
   call = rlang::caller_env(n = 0)
 ) {
-  rlang::abort(
-    paste(
+  cli::cli_abort(
+    c(
       "This function requires a fitted model.",
-      "Please use `fit()` on your cluster specification."
+      "i" = "Please use {.fn fit} on your cluster specification."
     ),
     call = call
   )

R/extract_parameter_set_dials.R

@@ -36,11 +36,7 @@
       silent = TRUE
     )
     if (inherits(res, "try-error")) {
-      rlang::abort(
-        glue::glue(
-          "Error when calling {x$fun}(): {as.character(res)}"
-        )
-      )
+      cli::cli_abort("Error when calling {.fn {x$fun}}: {as.character(res)}")
     }
   } else {
     res <- NA

R/finalize.R

@@ -22,7 +22,7 @@
 #' @export
 finalize_model_tidyclust <- function(x, parameters) {
   if (!inherits(x, "cluster_spec")) {
-    rlang::abort("`x` should be a tidyclust model specification.")
+    cli::cli_abort("{.arg x} should be a tidyclust model specification.")
   }
   parsnip::check_final_param(parameters)
   pset <- hardhat::extract_parameter_set_dials(x)
@@ -46,7 +46,7 @@
 #' @export
 finalize_workflow_tidyclust <- function(x, parameters) {
   if (!inherits(x, "workflow")) {
-    rlang::abort("`x` should be a workflow")
+    cli::cli_abort("{.arg x} should be {.obj_type_friendly workflow}")
   }
   parsnip::check_final_param(parameters)
 

R/fit.R

@@ -93,7 +93,7 @@
   ...
 ) {
   if (object$mode == "unknown") {
-    rlang::abort("Please set the mode in the model specification.")
+    cli::cli_abort("Please set the mode in the model specification.")
   }
 
   control <- parsnip::condense_control(control, control_cluster())
@@ -103,13 +103,14 @@
     eng_vals <- possible_engines(object)
     object$engine <- eng_vals[1]
     if (control$verbosity > 0) {
-      rlang::warn(glue::glue("Engine set to `{object$engine}`."))
+      cli::cli_warn("Engine set to {.code {object$engine}}.")
     }
   }
 
   if (all(c("x", "y") %in% names(dots))) {
-    rlang::abort(
-      "`fit.cluster_spec()` is for the formula methods. Use `fit_xy()` instead."
+    cli::cli_abort(
+      "The {.fn fit.cluster_spec} function is for the formula methods. 
+      Use {.fn fit_xy} instead."
     )
   }
   cl <- match.call(expand.dots = TRUE)
@@ -159,7 +160,7 @@
         target = object$method$fit$interface,
         ...
       ),
-      rlang::abort(glue::glue("{interfaces} is unknown."))
+      cli::cli_abort("{interfaces} is unknown.")
     )
   model_classes <- class(res$fit)
   class(res) <- c(paste0("_", model_classes[1]), "cluster_fit")
@@ -176,24 +177,17 @@
   if (form_interface) {
     return("formula")
   }
-  rlang::abort("Error when checking the interface.")
+  cli::cli_abort("Error when checking the interface.")
 }
 
 inher <- function(x, cls, cl) {
   if (!is.null(x) && !inherits(x, cls)) {
     call <- match.call()
     obj <- deparse(call[["x"]])
     if (length(cls) > 1) {
-      rlang::abort(
-        glue::glue(
-          "`{obj}` should be one of the following classes: ",
-          glue::glue_collapse(glue::glue("'{cls}'"), sep = ", ")
-        )
-      )
+      cli::cli_abort("{.code {obj}} should be {.cls {cls}}.")
     } else {
-      rlang::abort(
-        glue::glue("`{obj}` should be a {cls} object")
-      )
+      cli::cli_abort("{.code {obj}} should be {.obj_type_friendly {cls}}.")
     }
   }
   invisible(x)
@@ -241,14 +235,14 @@
     control <- parsnip::condense_control(control, control_cluster())
 
     if (is.null(colnames(x))) {
-      rlang::abort("'x' should have column names.")
+      cli::cli_abort("{.arg x} should have column names.")
     }
 
     if (is.null(object$engine)) {
       eng_vals <- possible_engines(object)
       object$engine <- eng_vals[1]
       if (control$verbosity > 0) {
-        rlang::warn(glue::glue("Engine set to `{object$engine}`."))
+        cli::cli_warn("Engine set to {.code {object$engine}}.")
       }
     }
 
@@ -298,7 +292,7 @@
           control = control,
           ...
         ),
-        rlang::abort(glue::glue("{interfaces} is unknown."))
+        cli::cli_abort("{interfaces} is unknown.")
       )
     model_classes <- class(res$fit)
     class(res) <- c(paste0("_", model_classes[1]), "cluster_fit")
@@ -309,7 +303,7 @@
   sparse_ok <- allow_sparse(model)
   sparse_x <- inherits(x, "dgCMatrix")
   if (!sparse_ok && sparse_x) {
-    rlang::abort(
+    cli::cli_abort(
       "Sparse matrices not supported by this model/engine combination."
     )
   }
@@ -334,7 +328,7 @@
   if (df_interface) {
     return("data.frame")
   }
-  rlang::abort("Error when checking the interface")
+  cli::cli_abort("Error when checking the interface")
 }
 
 allow_sparse <- function(x) {

R/fit_helpers.R

@@ -70,7 +70,7 @@ form_x <- function(object, control, env, target = "none", ...) {
 
 x_x <- function(object, env, control, target = "none", y = NULL, ...) {
   if (!is.null(y) && length(y) > 0) {
-    rlang::abort("Outcomes are not used in `cluster_spec` objects.")
+    cli::cli_abort("Outcomes are not used in {.cls cluster_spec} objects.")
   }
   encoding_info <-
     modelenv::get_encoding(class(object)[1]) %>%

R/hier_clust.R

@@ -156,7 +156,7 @@
   args <- lapply(object$args, rlang::eval_tidy)
 
   if (all(is.numeric(args$num_clusters)) && any(args$num_clusters < 0)) {
-    rlang::abort("The number of centers should be >= 0.")
+    cli::cli_abort("The number of centers should be >= 0.")
   }
 
   invisible(object)