diff --git a/NAMESPACE b/NAMESPACE index 971deba23..ef10680d5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,6 +34,7 @@ export(rehash) export(remove) export(repair) export(restore) +export(retrieve) export(revert) export(run) export(sandbox) diff --git a/NEWS.md b/NEWS.md index f07af88f5..a38b0f068 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,11 @@ # renv (development version) +* `renv` gains the function `renv::retrieve()`, which can be used to download + packages without installing them. This is primarily useful in CI / CD scenarios, + where you might want to download packages in a single stage before attempting + to install / restore them. (#1965) + * `renv` now preserves `Remote` fields present on packages installed from public package repositories (e.g. ). (#1961) diff --git a/R/hydrate.R b/R/hydrate.R index 9a1371c58..d4cc771f9 100644 --- a/R/hydrate.R +++ b/R/hydrate.R @@ -331,7 +331,7 @@ renv_hydrate_resolve_missing <- function(project, library, remotes, missing) { handler = handler ) - records <- retrieve(packages) + records <- renv_retrieve_impl(packages) renv_install_impl(records) # if we failed to restore anything, warn the user diff --git a/R/imbue.R b/R/imbue.R index 5a9e46c2c..06e14483a 100644 --- a/R/imbue.R +++ b/R/imbue.R @@ -65,7 +65,7 @@ renv_imbue_impl <- function(project, recursive = FALSE ) - records <- retrieve("renv") + records <- renv_retrieve_impl("renv") renv_install_impl(records) record <- records[["renv"]] diff --git a/R/install.R b/R/install.R index d2b0b7ee8..e365e9252 100644 --- a/R/install.R +++ b/R/install.R @@ -43,24 +43,6 @@ the$install_step_width <- 48L #' #' @inherit renv-params #' -#' @param packages Either `NULL` (the default) to install all packages required -#' by the project, or a character vector of packages to install. renv -#' supports a subset of the remotes syntax used for package installation, -#' e.g: -#' -#' * `pkg`: install latest version of `pkg` from CRAN. -#' * `pkg@version`: install specified version of `pkg` from CRAN. -#' * `username/repo`: install package from GitHub -#' * `bioc::pkg`: install `pkg` from Bioconductor. -#' -#' See and the examples -#' below for more details. -#' -#' renv deviates from the remotes spec in one important way: subdirectories -#' are separated from the main repository specification with a `:`, not `/`. -#' So to install from the `subdir` subdirectory of GitHub package -#' `username/repo` you'd use `"username/repo:subdir`. -#' #' @param exclude Packages which should not be installed. `exclude` is useful #' when using `renv::install()` to install all dependencies in a project, #' except for a specific set of packages. @@ -224,7 +206,7 @@ install <- function(packages = NULL, ) # retrieve packages - records <- retrieve(packages) + records <- renv_retrieve_impl(packages) if (empty(records)) { writef("- There are no packages to install.") return(invisible(list())) diff --git a/R/remotes.R b/R/remotes.R index 8377523e0..0abb2620e 100644 --- a/R/remotes.R +++ b/R/remotes.R @@ -451,6 +451,7 @@ renv_remotes_resolve_repository <- function(remote, latest) { if (latest && is.null(version)) { remote <- renv_available_packages_latest(package) version <- remote$Version + repository <- remote$Repository } list( diff --git a/R/restore.R b/R/restore.R index 6dcf38699..11c5655f6 100644 --- a/R/restore.R +++ b/R/restore.R @@ -212,7 +212,7 @@ renv_restore_run_actions <- function(project, actions, current, lockfile, rebuil packages <- names(installs) # perform the install - records <- retrieve(packages) + records <- renv_retrieve_impl(packages) renv_install_impl(records) # detect dependency tree repair diff --git a/R/retrieve.R b/R/retrieve.R index 5a7aa5fac..979a78600 100644 --- a/R/retrieve.R +++ b/R/retrieve.R @@ -1,10 +1,95 @@ the$repos_archive <- new.env(parent = emptyenv()) -# this routine retrieves a package + its dependencies, and as a side -# effect populates the restore state's `retrieved` member with a -# list of package records which can later be used for install -retrieve <- function(packages) { +#' Retrieve packages +#' +#' Retrieve (download) one or more packages from external sources. +#' Using `renv::retrieve()` can be useful in CI / CD workflows, where +#' you might want to download all packages listed in a lockfile +#' before later invoking [renv::restore()]. Packages will be downloaded +#' to an internal path within `renv`'s local state directories -- see +#' [paths] for more details. +#' +#' If `destdir` is `NULL` and the requested package is already available +#' within the `renv` cache, `renv` will return the path to that package +#' directory in the cache. +#' +#' @inheritParams renv-params +#' +#' @param lockfile The path to an `renv` lockfile. When set, `renv` +#' will retrieve the packages as defined within that lockfile. +#' If `packages` is also non-`NULL`, then only those packages will +#' be retrieved. +#' +#' @param destdir The directory where packages should be downloaded. +#' When `NULL` (the default), the default internal storage locations +#' (normally used by e.g. [renv::install()] or [renv::restore()]) will +#' be used. +#' +#' @returns A named vector, mapping package names to the paths where +#' those packages were downloaded. +#' +#' @export +#' +#' @examples +#' \dontrun{ +#' +#' # retrieve package + versions as defined in the lockfile +#' # normally used as a pre-flight step to renv::restore() +#' renv::retrieve() +#' +#' # download one or more packages locally +#' renv::retrieve("rlang", destdir = ".") +#' +#' } +retrieve <- function(packages = NULL, + ..., + lockfile = NULL, + destdir = NULL, + project = NULL) +{ + renv_consent_check() + renv_scope_error_handler() + renv_dots_check(...) + + project <- renv_project_resolve(project) + renv_project_lock(project = project) + + # set destdir if available + if (!is.null(destdir)) { + renv_scope_options(renv.config.cache.enabled = FALSE) + renv_scope_binding(the, "destdir", destdir) + } + + # figure out which records we want to retrieve + if (is.null(packages) && is.null(lockfile)) { + lockfile <- renv_lockfile_load(project = project) + } else if (is.null(lockfile)) { + records <- map(packages, renv_remotes_resolve, latest = TRUE) + packages <- map_chr(records, `[[`, "Package") + names(records) <- packages + } else if (is.character(lockfile)) { + lockfile <- renv_lockfile_read(lockfile) + records <- renv_lockfile_records(lockfile) + packages <- packages %||% names(records) + } + + # overlay project remotes + records <- overlay(renv_project_remotes(project), records) + + # perform the retrieval + renv_scope_restore( + project = project, + library = library, + packages = packages, + records = records + ) + + result <- renv_retrieve_impl(packages) + map_chr(result, `[[`, "Path") +} + +renv_retrieve_impl <- function(packages) { # confirm that we have restore state set up state <- renv_restore_state() @@ -31,7 +116,7 @@ retrieve <- function(packages) { before <- Sys.time() handler <- state$handler for (package in packages) - handler(package, renv_retrieve_impl(package)) + handler(package, renv_retrieve_impl_one(package)) after <- Sys.time() state <- renv_restore_state() @@ -46,7 +131,7 @@ retrieve <- function(packages) { } -renv_retrieve_impl <- function(package) { +renv_retrieve_impl_one <- function(package) { # skip packages with 'base' priority if (package %in% renv_packages_base()) @@ -169,6 +254,7 @@ renv_retrieve_impl <- function(package) { path <- renv_cache_find(record) if (nzchar(path) && renv_cache_package_validate(path)) return(renv_retrieve_successful(record, path)) + } } @@ -251,10 +337,14 @@ renv_retrieve_path <- function(record, type = "source", ext = NULL) { # extract relevant record information package <- record$Package name <- renv_retrieve_name(record, type, ext) - source <- renv_record_source(record) + + # if we have a destdir override, use this + if (!is.null(the$destdir)) + return(file.path(the$destdir, name)) # check for packages from an PPM binary URL, and # update the package type if known + source <- renv_record_source(record) if (renv_ppm_enabled()) { url <- attr(record, "url") if (is.character(url) && grepl("/__[^_]+__/", url)) @@ -1139,14 +1229,14 @@ renv_retrieve_successful_recurse_impl_one <- function(remote) { # if this is a 'plain' package remote, retrieve it if (grepl(renv_regexps_package_name(), remote)) { - renv_retrieve_impl(remote) + renv_retrieve_impl_one(remote) return(list()) } # otherwise, handle custom remotes record <- renv_retrieve_remotes_impl(remote) if (length(record)) { - renv_retrieve_impl(record$Package) + renv_retrieve_impl_one(record$Package) return(list()) } diff --git a/R/roxygen.R b/R/roxygen.R index f8efca575..dae1c189a 100644 --- a/R/roxygen.R +++ b/R/roxygen.R @@ -45,6 +45,24 @@ #' "strong", "most", and "all" are also supported. #' See [tools::package_dependencies()] for more details. #' +#' @param packages Either `NULL` (the default) to install all packages required +#' by the project, or a character vector of packages to install. renv +#' supports a subset of the remotes syntax used for package installation, +#' e.g: +#' +#' * `pkg`: install latest version of `pkg` from CRAN. +#' * `pkg@version`: install specified version of `pkg` from CRAN. +#' * `username/repo`: install package from GitHub +#' * `bioc::pkg`: install `pkg` from Bioconductor. +#' +#' See and the examples +#' below for more details. +#' +#' renv deviates from the remotes spec in one important way: subdirectories +#' are separated from the main repository specification with a `:`, not `/`. +#' So to install from the `subdir` subdirectory of GitHub package +#' `username/repo` you'd use `"username/repo:subdir`. +#' #' @return The project directory, invisibly. Note that this function is normally #' called for its side effects. #' diff --git a/R/tests.R b/R/tests.R index 0d05e1794..4f960e9c2 100644 --- a/R/tests.R +++ b/R/tests.R @@ -44,7 +44,7 @@ renv_test_retrieve <- function(record) { recursive = TRUE ) - records <- retrieve(record$Package) + records <- renv_retrieve_impl(record$Package) renv_install_impl(records) descpath <- file.path(templib, package) diff --git a/R/upgrade.R b/R/upgrade.R index ca121a1d4..90cfc9de1 100644 --- a/R/upgrade.R +++ b/R/upgrade.R @@ -89,7 +89,7 @@ renv_upgrade_impl <- function(project, version, reload, prompt) { ) # retrieve and install renv - records <- retrieve("renv") + records <- renv_retrieve_impl("renv") renv_install_impl(records) # update the lockfile diff --git a/_pkgdown.yml b/_pkgdown.yml index 6aa49fc18..8dd741bdb 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -71,10 +71,11 @@ reference: - title: internal contents: + - graph + - imbue - renv-package + - retrieve - sandbox - - imbue - - graph - sandbox articles: diff --git a/man/retrieve.Rd b/man/retrieve.Rd new file mode 100644 index 000000000..9d935fae6 --- /dev/null +++ b/man/retrieve.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/retrieve.R +\name{retrieve} +\alias{retrieve} +\title{Retrieve packages} +\usage{ +retrieve(packages = NULL, ..., lockfile = NULL, destdir = NULL, project = NULL) +} +\arguments{ +\item{packages}{Either \code{NULL} (the default) to install all packages required +by the project, or a character vector of packages to install. renv +supports a subset of the remotes syntax used for package installation, +e.g: +\itemize{ +\item \code{pkg}: install latest version of \code{pkg} from CRAN. +\item \code{pkg@version}: install specified version of \code{pkg} from CRAN. +\item \code{username/repo}: install package from GitHub +\item \code{bioc::pkg}: install \code{pkg} from Bioconductor. +} + +See \url{https://remotes.r-lib.org/articles/dependencies.html} and the examples +below for more details. + +renv deviates from the remotes spec in one important way: subdirectories +are separated from the main repository specification with a \code{:}, not \code{/}. +So to install from the \code{subdir} subdirectory of GitHub package +\code{username/repo} you'd use \verb{"username/repo:subdir}.} + +\item{...}{Unused arguments, reserved for future expansion. If any arguments +are matched to \code{...}, renv will signal an error.} + +\item{lockfile}{The path to an \code{renv} lockfile. When set, \code{renv} +will retrieve the packages as defined within that lockfile. +If \code{packages} is also non-\code{NULL}, then only those packages will +be retrieved.} + +\item{destdir}{The directory where packages should be downloaded. +When \code{NULL} (the default), the default internal storage locations +(normally used by e.g. \code{\link[=install]{install()}} or \code{\link[=restore]{restore()}}) will +be used.} + +\item{project}{The project directory. If \code{NULL}, then the active project will +be used. If no project is currently active, then the current working +directory is used instead.} +} +\value{ +A named vector, mapping package names to the paths where +those packages were downloaded. +} +\description{ +Retrieve (download) one or more packages from external sources. +Using \code{renv::retrieve()} can be useful in CI / CD workflows, where +you might want to download all packages listed in a lockfile +before later invoking \code{\link[=restore]{restore()}}. Packages will be downloaded +to an internal path within \code{renv}'s local state directories -- see +\link{paths} for more details. +} +\details{ +If \code{destdir} is \code{NULL} and the requested package is already available +within the \code{renv} cache, \code{renv} will return the path to that package +directory in the cache. +} +\examples{ +\dontrun{ + +# retrieve package + versions as defined in the lockfile +# normally used as a pre-flight step to renv::restore() +renv::retrieve() + +# download one or more packages locally +renv::retrieve("rlang", destdir = ".") + +} +} diff --git a/tests/testthat/test-retrieve.R b/tests/testthat/test-retrieve.R index 4523184ca..718cf40c4 100644 --- a/tests/testthat/test-retrieve.R +++ b/tests/testthat/test-retrieve.R @@ -384,3 +384,21 @@ test_that("retrieve handles local sources", { renv_test_retrieve(record) }) + +test_that("we can use retrieve() to download packages without installing", { + project <- renv_tests_scope() + init() + + result <- retrieve(packages = "breakfast") + expect_false(renv_package_installed("breakfast")) + expect_contains(names(result), "breakfast") + expect_contains(names(result), "bread") + + result <- retrieve(packages = "bread", destdir = ".") + expect_equal(result, c(bread = "./bread_1.0.0.tar.gz")) + + install("bread") + result <- retrieve(packages = "bread", destdir = ".") + expect_equal(result, c(bread = "./bread_1.0.0.tar.gz")) + +})