From 5c3a6bcad505ecf708cdc8fef8075fc3ec5c0ea1 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Mon, 10 May 2021 10:18:21 +0200 Subject: [PATCH 1/2] Add `new_error_package_not_found()` --- NAMESPACE | 2 + NEWS.md | 4 + R/session.R | 113 +++++++++++++++++++++-------- man/new_error_package_not_found.Rd | 35 +++++++++ tests/testthat/_snaps/session.md | 14 ++-- tests/testthat/test-session.R | 20 +++++ 6 files changed, 152 insertions(+), 36 deletions(-) create mode 100644 man/new_error_package_not_found.Rd diff --git a/NAMESPACE b/NAMESPACE index 1ae63fe063..9ab35f46e6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,6 +36,7 @@ S3method(c,rlang_envs) S3method(cnd_body,default) S3method(cnd_footer,default) S3method(cnd_header,default) +S3method(cnd_header,rlib_error_package_not_found) S3method(conditionMessage,rlang_error) S3method(format,rlang_error) S3method(format,rlang_trace) @@ -433,6 +434,7 @@ export(new_data_mask) export(new_double) export(new_double_along) export(new_environment) +export(new_error_package_not_found) export(new_formula) export(new_function) export(new_integer) diff --git a/NEWS.md b/NEWS.md index f793a9c909..4423367183 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # rlang (development version) +* `check_installed()` now throws errors of class + `rlib_error_package_not_found`. These can be constructed with + `new_error_package_not_found()`. + * New `rlib_bytes` class imported from the bench package (#1117). It prints and parses human-friendly sizes. diff --git a/R/session.R b/R/session.R index 95efcf7b66..5c6120f737 100644 --- a/R/session.R +++ b/R/session.R @@ -71,50 +71,34 @@ check_installed <- function(pkg, needs_install <- !map2_lgl(pkg, version, function(p, v) is_installed(p, version = v)) } - if (!any(needs_install)) { + missing_pkgs <- pkg[needs_install] + missing_vers <- version[needs_install] + + if (!length(missing_pkgs)) { return(invisible(NULL)) } - missing_pkgs <- pkg[needs_install] - missing_pkgs <- chr_quoted(missing_pkgs) + cnd <- new_error_package_not_found( + missing_pkgs, + missing_vers, + reason = reason + ) - if (!is_null(version)) { - missing_vers <- version[needs_install] - missing_pkgs <- map2_chr(missing_pkgs, missing_vers, function(p, v) { - if (is_na(v)) { - p - } else { - paste0(p, " (>= ", v, ")") - } - }) + if (!is_interactive()) { + cnd_signal(cnd) } - missing_pkgs_enum <- chr_enumerate(missing_pkgs, final = "and") + header <- cnd_header(cnd) n <- length(missing_pkgs) - info <- pluralise( - n, - paste0("The package ", missing_pkgs_enum, " is required"), - paste0("The packages ", missing_pkgs_enum, " are required") - ) - if (is_null(reason)) { - info <- paste0(info, ".") - } else { - info <- paste(info, reason) - } - question <- pluralise( n, "Would you like to install it?", "Would you like to install them?" ) - if (!is_interactive()) { - abort(info) - } - cat(paste_line( - paste0(info(), " ", info), + paste0(info(), " ", header), paste0(cross(), " ", question), .trailing = TRUE )) @@ -128,3 +112,74 @@ check_installed <- function(pkg, utils::install.packages(missing_pkgs) } } + +#' Signal that required packages were not found +#' +#' @description +#' +#' - `new_error_package_not_found()` constructs a condition of class +#' `rlib_error_package_not_found`. This condition includes the +#' character vectors `pkg` and `version`. They may contain more than +#' one package. `version` can be `NULL` and must be otherwise the +#' same length as `pkg`. +#' +#' @inheritParams is_installed +#' @param class,... Subclass and additional condition fields. +#' @export +new_error_package_not_found <- function(pkg, + version = NULL, + ..., + reason = NULL, + class = NULL) { + if (!is_character(pkg)) { + abort("`pkg` must be character vector.") + } + if (!length(pkg)) { + abort("`pkg` must contain at least one package.") + } + if (!is_null(version) && !is_character(version, n = length(pkg))) { + abort("`version` must be a character vector as long as `pkg`.") + } + + error_cnd( + class = c(class, "rlib_error_package_not_found"), + pkg = pkg, + version = version, + reason = reason, + ... + ) +} + +#' @export +cnd_header.rlib_error_package_not_found <- function(cnd, ...) { + pkg <- cnd$pkg + version <- cnd$version + reason <- cnd$reason + n <- length(pkg) + + pkg_enum <- chr_quoted(cnd$pkg) + + if (!is_null(version)) { + pkg_enum <- map2_chr(pkg_enum, version, function(p, v) { + if (is_na(v)) { + p + } else { + paste0(p, " (>= ", v, ")") + } + }) + } + + pkg_enum <- chr_enumerate(pkg_enum, final = "and") + + info <- pluralise( + n, + paste0("The package ", pkg_enum, " is required"), + paste0("The packages ", pkg_enum, " are required") + ) + + if (is_null(reason)) { + paste0(info, ".") + } else { + paste(info, reason) + } +} diff --git a/man/new_error_package_not_found.Rd b/man/new_error_package_not_found.Rd new file mode 100644 index 0000000000..f38c5cb448 --- /dev/null +++ b/man/new_error_package_not_found.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/session.R +\name{new_error_package_not_found} +\alias{new_error_package_not_found} +\title{Signal that required packages were not found} +\usage{ +new_error_package_not_found( + pkg, + version = NULL, + ..., + reason = NULL, + class = NULL +) +} +\arguments{ +\item{pkg}{The package names.} + +\item{version}{Minimum versions for \code{pkg}. If supplied, must be the +same length as \code{pkg}. \code{NA} elements stand for any versions.} + +\item{reason}{Optional string indicating why is \code{pkg} needed. +Appears in error messages (if non-interactive) and user prompts +(if interactive).} + +\item{class, ...}{Subclass and additional condition fields.} +} +\description{ +\itemize{ +\item \code{new_error_package_not_found()} constructs a condition of class +\code{rlib_error_package_not_found}. This condition includes the +character vectors \code{pkg} and \code{version}. They may contain more than +one package. \code{version} can be \code{NULL} and must be otherwise the +same length as \code{pkg}. +} +} diff --git a/tests/testthat/_snaps/session.md b/tests/testthat/_snaps/session.md index 8fcea3796e..d40bc9c739 100644 --- a/tests/testthat/_snaps/session.md +++ b/tests/testthat/_snaps/session.md @@ -3,17 +3,17 @@ Code (expect_error(check_installed("_foo"))) Output - + The package `_foo` is required. Code (expect_error(check_installed(c("_foo", "_bar")))) Output - + The packages `_foo` and `_bar` are required. Code (expect_error(check_installed(c("_foo", "_bar"), "to proceed."))) Output - + The packages `_foo` and `_bar` are required to proceed. # check_installed() checks minimal versions @@ -21,22 +21,22 @@ Code (expect_error(check_installed("_foo", version = "1.0"))) Output - + The package `_foo` (>= 1.0) is required. Code (expect_error(check_installed(c("_foo", "_bar"), version = c("1.0", NA)))) Output - + The packages `_foo` (>= 1.0) and `_bar` are required. Code (expect_error(check_installed(c("_foo", "_bar"), version = c(NA, "2.0")))) Output - + The packages `_foo` and `_bar` (>= 2.0) are required. Code (expect_error(check_installed(c("_foo", "_bar"), "to proceed.", version = c( "1.0", "2.0")))) Output - + The packages `_foo` (>= 1.0) and `_bar` (>= 2.0) are required to proceed. diff --git a/tests/testthat/test-session.R b/tests/testthat/test-session.R index 28bfa3975c..4ea963a183 100644 --- a/tests/testthat/test-session.R +++ b/tests/testthat/test-session.R @@ -36,3 +36,23 @@ test_that("check_installed() checks minimal versions", { (expect_error(check_installed(c("_foo", "_bar"), "to proceed.", version = c("1.0", "2.0")))) }) }) + +test_that("pnf error is validated", { + expect_pnf <- function(out, pkg, ver) { + expect_s3_class(out, "rlib_error_package_not_found") + expect_equal(out$pkg, pkg) + expect_equal(out$version, ver) + } + expect_pnf(new_error_package_not_found("foo"), "foo", NULL) + expect_pnf(new_error_package_not_found("foo", "1.0"), "foo", "1.0") + expect_pnf(new_error_package_not_found(c("foo", "bar"), c("1.0", "1.0")), c("foo", "bar"), c("1.0", "1.0")) + + expect_error( + new_error_package_not_found(chr()), + "at least one package" + ) + expect_error( + new_error_package_not_found(c("foo", "bar"), "1.0"), + "as long as `pkg`" + ) +}) From ea90d074b824a3e0a864dc40d908e09a9ca46e18 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Mon, 10 May 2021 12:17:44 +0200 Subject: [PATCH 2/2] Add a restart mechanism to `check_installed()` Closes #1150 --- NAMESPACE | 1 - NEWS.md | 13 ++++-- R/session.R | 69 +++++++++++++++++++++++------- man/is_installed.Rd | 23 ++++++++++ man/new_error_package_not_found.Rd | 35 --------------- tests/testthat/_snaps/session.md | 14 +++--- tests/testthat/test-session.R | 48 +++++++++++++++++++++ 7 files changed, 142 insertions(+), 61 deletions(-) delete mode 100644 man/new_error_package_not_found.Rd diff --git a/NAMESPACE b/NAMESPACE index 9ab35f46e6..1e49d7071d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -434,7 +434,6 @@ export(new_data_mask) export(new_double) export(new_double_along) export(new_environment) -export(new_error_package_not_found) export(new_formula) export(new_function) export(new_integer) diff --git a/NEWS.md b/NEWS.md index 4423367183..114a77646c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,15 @@ # rlang (development version) -* `check_installed()` now throws errors of class - `rlib_error_package_not_found`. These can be constructed with - `new_error_package_not_found()`. +* `check_installed()` now consults the + `rlib_restart_package_not_found` global option to determine whether + to prompt users to install packages. This also disables the restart + mechanism (see below). + +* `check_installed()` now signals errors of class + `rlib_error_package_not_found` with a + `rlib_restart_package_not_found` restart. This allows calling + handlers to install the required packages and restart the check + (#1150). * New `rlib_bytes` class imported from the bench package (#1117). It prints and parses human-friendly sizes. diff --git a/R/session.R b/R/session.R index 5c6120f737..ac2898fc2c 100644 --- a/R/session.R +++ b/R/session.R @@ -16,6 +16,10 @@ #' interactive or if the user chooses not to install the packages, #' the current evaluation is aborted. #' +#' You can disable the prompt by setting the +#' `rlib_restart_package_not_found` global option to `FALSE`. In that +#' case, missing packages always cause an error. +#' #' @param pkg The package names. #' @param reason Optional string indicating why is `pkg` needed. #' Appears in error messages (if non-interactive) and user prompts @@ -27,6 +31,24 @@ #' provided in `pkg` are installed, `FALSE` #' otherwise. `check_installed()` either doesn't return or returns #' `NULL`. +#' +#' @section Handling package not found errors: +#' `check_installed()` signals error conditions of class +#' `rlib_error_package_not_found`. The error includes `pkg` and +#' `version` fields. They are vectorised and may include several +#' packages. +#' +#' The error is signalled with a `rlib_restart_package_not_found` +#' restart on the stack to allow handlers to install the required +#' packages. To do so, add a [calling handler][withCallingHandlers] +#' for `rlib_error_package_not_found`, install the required packages, +#' and invoke the restart without arguments. This restarts the check +#' from scratch. +#' +#' The condition is not signalled in non-interactive sessions, in the +#' restarting case, or if the `rlib_restart_package_not_found` user +#' option is set to `FALSE`. +#' #' @export #' @examples #' is_installed("utils") @@ -35,6 +57,12 @@ is_installed <- function(pkg, ..., version = NULL) { check_dots_empty0(...) + # Internal mechanism for unit tests + hook <- peek_option("rlang:::is_installed_hook") + if (is_function(hook)) { + return(all(hook(pkg, version))) + } + if (!all(map_lgl(pkg, function(x) is_true(requireNamespace(x, quietly = TRUE))))) { return(FALSE) } @@ -84,8 +112,22 @@ check_installed <- function(pkg, reason = reason ) - if (!is_interactive()) { - cnd_signal(cnd) + restart <- peek_option("rlib_restart_package_not_found") %||% TRUE + if (!is_bool(restart)) { + abort("`rlib_restart_package_not_found` must be a logical value.") + } + + if (!is_interactive() || !restart) { + abort(cnd_header(cnd)) + } + + if (signal_package_not_found(cnd)) { + # A calling handler asked for a restart. Disable restarts and try + # again. + return(with_options( + "rlib_restart_package_not_found" = FALSE, + check_installed(pkg, reason, version = version) + )) } header <- cnd_header(cnd) @@ -113,19 +155,6 @@ check_installed <- function(pkg, } } -#' Signal that required packages were not found -#' -#' @description -#' -#' - `new_error_package_not_found()` constructs a condition of class -#' `rlib_error_package_not_found`. This condition includes the -#' character vectors `pkg` and `version`. They may contain more than -#' one package. `version` can be `NULL` and must be otherwise the -#' same length as `pkg`. -#' -#' @inheritParams is_installed -#' @param class,... Subclass and additional condition fields. -#' @export new_error_package_not_found <- function(pkg, version = NULL, ..., @@ -183,3 +212,13 @@ cnd_header.rlib_error_package_not_found <- function(cnd, ...) { paste(info, reason) } } + +signal_package_not_found <- function(cnd) { + withRestarts({ + signalCondition(cnd) + FALSE + }, + rlib_restart_package_not_found = function() { + TRUE + }) +} diff --git a/man/is_installed.Rd b/man/is_installed.Rd index c987a967d0..ad5efec314 100644 --- a/man/is_installed.Rd +++ b/man/is_installed.Rd @@ -42,7 +42,30 @@ packages are installed with \code{pak::pkg_install()} if available, or interactive or if the user chooses not to install the packages, the current evaluation is aborted. } + +You can disable the prompt by setting the +\code{rlib_restart_package_not_found} global option to \code{FALSE}. In that +case, missing packages always cause an error. +} +\section{Handling package not found errors}{ + +\code{check_installed()} signals error conditions of class +\code{rlib_error_package_not_found}. The error includes \code{pkg} and +\code{version} fields. They are vectorised and may include several +packages. + +The error is signalled with a \code{rlib_restart_package_not_found} +restart on the stack to allow handlers to install the required +packages. To do so, add a \link[=withCallingHandlers]{calling handler} +for \code{rlib_error_package_not_found}, install the required packages, +and invoke the restart without arguments. This restarts the check +from scratch. + +The condition is not signalled in non-interactive sessions, in the +restarting case, or if the \code{rlib_restart_package_not_found} user +option is set to \code{FALSE}. } + \examples{ is_installed("utils") is_installed(c("base", "ggplot5")) diff --git a/man/new_error_package_not_found.Rd b/man/new_error_package_not_found.Rd deleted file mode 100644 index f38c5cb448..0000000000 --- a/man/new_error_package_not_found.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/session.R -\name{new_error_package_not_found} -\alias{new_error_package_not_found} -\title{Signal that required packages were not found} -\usage{ -new_error_package_not_found( - pkg, - version = NULL, - ..., - reason = NULL, - class = NULL -) -} -\arguments{ -\item{pkg}{The package names.} - -\item{version}{Minimum versions for \code{pkg}. If supplied, must be the -same length as \code{pkg}. \code{NA} elements stand for any versions.} - -\item{reason}{Optional string indicating why is \code{pkg} needed. -Appears in error messages (if non-interactive) and user prompts -(if interactive).} - -\item{class, ...}{Subclass and additional condition fields.} -} -\description{ -\itemize{ -\item \code{new_error_package_not_found()} constructs a condition of class -\code{rlib_error_package_not_found}. This condition includes the -character vectors \code{pkg} and \code{version}. They may contain more than -one package. \code{version} can be \code{NULL} and must be otherwise the -same length as \code{pkg}. -} -} diff --git a/tests/testthat/_snaps/session.md b/tests/testthat/_snaps/session.md index d40bc9c739..8fcea3796e 100644 --- a/tests/testthat/_snaps/session.md +++ b/tests/testthat/_snaps/session.md @@ -3,17 +3,17 @@ Code (expect_error(check_installed("_foo"))) Output - + The package `_foo` is required. Code (expect_error(check_installed(c("_foo", "_bar")))) Output - + The packages `_foo` and `_bar` are required. Code (expect_error(check_installed(c("_foo", "_bar"), "to proceed."))) Output - + The packages `_foo` and `_bar` are required to proceed. # check_installed() checks minimal versions @@ -21,22 +21,22 @@ Code (expect_error(check_installed("_foo", version = "1.0"))) Output - + The package `_foo` (>= 1.0) is required. Code (expect_error(check_installed(c("_foo", "_bar"), version = c("1.0", NA)))) Output - + The packages `_foo` (>= 1.0) and `_bar` are required. Code (expect_error(check_installed(c("_foo", "_bar"), version = c(NA, "2.0")))) Output - + The packages `_foo` and `_bar` (>= 2.0) are required. Code (expect_error(check_installed(c("_foo", "_bar"), "to proceed.", version = c( "1.0", "2.0")))) Output - + The packages `_foo` (>= 1.0) and `_bar` (>= 2.0) are required to proceed. diff --git a/tests/testthat/test-session.R b/tests/testthat/test-session.R index 4ea963a183..5de4d9ab1a 100644 --- a/tests/testthat/test-session.R +++ b/tests/testthat/test-session.R @@ -56,3 +56,51 @@ test_that("pnf error is validated", { "as long as `pkg`" ) }) + +test_that("can handle check-installed", { + local_interactive() + + # Override `is_installed()` results + override <- NULL + is_installed_hook <- function(pkg, ver) { + if (is_bool(override)) { + rep_along(pkg, override) + } else { + with_options( + "rlang:::is_installed_hook" = NULL, + is_installed(pkg, version = ver) + ) + } + } + local_options("rlang:::is_installed_hook" = is_installed_hook) + + test_env <- current_env() + handle <- function(value, frame, expr) { + withCallingHandlers( + rlib_error_package_not_found = function(cnd) { + override <<- value + invokeRestart("rlib_restart_package_not_found") + }, + expr + ) + } + + override <- NULL + expect_no_error( + handle( + TRUE, + test_env, + check_installed(c("foo", "bar"), version = c("1.0", "2.0")) + ) + ) + + override <- NULL + expect_error( + handle( + FALSE, + test_env, + check_installed(c("foo", "bar"), version = c("1.0", "2.0")) + ), + "are required" + ) +})