R/checkout.R

In renv: Project Environments

#' Checkout a repository
#'
#' `renv::checkout()` can be used to retrieve the latest-available packages from
#' a (set of) package repositories.
#'
#' `renv::checkout()` is most useful with services like the Posit's
#' [Package Manager](https://packagemanager.rstudio.com/), as it
#' can be used to switch between different repository snapshots within an
#' renv project. In this way, you can upgrade (or downgrade) all of the
#' packages used in a particular renv project to the package versions
#' provided by a particular snapshot.
#'
#' Note that calling `renv::checkout()` will also install the version of `renv`
#' available as of the requested snapshot date, which might be older or lack
#' features available in the currently-installed version of `renv`. In addition,
#' the project's `renv/activate.R` script will be re-generated after checkout.
#' If this is undesired, you can re-install a newer version of `renv` after
#' checkout from your regular \R package repository.
#'
#' @section Caveats:
#'
#' If your library contains packages installed from other remote sources (e.g.
#' GitHub), but a version of a package of the same name is provided by the
#' repositories being checked out, then please be aware that the package will be
#' replaced with the version provided by the requested repositories. This could
#' be a concern if your project uses \R packages from GitHub whose name matches
#' that of an existing CRAN package, but is otherwise unrelated to the package
#' on CRAN.
#'
#' @inheritParams renv-params
#'
#' @param repos The \R package repositories to use.
#'
#' @param packages The packages to be installed. When `NULL` (the default),
#'   all packages currently used in the project will be installed, as
#'   determined by [renv::dependencies()]. The recursive dependencies of these
#'   packages will be included as well.
#'
#' @param date The snapshot date to use. When set, the associated snapshot as
#'   available from the Posit's public
#'   [Package Manager](https://packagemanager.rstudio.com/) instance will be
#'   used. Ignored if `repos` is non-`NULL`.
#'
#' @param restart Should the \R session be restarted after the new
#'   packages have been checked out? When `NULL` (the default), the
#'   session is restarted if the `"restore"` action was taken.
#'
#' @param actions The action(s) to perform with the requested repositories.
#'   This can either be `"snapshot"`, in which `renv` will generate a lockfile
#'   based on the latest versions of the packages available from `repos`, or
#'   `"restore"` if you'd like to install those packages. You can use
#'   `c("snapshot", "restore")` if you'd like to generate a lockfile and
#'   install those packages in a single call. When `actions` contains
#'   `"snapshot"`, the lockfile is generated from repository metadata
#'   (the `PACKAGES` file) without installing packages, so it may contain
#'   only a subset of the fields present in a lockfile generated by
#'   [renv::snapshot()].
#'
#' @examples
#' \dontrun{
#'
#' # check out packages from PPM using the date '2023-01-02'
#' renv::checkout(date = "2023-01-02")
#'
#' # alternatively, supply the full repository path
#' renv::checkout(repos = c(PPM = "https://packagemanager.rstudio.com/cran/2023-01-02"))
#'
#' # only check out some subset of packages (and their recursive dependencies)
#' renv::checkout(packages = "dplyr", date = "2023-01-02")
#'
#' # generate a lockfile based on a snapshot date
#' renv::checkout(date = "2023-01-02", actions = "snapshot")
#'
#' }
#' @export
checkout <- function(repos = NULL,
                     ...,
                     packages     = NULL,
                     date         = NULL,
                     clean        = FALSE,
                     actions      = "restore",
                     dependencies = NULL,
                     restart      = NULL,
                     project      = NULL)
{
  renv_consent_check()
  renv_scope_error_handler()
  renv_dots_check(...)

  project  <- renv_project_resolve(project)
  renv_project_lock(project = project)

  # set new repositories
  repos <- repos %||% renv_checkout_repos(date)
  options(repos = repos)

  # TODO: Activate Bioconductor if it appears to be used by this project

  # select packages to install
  requested <- packages
  packages <- packages %||% renv_checkout_packages(project = project)

  # expand dependency fields
  fields <- renv_dependencies_fields(dependencies, project = project)

  # get available packages database
  dbs <- available_packages(type = "source")
  if (is.null(dbs))
    stop("no package repositories are available")

  db <- renv_available_packages_flatten(dbs)

  # warn about user-requested packages not available in repositories
  renv_checkout_report(requested, db)

  # resolve the full recursive dependency tree
  packages <- renv_checkout_resolve(packages, db, fields, project = project)

  # build enriched lockfile records from available packages metadata
  records <- renv_checkout_records(packages, db)

  # create a lockfile matching this request
  lockfile <- renv_lockfile_init(project)
  lockfile$Packages <- records

  if ("restore" %in% actions) local({

    # install the requested packages
    restore(lockfile = lockfile, clean = clean)

    # make sure we can find 'renv' on the library paths
    path <- renv_namespace_path("renv")
    renv_scope_libpaths(c(dirname(path), renv_libpaths_all()))

    # invoke activate
    args <- c("--vanilla", "-s", "-e", shQuote("renv::activate()"))
    r(args, stdout = TRUE, stderr = TRUE)

    # update the renv lockfile record
    # (note: it might not be available when running tests)
    renv <- renv_lockfile_records(lockfile)[["renv"]]
    if (!is.null(renv)) {
      renv_scope_options(renv.verbose = FALSE)
      record(records = list(renv = renv), project = project)
    }

  })

  # write the lockfile if requested
  if ("snapshot" %in% actions) {
    if ("restore" %in% actions) {
      snapshot(project = project)
    } else {
      lockfile <- renv_lockfile_fini(lockfile, project)
      class(lockfile) <- "renv_lockfile"
      renv_lockfile_write(lockfile, file = paths$lockfile(project = project))
    }
  }

  # try to restart the session if we installed some packages
  restart <- restart %||% "restore" %in% actions
  if (restart)
    renv_restart_request(project = project, reason = "renv has been updated")

  invisible(lockfile)

}

renv_checkout_packages <- function(project) {
  renv_dependencies_impl(
    project,
    field = "Package",
    dev = TRUE
  )
}

renv_checkout_report <- function(requested, db) {

  if (is.null(requested))
    return()

  missing <- setdiff(requested, db$Package)
  bulletin(
    "The following package(s) are not available in the configured repositories:",
    missing
  )

}

renv_checkout_resolve <- function(packages, db, fields, project = NULL) {

  # keep only packages which appear to be available in the repositories
  packages <- intersect(packages, db$Package)

  # remove ignored packages -- note we intentionally do this before
  # computing recursive dependencies as we don't want to allow users
  # to ignore a recursive dependency of a required package
  ignored <- renv_project_ignored_packages(project)
  packages <- setdiff(packages, ignored)

  # compute recursive dependencies for these packages
  renv_checkout_recdeps(packages, db, fields)

}

renv_checkout_records <- function(packages, db) {

  depfields <- c("Depends", "Imports", "LinkingTo", "Suggests", "Enhances")

  records <- enumerate(packages, function(package, remote) {

    # find the entry in the available packages database
    entry <- rows(db, db$Package == package)
    if (nrow(entry) == 0L)
      return(NULL)

    # build the record from available packages metadata
    record <- list(
      Package    = package,
      Version    = entry$Version,
      Source     = "Repository",
      Repository = entry$Index
    )

    # include dependency fields, split into lists
    for (field in depfields) {
      value <- entry[[field]]
      if (!is.null(value) && !is.na(value) && nzchar(value)) {
        parts <- strsplit(value, ",", fixed = TRUE)
        cleaned <- gsub("\\s+", " ", trimws(parts[[1L]]), perl = TRUE)
        record[[field]] <- as.list(cleaned)
      }
    }

    record

  })

  # drop any NULL entries (packages not found)
  filter(records, Negate(is.null))

}

renv_checkout_recdeps <- function(packages, db, fields) {

  # initialize environment (will map package names to discovered remotes)
  envir <- new.env(parent = emptyenv())

  # set R to NA since it's a common non-package 'dependency' for packages
  envir$R <- NA

  # iterate through dependencies
  for (package in packages)
    renv_checkout_recdeps_impl(package, db, envir, fields)

  # get list of discovered dependencies
  recdeps <- as.list.environment(envir, all.names = TRUE)

  # drop any NA values
  recdeps <- filter(recdeps, Negate(is.na))

  # return sorted vector
  recdeps[csort(names(recdeps))]

}

renv_checkout_recdeps_impl <- function(package, db, envir, fields) {

  # check if we've already visited this package
  if (!is.null(envir[[package]]))
    return()

  # get entry from database
  entry <- rows(db, db$Package == package)
  if (nrow(entry) == 0L) {
    envir[[package]] <- NA_character_
    return()
  }

  # set discovered remote
  envir[[package]] <- with(entry, paste(Package, Version, sep = "@"))

  # iterate through requested dependency fields
  for (field in fields) {
    value <- entry[[field]]
    if (!is.null(value) && !is.na(value)) {
      value <- renv_description_parse_field(entry[[field]])
      for (package in value$Package)
        if (is.null(envir[[package]]))
          renv_checkout_recdeps_impl(package, db, envir, fields)
    }
  }

}

renv_checkout_repos <- function(date) {

  # if no date was provided, just use default repositories
  if (is.null(date))
    return(getOption("repos"))

  # build path to repository snapshot location
  root <- dirname(config$ppm.url())
  url <- file.path(root, date)
  if (renv_download_available(file.path(url, "src/contrib/PACKAGES")))
    return(c(PPM = url))

  # requested date not available; try to search a bit
  candidate <- date
  for (i in 1:7) {
    candidate <- format(as.Date(candidate) - 1L)
    url <- file.path(root, candidate)
    if (renv_download_available(file.path(url, "src/contrib/PACKAGES"))) {
      fmt <- "- Snapshot date '%s' not available; using '%s' instead"
      printf(fmt, date, candidate)
      return(c(PPM = url))
    }
  }

  stopf("repository snapshot '%s' not available", date)

}