Replace base R message/warning/stop with {cli}

.lintr

@@ -2,7 +2,16 @@ linters: linters_with_tags(
     tags = NULL, # include all linters
     implicit_integer_linter = NULL,
     extraction_operator_linter = NULL,
-    undesirable_function_linter = NULL,
+    keyword_quote_linter = NULL,
+    undesirable_function_linter(
+      fun = c(
+         # Base messaging
+         "message" = "use cli::cli_inform()",
+         "warning" = "use cli::cli_warn()",
+         "stop" = "use cli::cli_abort()",
+         "stopifnot" = "use cli::cli_abort()"
+      )
+    ),
     function_argument_linter = NULL,
     indentation_linter = NULL,
     object_name_linter = NULL,

DESCRIPTION

@@ -100,6 +100,7 @@ Depends:
     R (>= 3.5.0)
 Imports:
     checkmate,
+    cli,
     data.table,
     futile.logger (>= 1.4),
     future,
@@ -148,7 +149,7 @@ Encoding: UTF-8
 Language: en-GB
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.2.9000
 NeedsCompilation: yes
 SystemRequirements: GNU make
        C++17

NAMESPACE

@@ -125,6 +125,11 @@ importFrom(checkmate,assert_string)
 importFrom(checkmate,assert_subset)
 importFrom(checkmate,test_data_frame)
 importFrom(checkmate,test_numeric)
+importFrom(cli,cli_abort)
+importFrom(cli,cli_inform)
+importFrom(cli,cli_warn)
+importFrom(cli,col_blue)
+importFrom(cli,col_red)
 importFrom(data.table,":=")
 importFrom(data.table,.N)
 importFrom(data.table,as.data.table)

NEWS.md

@@ -8,6 +8,7 @@
 
 ## Model changes
 
+- All functions now use the `{cli}` R package to signal errors, warnings, and messages. By @jamesmbaazam in #762 and reviewed by @<REVIEWER>.
 - `epinow()` now returns the "timing" output in a "time difference"" format that is easier to understand and work with. By @jamesmbaazam in #688 and reviewed by @sbfnk.
 - The interface for defining delay distributions has been generalised to also cater for continuous distributions
 - When defining probability distributions these can now be truncated using the `tolerance` argument

R/checks.R

@@ -61,6 +61,7 @@ check_reports_valid <- function(data,
 #' @param dist A `dist_spec` object.`
 #' @importFrom checkmate assert_class
 #' @importFrom rlang arg_match
+#' @importFrom cli cli_abort col_blue
 #' @return Called for its side effects.
 #' @keywords internal
 check_stan_delay <- function(dist) {
@@ -73,9 +74,12 @@ check_stan_delay <- function(dist) {
   if (
     !all(distributions %in% c("lognormal", "gamma", "fixed", "nonparametric"))
   ) {
-    stop(
-      "Distributions passed to the model need to be lognormal, gamma, fixed ",
-      "or nonparametric."
+    cli_abort(
+      c(
+       "!" = "Distributions passed to the model need to be
+        {col_blue(\"lognormal\")}, {col_blue(\"gamma\")},
+        {col_blue(\"fixed\")}, or {col_blue(\"nonparametric\")}."
+      )
     )
   }
   # Check that `dist` has parameters that are either numeric or normal
@@ -91,10 +95,13 @@ check_stan_delay <- function(dist) {
     }
   }))
   if (!all(numeric_or_normal)) {
-    stop(
-      "Delay distributions passed to the model need to have parameters that ",
-      "are either numeric or normally distributed with numeric parameters ",
-      "and infinite maximum."
+    cli_abort(
+      c(
+        "!" = "Delay distributions passed to the model need to have parameters
+        that are either {col_blue(\"numeric\")} or
+        {col_blue(\"normally distributed\")} with {col_blue(\"numeric\")}
+        parameters and {col_blue(\"infinite maximum\")}."
+      )
     )
   }
   if (is.null(attr(dist, "tolerance"))) {
@@ -103,9 +110,12 @@ check_stan_delay <- function(dist) {
   assert_numeric(attr(dist, "tolerance"), lower = 0, upper = 1)
   # Check that `dist` has a finite maximum
   if (any(is.infinite(max(dist))) && !(attr(dist, "tolerance") > 0)) {
-    stop(
-      "All distribution passed to the model need to have a finite maximum,",
-      "which can be achieved either by setting `max` or non-zero `tolerance`."
+    cli_abort(
+      c(
+        "i" = "All distribution passed to the model need to have a
+      {col_blue(\"finite maximum\")}, which can be achieved either by
+      setting {.var max} or non-zero {.var tolerance}."
+      )
     )
   }
 }
@@ -117,19 +127,21 @@ check_stan_delay <- function(dist) {
 #' @param pmf A probability mass function vector
 #' @param span The number of consecutive indices in the tail to check
 #' @param tol The value which to consider the tail as sparse
+#' @importFrom cli cli_warn col_blue
 #'
 #' @return Called for its side effects.
 #' @keywords internal
 check_sparse_pmf_tail <- function(pmf, span = 5, tol = 1e-6) {
   if (all(pmf[(length(pmf) - span + 1):length(pmf)] < tol)) {
-    warning(
-      sprintf(
-        "The PMF tail has %s consecutive values smaller than %s.",
-        span, tol
+    cli_warn(
+      c(
+        "!" = "The PMF tail has {col_blue(span)} consecutive value{?s} smaller
+        than {col_blue(tol)}.",
+        "i" = "This will drastically increase run times with very small
+        increases in accuracy. Consider increasing the tail values of the PMF."
       ),
-      " This will drastically increase run time with very small increases ",
-      "in accuracy. Consider increasing the tail values of the PMF.",
-      call. = FALSE
+      .frequency = "regularly",
+      .frequency_id = "sparse_pmf_tail"
     )
   }
 }

R/create.R

@@ -246,6 +246,7 @@ create_future_rt <- function(future = c("latest", "project", "estimate"),
 #' breakpoints.
 #'
 #' @param horizon Numeric, forecast horizon.
+#' @importFrom cli cli_abort
 #'
 #' @seealso rt_settings
 #' @return A list of settings defining the time-varying reproduction number
@@ -285,7 +286,11 @@ create_rt_data <- function(rt = rt_opts(), breakpoints = NULL,
   # apply random walk
   if (rt$rw != 0) {
     if (is.null(breakpoints)) {
-      stop("breakpoints must be supplied when using random walk")
+      cli_abort(
+        c(
+          "!" = "breakpoints must be supplied when using random walk."
+        )
+      )
     }
 
     breakpoints <- seq_along(breakpoints)

R/deprecated.R

@@ -595,13 +595,18 @@ dist_skel <- function(n, dist = FALSE, cum = TRUE, model,
 #' removed.
 #' @return A `<dist_spec>` where probability masses below the threshold level
 #' have been removed
+#' @importFrom cli cli_abort
 #' @keywords internal
 apply_tolerance <- function(x, tolerance) {
   lifecycle::deprecate_warn(
     "1.6.0", "apply_tolerance()", "bound_dist()"
   )
   if (!is(x, "dist_spec")) {
-    stop("Can only apply tolerance to distributions in a <dist_spec>.")
+    cli_abort(
+      c(
+        "!" = "Can only apply tolerance to distributions in a {.cls dist_spec}."
+      )
+    )
   }
   y <- lapply(x, function(x) {
     if (x$distribution == "nonparametric") {