Merge pull request #1176 from lionel-/cli-errors

Format condition messages with cli

DESCRIPTION

@@ -25,7 +25,7 @@ Depends:
 Imports:
     utils
 Suggests:
-    cli,
+    cli (>= 2.5.0),
     covr,
     crayon,
     fs,

NAMESPACE

@@ -266,7 +266,6 @@ export(fn_env)
 export(fn_fmls)
 export(fn_fmls_names)
 export(fn_fmls_syms)
-export(format_bullets)
 export(format_error_bullets)
 export(frame_position)
 export(friendly_type)

NEWS.md

@@ -1,5 +1,12 @@
 # rlang (development version)
 
+* Errors, warnings, and messages generated from rlang are now
+  formatted with cli. This means in practice that long lines are
+  width-wrapped to the terminal size and user themes are applied.
+  This is currently only the case for rlang messages. No formatting is
+  applied when `abort()`, `warn()`, and `inform()` are called from
+  another namespace.
+
 * Added `compat-cli.R` file to format message elements consistently
   with cli in zero-deps packages.
 
@@ -88,15 +95,13 @@
 
 * `friendly_type()` is deprecated and `as_pairlist()` is defunct.
 
-* Updated `env_print()` to use `format_bullets()` and consistent
+* Updated `env_print()` to use `format_error_bullets()` and consistent
   tidyverse style (#1154).
 
 * `set_names()` now recycles names of size 1 to the size of the input,
   following the tidyverse recycling rules.
 
-* `format_error_bullets()` has been renamed to `format_bullets()`.
-
-* `format_bullets()` now treats:
+* `format_error_bullets()` now treats:
 
   - Unnamed elements as unindented line breaks (#1130)
   - Elements named `"v"` as green ticks (@rossellhayes)
@@ -200,7 +205,7 @@
 * `format_error_bullets()` is no longer experimental. The `message`
   arguments of `abort()`, `warn()`, and `inform()` are automatically
   passed to that function to make it easy to create messages with
-  regular, info, and error bullets. See `?format_bullets` for
+  regular, info, and error bullets. See `?format_error_bullets` for
   more information.
 
 * New `zap_srcref()` function to recursively remove source references

R/cnd-abort.R

@@ -17,7 +17,6 @@
 #' kind that is signalled with `Ctrl-C`. It is currently not possible
 #' to create custom interrupt condition objects.
 #'
-#'
 #' @section Backtrace:
 #'
 #' Unlike `stop()` and `warning()`, these functions don't include call
@@ -60,7 +59,7 @@
 #'
 #' @inheritParams cnd
 #' @param message The message to display. Character vectors are
-#'   formatted with [format_bullets()]. The first element
+#'   formatted with [format_error_bullets()]. The first element
 #'   defines a message header and the rest of the vector defines
 #'   bullets. Bullets named `i` and `x` define info and error bullets
 #'   respectively, with special Unicode and colour formatting applied
@@ -166,7 +165,7 @@ abort <- function(message = NULL,
   }
 
   message <- validate_signal_message(message, class)
-  message <- collapse_cnd_message(message)
+  message <- cli_format_error(message, caller_env())
 
   cnd <- error_cnd(class,
     ...,

R/cnd-message.R

@@ -104,7 +104,7 @@ cnd_footer.default <- function(cnd, ...) {
 #' Format bullets for error messages
 #'
 #' @description
-#' `format_bullets()` takes a character vector and returns a single
+#' `format_error_bullets()` takes a character vector and returns a single
 #' string (or an empty vector if the input is empty). The elements of
 #' the input vector are assembled as a list of bullets, depending on
 #' their names:
@@ -134,29 +134,29 @@ cnd_footer.default <- function(cnd, ...) {
 #'   single space `" "` trigger a line break from the previous bullet.
 #' @examples
 #' # All bullets
-#' writeLines(format_bullets(c("foo", "bar")))
+#' writeLines(format_error_bullets(c("foo", "bar")))
 #'
 #' # This is equivalent to
-#' writeLines(format_bullets(set_names(c("foo", "bar"), "*")))
+#' writeLines(format_error_bullets(set_names(c("foo", "bar"), "*")))
 #'
 #' # Supply named elements to format info, cross, and tick bullets
-#' writeLines(format_bullets(c(i = "foo", x = "bar", v = "baz", "*" = "quux")))
+#' writeLines(format_error_bullets(c(i = "foo", x = "bar", v = "baz", "*" = "quux")))
 #'
 #' # An unnamed element breaks the line
-#' writeLines(format_bullets(c(i = "foo\nbar")))
+#' writeLines(format_error_bullets(c(i = "foo\nbar")))
 #'
 #' # A " " element breaks the line within a bullet (with indentation)
-#' writeLines(format_bullets(c(i = "foo", " " = "bar")))
+#' writeLines(format_error_bullets(c(i = "foo", " " = "bar")))
 #' @export
-format_bullets <- function(x) {
+format_error_bullets <- function(x) {
   if (!length(x)) {
     return(x)
   }
 
   nms <- names(x)
 
   # Treat unnamed vectors as all bullets
-  if (is_null(nms) || all(nms == "")) {
+  if (is_null(nms)) {
     bullets <- rep_along(x, bullet())
     return(paste(bullets, x, sep = " ", collapse = "\n"))
   }
@@ -182,14 +182,117 @@ format_bullets <- function(x) {
   paste0(bullets, x, collapse = "\n")
 }
 
-collapse_cnd_message <- function(x) {
-  if (length(x) > 1L) {
-    paste(
-      x[[1]],
-      format_bullets(x[-1]),
-      sep = "\n"
+cli_format_message <- function(x, env = caller_env()) {
+  # No-op for the empty string, e.g. for `abort("", class = "foo")`
+  # and a `conditionMessage.foo()` method
+  if (is_string(x, "") || inherits(x, "AsIs")) {
+    return(x)
+  }
+
+  orig <- x
+
+  # Interpret unnamed vectors as bullets
+  if (is_null(names(x))) {
+    if (length(x) > 1) {
+      x <- set_names(x, "*")
+      names(x)[[1]] <- ""
+    } else {
+      x <- set_names(x, names2(x))
+    }
+  } 
+
+  out <- switch(
+    use_cli_format(env),
+    partial = cli::format_message(cli_escape(x)),
+    full = cli::format_message(x, env),
+    format_error_bullets(x)
+  )
+
+  str_restore(out, orig)
+}
+
+cli_format_error <- function(x, env = caller_env()) {
+  if (is_string(x, "") || inherits(x, "AsIs")) {
+    return(x)
+  }
+  switch(
+    use_cli_format(env),
+    partial = str_restore(cli::format_error(cli_escape(x)), x),
+    full = str_restore(cli::format_error(x, env), x),
+    cli_format_message(x, env)
+  )
+}
+
+cli_format_warning <- function(x, env = caller_env()) {
+  if (is_string(x, "") || inherits(x, "AsIs")) {
+    return(x)
+  }
+  switch(
+    use_cli_format(env),
+    partial = str_restore(cli::format_warning(cli_escape(x)), x),
+    full = str_restore(cli::format_warning(x, env), x),
+    cli_format_message(x, env)
+  )
+}
+
+str_restore <- function(x, to) {
+  to <- to[1]
+  to[[1]] <- x
+  to
+}
+cli_escape <- function(x) {
+  gsub("\\}", "}}", gsub("\\{", "{{", x))
+}
+
+use_cli_format <- function(env) {
+  # Internal option to disable cli in case of recursive errors
+  if (is_true(peek_option("rlang:::disable_cli"))) {
+    return(FALSE)
+  }
+
+  # Formatting with cli is opt-in for now
+  default <- FALSE
+
+  last <- topenv(env)
+
+  # Search across load-all'd environments
+  if (identical(last, global_env()) && "devtools_shims" %in% search()) {
+    last <- empty_env()
+  }
+
+  flag <- env_get(
+    env,
+    ".rlang_use_cli_format",
+    default = default,
+    inherit = TRUE,
+    last = last
+  )
+
+  if (is_string(flag, "try")) {
+    if (has_cli_format) {
+      return("partial")
+    } else {
+      return("fallback")
+    }
+  }
+
+  if (!is_bool(flag)) {
+    abort("`.rlang_use_cli_format` must be a logical value.")
+  }
+
+  if (flag && !has_cli_format) {
+    with_options(
+      "rlang:::disable_cli" = TRUE,
+      abort(c(
+        "`.rlang_use_cli_format` is set to `TRUE` but cli is not installed.",
+        "i" = "The package author should add `cli` to their `Imports`."
+      ))
     )
+  }
+
+  if (flag) {
+    "full"
   } else {
-    x
+    "fallback"
   }
 }

R/cnd-signal.R

@@ -107,7 +107,7 @@ warn <- function(message = NULL,
   validate_signal_args(.subclass)
 
   message <- validate_signal_message(message, class)
-  message <- collapse_cnd_message(message)
+  message <- cli_format_warning(message, caller_env())
 
   .frequency <- arg_match0(.frequency, c("always", "regularly", "once"))
 
@@ -147,7 +147,8 @@ inform <- function(message = NULL,
   }
 
   message <- message %||% ""
-  message <- collapse_cnd_message(message)
+
+  message <- cli_format_message(message, caller_env())
   message <- add_message_freq(message, .frequency, "message")
   message <- paste0(message, "\n")
 
@@ -162,9 +163,12 @@ inform <- function(message = NULL,
 }
 #' @rdname abort
 #' @export
-signal <- function(message, class, ..., .subclass = deprecated()) {
+signal <- function(message,
+                   class,
+                   ...,
+                   .subclass = deprecated()) {
   validate_signal_args(.subclass)
-  message <- collapse_cnd_message(message)
+  message <- cli_format_message(message, caller_env())
   cnd <- cnd(class, ..., message = message)
   cnd_signal(cnd)
 }

R/compat-linked-version.R

@@ -54,7 +54,7 @@ check_linked_version <- local({
     msg <- c(msg, howto_reinstall_msg(pkg))
 
     if (with_rlang) {
-      msg <- paste(header, rlang::format_bullets(msg), sep = "\n")
+      msg <- paste(header, rlang::format_error_bullets(msg), sep = "\n")
       rlang::abort(msg)
     } else {
       msg <- paste(c(header, msg), collapse = "\n")

R/dots.R

@@ -450,27 +450,13 @@ abort_dots_homonyms <- function(dots, dups) {
     abort("Internal error: Expected dots duplicates")
   }
 
-  if (dups_n == 1L) {
-    nm <- dups_nms
-    enum <- homonym_enum(nm, dups_all, nms)
-    pos_msg <- sprintf(
-      "We found multiple arguments named `%s` at positions %s",
-      nm,
-      enum
-    )
-    abort(paste_line(
-      "Arguments can't have the same name.",
-      pos_msg
-    ))
-  }
-
   enums <- map(dups_nms, homonym_enum, dups_all, nms)
-  line <- "* Multiple arguments named `%s` at positions %s"
-  enums_lines <- map2(dups_nms, enums, sprintf, fmt = line)
+  line <- "Multiple arguments named `%s` at positions %s."
+  enums_lines <- map2_chr(dups_nms, enums, sprintf, fmt = line)
 
-  abort(paste_line(
-    "Arguments can't have the same name. We found these problems:",
-    !!!enums_lines
+  abort(c(
+    "Arguments can't have the same name.",
+    set_names(enums_lines, "x")
   ))
 }
 

R/env.R

@@ -703,7 +703,7 @@ env_print <- function(env = caller_env()) {
       types <- c(types, sprintf("... with %s more bindings", n_other))
     }
 
-    writeLines(format_bullets(types))
+    writeLines(format_error_bullets(types))
   }
 
   invisible(env)

R/lifecycle-retired.R

@@ -2133,14 +2133,3 @@ env_bury <- function(.env, ...) {
   env_ <- child_env(env_, ...)
   set_env(.env, env_)
 }
-
-#' Format error bullets
-#' @description
-#' `r lifecycle::badge("deprecated")`
-#' `format_error_bullets()` has been renamed to [format_bullets()].
-#' @inheritParams format_bullets
-#' @keywords internal
-#' @export
-format_error_bullets <- function(x) {
-  format_bullets(x)
-}

R/rlang.R

@@ -7,3 +7,5 @@ on_load({
     "dplyr (>= 0.8.0)"
   )
 })
+
+.rlang_use_cli_format <- "try"

R/utils.R

@@ -222,10 +222,10 @@ pad_spaces <- function(x, left = TRUE) {
 
 # Import symbols from cli if available
 has_cli <- FALSE
-has_cli_bullet <- FALSE
+has_cli_format <- FALSE
 on_load({
   has_cli <- is_installed("cli")
-  # TODO: detect new-style cli bullet
+  has_cli_format <- is_installed("cli", version = "2.5.0")
 })
 
 info <- function() {
@@ -245,7 +245,7 @@ bullet <- function() {
 
   # Use small bullet if cli is too old.
   # See https://github.com/r-lib/cli/issues/241
-  if (!has_cli_bullet && !is_string(x, "*")) {
+  if (!has_cli_format && !is_string(x, "*")) {
     x <- "\u2022"
   }
 

_pkgdown.yml

@@ -82,7 +82,7 @@ reference:
       - inform
       - signal
       - cnd_message
-      - format_bullets
+      - format_error_bullets
       - trace_back
       - with_abort
       - entrace