Remove {prettycode} dependency in favour of cli::code_highlight()

DESCRIPTION

@@ -19,7 +19,7 @@ URL: https://github.com/cynkra/constructive,
     https://cynkra.github.io/constructive/
 BugReports: https://github.com/cynkra/constructive/issues
 Imports: 
-    cli,
+    cli (>= 3.1.0),
     diffobj,
     methods,
     rlang (>= 1.0.0),
@@ -38,7 +38,6 @@ Suggests:
     knitr,
     lubridate,
     pixarfilms,
-    prettycode,
     R6,
     reprex,
     rmarkdown,

NEWS.md

@@ -1,5 +1,13 @@
 # constructive (development version)
 
+* `cli::code_highlight()` is now used to apply syntax highlighting to console
+  output, removing the dependency on {prettycode}.
+  * If you prefer not to use highlighting you can turn it off using
+    `options(constructive_pretty = FALSE)`. 
+  * The `style` argument of `print.constructive_code()` is deprecated in 
+    favour of the new argument `code_theme`.
+  * {cli} >= 3.1.0 is now required.
+
 # constructive 1.0.1
 
 * We fixed a typo that was breaking `.cstr_new_class(, commented = TRUE)`

R/abort.R

@@ -62,7 +62,7 @@
 describe <- function(x) {
   type <- typeof(x)
   code <- construct(x, check = FALSE)$code
-  code <- highlight_if_prettycode_installed(code)
+  code <- highlight_code(code)
   code <- paste(code, collapse = "\n")
   if (type %in% c("logical", "integer", "double", "complex", "character", "raw", "list")) {
     info <- sprintf("It has type '%s' and length %s:\n", typeof(x), length(x))

R/construct.R

@@ -303,20 +303,33 @@ print.constructive <- function(
 
 
 
-# this is  styler:::print.vertical with small tweaks:
-# * different default for `colored`
-# * fail rather than warn if colored is TRUE and not installed
-# * returns input invisibly
-
+#' Print code with syntax highlighting
+#'
+#' @param x The object to print
+#' @param ... Unused
+#' @param colored Whether to apply syntax highlighting. Set to `FALSE`, or use
+#'   `options(constructive_pretty = FALSE)` to turn off highlighting.
+#' @param code_theme Syntax highlighting theme passed to [cli::code_highlight()].
+#'   Setting `code_theme = list()` will remove all syntax highlighting, but
+#'   hyperlinks will remain if supported.
+#' @param style Deprecated in favour of `code_theme`
+#' @keywords internal
 #' @export
-print.constructive_code <- function(x, ..., colored = rlang::is_installed("prettycode"), style = NULL) {
-  if (colored) {
-    if (!is_installed("prettycode")) {
-      abort(paste("Could not use `colored = TRUE`, as the package prettycode is not",
-                  "installed. Please install it if you want to see colored output"))
-    }
-    x <- highlight_if_prettycode_installed(x, style = style)
+print.constructive_code <- function(
+    x,
+    ...,
+    colored = getOption("constructive_pretty", TRUE),
+    code_theme = NULL,
+    style = NULL
+) {
+  if (!is.null(style)) {
+    deprecate_soft(c(
+      "The `style` argument of `print.constructive_code()` is deprecated as of constructive 1.0.2",
+      i = "Please use the `code_theme` argument instead"
+    ))
   }
+
+  x <- highlight_code(x, code_theme, colored)
   cat(x, sep = "\n")
   invisible(x)
 }

R/construct_diff.R

@@ -89,7 +89,7 @@ construct_diff <- function(
 
 format_call_for_diffobj_banner <- function(call, interactive) {
   deparsed <- rlang::expr_deparse(call)
-  styled <- highlight_if_prettycode_installed(deparsed)
+  styled <- highlight_code(deparsed)
   if (!interactive) return(paste(styled, collapse = " "))
   multiline <- paste(styled, collapse = "<BR>")
   idented <- gsub(" ", "&#x00A0;", multiline)

R/global-options.R

@@ -1,7 +1,7 @@
 #' Global Options
 #'
 #' Set these options to tweak \{constructive\}'s global behavior, to set them
-#' permanently you can edit your `.RProfile` (`usethis::edit_r_profile()` might help).
+#' permanently you can edit your `.RProfile1`, e.g. using `usethis::edit_r_profile()`.
 #'
 #' * Set `options(constructive_print_mode = <character>)` to change the default
 #'   value of the `print_mode` argument, of `print.constructive`, where `<character>` is a vector
@@ -15,8 +15,12 @@
 #'     the code without output is copied to the clipboard)
 #' * Set `options(constructive_opts_template = <list>)` to set default constructive options,
 #'     see documentation of the `template` arg in `?construct`
-#' * Set `options(constructive_pretty = FALSE)` to disable pretty printing using
-#'     \{prettycode\}
+#' * Set `options(constructive_pretty = FALSE)` to disable syntax highlighting.
+#' 
+#' ## Relevant options from other packages:
+#' 
+#' * `cli.code_theme` can be used to configure the syntax highlighting theme
+#'   used by \{constructive\}; see [cli::code_theme_list()] for more information.
 #'
 #' @name constructive-global_options
 #' @aliases constructive_opts_template constructive_pretty constructive_print_mode

R/import-standalone-lifecycle.R

@@ -0,0 +1,252 @@
+# Standalone file: do not edit by hand
+# Source: <https://github.com/r-lib/rlang/blob/main/R/standalone-lifecycle.R>
+# ----------------------------------------------------------------------
+#
+# ---
+# repo: r-lib/rlang
+# file: standalone-lifecycle.R
+# last-updated: 2023-02-23
+# license: https://unlicense.org
+# imports: rlang (>= 1.0.0)
+# ---
+#
+# This file serves as a reference for currently unexported rlang
+# lifecycle functions. These functions require rlang in your `Imports`
+# DESCRIPTION field but you don't need to import rlang in your
+# namespace.
+#
+# ## Changelog
+#
+# 2023-02-23
+#
+# - Updated the API and internals to match modern lifecycle tools.
+#
+#
+# 2021-04-19
+#
+# - Removed `lifecycle()` function. You can now use the following in
+#   your roxygen documentation to inline a badge:
+#
+#    ```
+#    `r lifecycle::badge()`
+#    ```
+#
+#   This is a build-time dependency on lifecycle so there is no need
+#   to add lifecycle to Imports just to use badges. See also
+#   `?usethis::use_lifecycle()` for importing or updating the badge
+#   images in your package.
+#
+# - Soft-namespaced private objects.
+#
+# nocov start
+
+
+#' Signal deprecation
+#'
+#' @description
+#' These functions provide two levels of verbosity for deprecation
+#' warnings.
+#'
+#' * `deprecate_soft()` warns only if called directly: from the global
+#'   environment (so the user can change their script) or from the
+#'   package currently being tested (so the package developer can fix
+#'   the package).
+#'
+#' * `deprecate_warn()` warns unconditionally.
+#'
+#' * `deprecate_stop()` fails unconditionally.
+#'
+#' Both functions warn only once per session by default to avoid
+#' overwhelming the user with repeated warnings.
+#'
+#' @param msg The deprecation message.
+#' @param id The id of the deprecation. A warning is issued only once
+#'   for each `id`. Defaults to `msg`, but you should give a unique ID
+#'   when the message is built programmatically and depends on inputs.
+#' @param user_env The environment in which the deprecated function
+#'   was called. The verbosity depends on whether the deprecated
+#'   feature was called directly, see [rlang::env_is_user_facing()] and the
+#'   documentation in the lifecycle package.
+#'
+#' @section Controlling verbosity:
+#'
+#' The verbosity of retirement warnings can be controlled with global
+#' options. You'll generally want to set these options locally with
+#' one of these helpers:
+#'
+#' * `with_lifecycle_silence()` disables all soft-deprecation and
+#'   deprecation warnings.
+#'
+#' * `with_lifecycle_warnings()` enforces warnings for both
+#'   soft-deprecated and deprecated functions. The warnings are
+#'   repeated rather than signalled once per session.
+#'
+#' * `with_lifecycle_errors()` enforces errors for both
+#'   soft-deprecated and deprecated functions.
+#'
+#' All the `with_` helpers have `scoped_` variants that are
+#' particularly useful in testthat blocks.
+#'
+#' @noRd
+NULL
+
+deprecate_soft <- function(msg,
+                           id = msg,
+                           user_env = rlang::caller_env(2)) {
+  .rlang_lifecycle_signal_stage(msg, "deprecated")
+
+  id <- paste(id, collapse = "\n")
+  verbosity <- .rlang_lifecycle_verbosity()
+
+  invisible(switch(
+    verbosity,
+    quiet = NULL,
+    warning = ,
+    default =
+      if (rlang::env_is_user_facing(user_env)) {
+        always <- verbosity == "warning"
+        trace <- rlang::trace_back(bottom = caller_env())
+        .rlang_lifecycle_deprecate_warn0(
+          msg,
+          id = id,
+          trace = trace,
+          always = always
+        )
+      },
+    error = deprecate_stop(msg)
+  ))
+}
+
+deprecate_warn <- function(msg,
+                           id = msg,
+                           always = FALSE,
+                           user_env = rlang::caller_env(2)) {
+  .rlang_lifecycle_signal_stage(msg, "deprecated")
+
+  id <- paste(id, collapse = "\n")
+  verbosity <- .rlang_lifecycle_verbosity()
+
+  invisible(switch(
+    verbosity,
+    quiet = NULL,
+    warning = ,
+    default = {
+      direct <- rlang::env_is_user_facing(user_env)
+      always <- direct && (always || verbosity == "warning")
+
+      trace <- tryCatch(
+        rlang::trace_back(bottom = rlang::caller_env()),
+        error = function(...) NULL
+      )
+
+      .rlang_lifecycle_deprecate_warn0(
+        msg,
+        id = id,
+        trace = trace,
+        always = always
+      )
+    },
+    error = deprecate_stop(msg),
+  ))
+}
+
+.rlang_lifecycle_deprecate_warn0 <- function(msg,
+                                             id = msg,
+                                             trace = NULL,
+                                             always = FALSE,
+                                             call = rlang::caller_env()) {
+  if (always) {
+    freq <- "always"
+  } else {
+    freq <- "regularly"
+  }
+
+  rlang::warn(
+    msg,
+    class = "lifecycle_warning_deprecated",
+    .frequency = freq,
+    .frequency_id = id
+  )
+}
+
+deprecate_stop <- function(msg) {
+  msg <- cli::format_error(msg)
+  .rlang_lifecycle_signal_stage(msg, "deprecated")
+
+  stop(rlang::cnd(
+    c("defunctError", "error", "condition"),
+    old = NULL,
+    new = NULL,
+    package = NULL,
+    message = msg
+  ))
+}
+
+.rlang_lifecycle_signal_stage <- function(msg, stage) {
+  rlang::signal(msg, "lifecycle_stage", stage = stage)
+}
+
+expect_deprecated <- function(expr, regexp = NULL, ...) {
+  rlang::local_options(lifecycle_verbosity = "warning")
+
+  if (!is.null(regexp) && rlang::is_na(regexp)) {
+    rlang::abort("`regexp` can't be `NA`.")
+  }
+
+  testthat::expect_warning(
+    {{ expr }},
+    regexp = regexp,
+    class = "lifecycle_warning_deprecated",
+    ...
+  )
+}
+
+local_lifecycle_silence <- function(frame = rlang::caller_env()) {
+  rlang::local_options(
+    .frame = frame,
+    lifecycle_verbosity = "quiet"
+  )
+}
+with_lifecycle_silence <- function(expr) {
+  local_lifecycle_silence()
+  expr
+}
+
+local_lifecycle_warnings <- function(frame = rlang::caller_env()) {
+  rlang::local_options(
+    .frame = frame,
+    lifecycle_verbosity = "warning"
+  )
+}
+with_lifecycle_warnings <- function(expr) {
+  local_lifecycle_warnings()
+  expr
+}
+
+local_lifecycle_errors <- function(frame = rlang::caller_env()) {
+  rlang::local_options(
+    .frame = frame,
+    lifecycle_verbosity = "error"
+  )
+}
+with_lifecycle_errors <- function(expr) {
+  local_lifecycle_errors()
+  expr
+}
+
+.rlang_lifecycle_verbosity <- function() {
+  opt <- getOption("lifecycle_verbosity", "default")
+
+  if (!rlang::is_string(opt, c("quiet", "default", "warning", "error"))) {
+    options(lifecycle_verbosity = "default")
+    rlang::warn(paste(
+      "The `lifecycle_verbosity` option must be set to one of:",
+      "\"quiet\", \"default\", \"warning\", or \"error\".",
+      "Resetting to \"default\"."
+    ))
+  }
+
+  opt
+}
+
+# nocov end

R/utils.R

@@ -342,11 +342,11 @@ defaults_arg_values <- function(fun_val, pkg) {
   lapply(defaults_lng, eval, asNamespace(pkg))
 }
 
-highlight_if_prettycode_installed <- function(x, style = NULL) {
-  if (!is_installed("prettycode") || isFALSE(getOption("constructive_pretty"))) {
+highlight_code <- function(x, code_theme = NULL, colored = getOption("constructive_pretty", TRUE)) {
+  if (isFALSE(colored)) {
     return(x)
   }
-  prettycode::highlight(x, style = style %||% prettycode::default_style())
+  cli::code_highlight(x, code_theme)
 }
 
 strip <- function(x) {