Update errors, warnings, and messages to cli (#4796)

Author: thomasp85

R/aes-evaluation.r

@@ -122,7 +122,7 @@ is_calculated <- function(x) {
   } else if (is.pairlist(x)) {
     FALSE
   } else {
-    abort(glue("Unknown input: {class(x)[1]}"))
+    cli::cli_abort("Unknown input: {.cls {class(x)[1]}}")
   }
 }
 is_scaled <- function(x) {
@@ -170,7 +170,7 @@ strip_dots <- function(expr, env, strip_pronoun = FALSE) {
     # For list of aesthetics
     lapply(expr, strip_dots, env = env, strip_pronoun = strip_pronoun)
   } else {
-    abort(glue("Unknown input: {class(expr)[1]}"))
+    cli::cli_abort("Unknown input: {.cls {class(expr)[1]}}")
   }
 }
 

R/aes.r

@@ -113,7 +113,7 @@ new_aesthetic <- function(x, env = globalenv()) {
 }
 new_aes <- function(x, env = globalenv()) {
   if (!is.list(x)) {
-    abort("`x` must be a list")
+    cli::cli_abort("{.arg x} must be a list")
   }
   x <- lapply(x, new_aesthetic, env = env)
   structure(x, class = "uneval")
@@ -179,8 +179,7 @@ rename_aes <- function(x) {
   names(x) <- standardise_aes_names(names(x))
   duplicated_names <- names(x)[duplicated(names(x))]
   if (length(duplicated_names) > 0L) {
-    duplicated_message <- paste0(unique(duplicated_names), collapse = ", ")
-    warn(glue("Duplicated aesthetics after name standardisation: {duplicated_message}"))
+    cli::cli_warn("Duplicated aesthetics after name standardisation: {.field {unique(duplicated_names)}}")
   }
   x
 }
@@ -283,7 +282,7 @@ aes_ <- function(x, y, ...) {
     } else if (is.call(x) || is.name(x) || is.atomic(x)) {
       new_aesthetic(x, caller_env)
     } else {
-      abort("Aesthetic must be a one-sided formula, call, name, or constant.")
+      cli::cli_abort("Aesthetic must be a one-sided formula, call, name, or constant.")
     }
   }
   mapping <- lapply(mapping, as_quosure_aes)
@@ -351,7 +350,7 @@ aes_auto <- function(data = NULL, ...) {
 
   # detect names of data
   if (is.null(data)) {
-    abort("aes_auto requires data.frame or names of data.frame.")
+    cli::cli_abort("{.fn aes_auto} requires a {.cls data.frame} or names of data.frame.")
   } else if (is.data.frame(data)) {
     vars <- names(data)
   } else {
@@ -400,7 +399,10 @@ warn_for_aes_extract_usage_expr <- function(x, data, env = emptyenv()) {
   if (is_call(x, "[[") || is_call(x, "$")) {
     if (extract_target_is_likely_data(x, data, env)) {
       good_usage <- alternative_aes_extract_usage(x)
-      warn(glue("Use of `{format(x)}` is discouraged. Use `{good_usage}` instead."))
+      cli::cli_warn(c(
+        "Use of {.code {format(x)}} is discouraged.",
+        "i" = "Use {.code {good_usage}} instead."
+      ))
     }
   } else if (is.call(x)) {
     lapply(x, warn_for_aes_extract_usage_expr, data, env)
@@ -414,7 +416,7 @@ alternative_aes_extract_usage <- function(x) {
   } else if (is_call(x, "$")) {
     as.character(x[[3]])
   } else {
-    abort(glue("Don't know how to get alternative usage for `{format(x)}`"))
+    cli::cli_abort("Don't know how to get alternative usage for {.var {x}}")
   }
 }
 

R/annotation-custom.r

@@ -71,7 +71,7 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom,
   draw_panel = function(data, panel_params, coord, grob, xmin, xmax,
                         ymin, ymax) {
     if (!inherits(coord, "CoordCartesian")) {
-      abort("annotation_custom only works with Cartesian coordinates")
+      cli::cli_abort("{.fn annotation_custom} only works with {.fn coord_cartesian}")
     }
     corners <- new_data_frame(list(x = c(xmin, xmax), y = c(ymin, ymax)), n = 2)
     data <- coord$transform(corners, panel_params)

R/annotation-map.r

@@ -59,13 +59,13 @@ NULL
 annotation_map <- function(map, ...) {
   # Get map input into correct form
   if (!is.data.frame(map)) {
-    abort("`map` must be a data.frame")
+    cli::cli_abort("{.arg map} must be a {.cls data.frame}")
   }
   if (!is.null(map$lat)) map$y <- map$lat
   if (!is.null(map$long)) map$x <- map$long
   if (!is.null(map$region)) map$id <- map$region
   if (!all(c("x", "y", "id") %in% names(map))) {
-    abort("`map`must have the columns `x`, `y`, and `id`")
+    cli::cli_abort("{.arg map} must have the columns {.col x}, {.col y}, and {.col id}")
   }
 
   layer(

R/annotation-raster.r

@@ -74,7 +74,7 @@ GeomRasterAnn <- ggproto("GeomRasterAnn", Geom,
   draw_panel = function(data, panel_params, coord, raster, xmin, xmax,
                         ymin, ymax, interpolate = FALSE) {
     if (!inherits(coord, "CoordCartesian")) {
-      abort("annotation_raster only works with Cartesian coordinates")
+      cli::cli_abort("{.fn annotation_raster} only works with {.fn coord_cartesian}")
     }
     corners <- new_data_frame(list(x = c(xmin, xmax), y = c(ymin, ymax)), n = 2)
     data <- coord$transform(corners, panel_params)

R/annotation.r

@@ -43,9 +43,9 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL,
                      na.rm = FALSE) {
 
   if (geom %in% c("abline", "hline", "vline")) {
-    warn(c(
-      glue("`annotate()` does not support `geom = \"{geom}\"`."),
-      i = glue("Please use `geom_{geom}()` directly instead.")
+    cli::cli_warn(c(
+      "{.arg geom} must not be {.val {geom}}.",
+      "i" = "Please use {.fn {paste0('geom_', geom)}} directly instead."
     ))
   }
 
@@ -67,9 +67,8 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL,
   # if there is still more than one unique length, we error out
   if (length(n) > 1L) {
     bad <- lengths != 1L
-    details <- paste(names(aesthetics)[bad], " (", lengths[bad], ")",
-      sep = "", collapse = ", ")
-    abort(glue("Unequal parameter lengths: {details}"))
+    details <- paste0(names(aesthetics)[bad], " (", lengths[bad], ")")
+    cli::cli_abort("Unequal parameter lengths: {details}")
   }
 
   data <- new_data_frame(position, n = n)

R/autolayer.r

@@ -15,9 +15,5 @@ autolayer <- function(object, ...) {
 
 #' @export
 autolayer.default <- function(object, ...) {
-  abort(glue(
-    "Objects of type ",
-    glue_collapse(class(object), "/"),
-    " not supported by autolayer."
-  ))
+  cli::cli_abort("No autolayer method avialable for {.cls {class(object)[1]}} objects")
 }

R/autoplot.r

@@ -15,10 +15,9 @@ autoplot <- function(object, ...) {
 
 #' @export
 autoplot.default <- function(object, ...) {
-  abort(glue(
-    "Objects of type ",
-    glue_collapse(class(object), "/"),
-    " not supported by autoplot."
+  cli::cli_abort(c(
+    "Objects of class {.cls {class(object)[[1]]}} are not supported by autoplot.",
+    "i" = "have you loaded the required package?"
   ))
 }
 

R/axis-secondary.R

@@ -122,7 +122,9 @@ is.sec_axis <- function(x) {
 set_sec_axis <- function(sec.axis, scale) {
   if (!is.waive(sec.axis)) {
     if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis)
-    if (!is.sec_axis(sec.axis)) abort("Secondary axes must be specified using 'sec_axis()'")
+    if (!is.sec_axis(sec.axis)) {
+      cli::cli_abort("Secondary axes must be specified using {.fn sec_axis}")
+    }
     scale$secondary.axis <- sec.axis
   }
   return(scale)
@@ -159,8 +161,12 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
 
   # Inherit settings from the primary axis/scale
   init = function(self, scale) {
-    if (self$empty()) return()
-    if (!is.function(self$trans)) abort("transformation for secondary axes must be a function")
+    if (self$empty()) {
+      return()
+    }
+    if (!is.function(self$trans)) {
+      cli::cli_abort("Transformation for secondary axes must be a function")
+    }
     if (is.derived(self$name) && !is.waive(scale$name)) self$name <- scale$name
     if (is.derived(self$breaks)) self$breaks <- scale$breaks
     if (is.waive(self$breaks)) self$breaks <- scale$trans$breaks
@@ -188,7 +194,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
 
     # Test for monotonicity
     if (length(unique(sign(diff(full_range)))) != 1)
-      abort("transformation for secondary axes must be monotonic")
+      cli::cli_abort("Transformation for secondary axes must be monotonic")
   },
 
   break_info = function(self, range, scale) {

R/bench.r

@@ -16,7 +16,7 @@ benchplot <- function(x) {
   x <- enquo(x)
   construct <- system.time(x <- eval_tidy(x))
   if (!inherits(x, "ggplot")) {
-    abort("`x` must be a ggplot object")
+    cli::cli_abort("{.arg x} must be a {.cls ggplot} object")
   }
 
   build <- system.time(data <- ggplot_build(x))

R/bin.R

@@ -1,6 +1,8 @@
 bins <- function(breaks, closed = "right",
                  fuzz = 1e-08 * stats::median(diff(breaks))) {
-  if (!is.numeric(breaks)) abort("`breaks` must be a numeric vector")
+  if (!is.numeric(breaks)) {
+    cli::cli_abort("{.arg breaks} must be a numeric vector")
+  }
   closed <- arg_match0(closed, c("right", "left"))
 
   breaks <- sort(breaks)
@@ -50,18 +52,22 @@ bin_breaks <- function(breaks, closed = c("right", "left")) {
 
 bin_breaks_width <- function(x_range, width = NULL, center = NULL,
                              boundary = NULL, closed = c("right", "left")) {
-  if (length(x_range) != 2) abort("`x_range` must have two elements")
+  if (length(x_range) != 2) {
+    cli::cli_abort("{.arg x_range} must have two elements")
+  }
 
   # if (length(x_range) == 0) {
   #   return(bin_params(numeric()))
   # }
-  if (!(is.numeric(width) && length(width) == 1)) abort("`width` must be a numeric scalar")
+  if (!(is.numeric(width) && length(width) == 1)) {
+    cli::cli_abort("{.arg width} must be a number")
+  }
   if (width <= 0) {
-    abort("`binwidth` must be positive")
+    cli::cli_abort("{.arg binwidth} must be positive")
   }
 
   if (!is.null(boundary) && !is.null(center)) {
-    abort("Only one of 'boundary' and 'center' may be specified.")
+    cli::cli_abort("Only one of {.arg boundary} and {.arg center} may be specified.")
   } else if (is.null(boundary)) {
     if (is.null(center)) {
       # If neither edge nor center given, compute both using tile layer's
@@ -87,7 +93,10 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL,
   max_x <- x_range[2] + (1 - 1e-08) * width
 
   if (isTRUE((max_x - origin) / width > 1e6)) {
-    abort("The number of histogram bins must be less than 1,000,000.\nDid you make `binwidth` too small?")
+    cli::cli_abort(c(
+      "The number of histogram bins must be less than 1,000,000.",
+      "i" = "Did you make {.arg binwidth} too small?"
+    ))
   }
   breaks <- seq(origin, max_x, width)
 
@@ -102,11 +111,13 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL,
 
 bin_breaks_bins <- function(x_range, bins = 30, center = NULL,
                             boundary = NULL, closed = c("right", "left")) {
-  if (length(x_range) != 2) abort("`x_range` must have two elements")
+  if (length(x_range) != 2) {
+    cli::cli_abort("{.arg x_range} must have two elements")
+  }
 
   bins <- as.integer(bins)
   if (bins < 1) {
-    abort("Need at least one bin.")
+    cli::cli_abort("{.arg bins} must be 1 or greater")
   } else if (zero_range(x_range)) {
     # 0.1 is the same width as the expansion `default_expansion()` gives for 0-width data
     width <- 0.1
@@ -125,7 +136,9 @@ bin_breaks_bins <- function(x_range, bins = 30, center = NULL,
 # Compute bins ------------------------------------------------------------
 
 bin_vector <- function(x, bins, weight = NULL, pad = FALSE) {
-  if (!is_bins(bins)) abort("`bins` must be a ggplot2_bins object")
+  if (!is_bins(bins)) {
+    cli::cli_abort("{.arg bins} must be a {.cls ggplot2_bins} object")
+  }
 
   if (all(is.na(x))) {
     return(bin_out(length(x), NA, NA, xmin = NA, xmax = NA))

R/compat-plyr.R

@@ -19,7 +19,7 @@ unrowname <- function(x) {
   } else if (is.matrix(x)) {
     dimnames(x)[1] <- list(NULL)
   } else {
-    abort("Can only remove rownames from data.frame and matrix objects")
+    cli::cli_abort("Can only remove rownames from {.cls data.frame} and {.cls matrix} objects")
   }
   x
 }
@@ -193,7 +193,7 @@ revalue <- function(x, replace) {
     lev[match(names(replace), lev)] <- replace
     levels(x) <- lev
   } else if (!is.null(x)) {
-    abort("x is not a factor or character vector")
+    cli::cli_abort("{.arg x} must be a factor or character vector")
   }
   x
 }
@@ -239,14 +239,16 @@ as.quoted <- function(x, env = parent.frame()) {
   } else if (is.call(x)) {
     as.list(x)[-1]
   } else {
-    abort("Only knows how to quote characters, calls, and formula")
+    cli::cli_abort("Must be a character vector, call, or formula")
   }
   attributes(x) <- list(env = env, class = 'quoted')
   x
 }
 # round a number to a given precision
 round_any <- function(x, accuracy, f = round) {
-  if (!is.numeric(x)) abort("`x` must be numeric")
+  if (!is.numeric(x)) {
+    cli::cli_abort("{.arg x} must be numeric")
+  }
   f(x/accuracy) * accuracy
 }
 #' Bind data frames together by common column names

R/coord-.r

@@ -63,28 +63,28 @@ Coord <- ggproto("Coord",
 
   render_fg = function(panel_params, theme) element_render(theme, "panel.border"),
 
-  render_bg = function(panel_params, theme) {
-    abort("Not implemented")
+  render_bg = function(self, panel_params, theme) {
+    cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_bg} method")
   },
 
-  render_axis_h = function(panel_params, theme) {
-    abort("Not implemented")
+  render_axis_h = function(self, panel_params, theme) {
+    cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_axis_h} method")
   },
 
-  render_axis_v = function(panel_params, theme) {
-    abort("Not implemented")
+  render_axis_v = function(self, panel_params, theme) {
+    cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_axis_v} method")
   },
 
   # transform range given in transformed coordinates
   # back into range in given in (possibly scale-transformed)
   # data coordinates
   backtransform_range = function(self, panel_params) {
-    abort("Not implemented")
+    cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn backtransform_range} method")
   },
 
   # return range stored in panel_params
-  range = function(panel_params) {
-    abort("Not implemented")
+  range = function(self, panel_params) {
+    cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn range} method")
   },
 
   setup_panel_params = function(scale_x, scale_y, params = list()) {