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.
#'
#' @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",
                     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
  packages <- packages %||% renv_checkout_packages(project = project)

  # get the associated remotes for these packages
  remotes <- renv_checkout_remotes(packages, project)

  # parse these into package records
  records <- map(remotes, renv_remotes_resolve, latest = TRUE)

  # 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)

    # 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)
    }

  })

  # re-generate the lockfile if requested
  if ("snapshot" %in% actions) {
    snapshot(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_remotes <- function(packages, project) {

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

  # flatten so we only see the latest version of a package
  db <- renv_available_packages_flatten(dbs)

  # 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)

}

renv_checkout_recdeps <- function(packages, db) {

  # 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)

  # 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) {

  # 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 hard dependencies
  fields <- c("Depends", "Imports", "LinkingTo")
  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)
    }
  }

  # for soft dependencies, only include those if they're currently installed
  # TODO: or check if it's in the lockfile?
  value <- entry[["Suggests"]]
  if (!is.null(value) && !is.na(value)) {
    value <- renv_description_parse_field(value)
    for (package in value$Package)
      if (is.null(envir[[package]]))
        if (renv_package_installed(package))
          renv_checkout_recdeps_impl(package, db, envir)
  }

}

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)

}