R/restore.R


the$restore_running <- FALSE
the$restore_state <- NULL

#' Restore project library from a lockfile
#'
#' Restore a project's dependencies from a lockfile, as previously generated by
#' [snapshot()].
#'
#' `renv::restore()` compares packages recorded in the lockfile to
#' the packages installed in the project library. Where there are differences
#' it resolves them by installing the lockfile-recorded package into the
#' project library. If `clean = TRUE`, `restore()` will additionally delete any
#' packages in the project library that don't appear in the lockfile.
#'
#' @section Transactional Restore:
#'
#' By default, `renv::restore()` will perform a 'transactional' restore, wherein the
#' project library is mutated only if all packages within the lockfile are successfully
#' restored. The intention here is to prevent the private library from entering
#' an inconsistent state, if some subset of packages were to install successfully
#' but some other subset of packages did not. `renv::restore(transactional = FALSE)`
#' can be useful if you're attempting to restore packages from a lockfile, but would
#' like to update or change certain packages piece-meal if they fail to install.
#'
#' The term 'transactional' here borrows from the parlance of a 'database transaction',
#' where the failure of any intermediate step implies that the whole transaction
#' will be rolled back, so that the state of the database before the transaction
#' was initiated can be preserved. See <https://en.wikipedia.org/wiki/Database_transaction>
#' for more details.
#'
#' @inherit renv-params
#'
#' @param library The library paths to be used during restore.
#'
#' @param packages A subset of packages recorded in the lockfile to restore.
#'   When `NULL` (the default), all packages available in the lockfile will be
#'   restored. Any required recursive dependencies of the requested packages
#'   will be restored as well.
#'
#' @param transactional Whether or not to use a 'transactional' restore.
#'   See **Transactional Restore** for more details. When `NULL` (the default),
#'   the value of the `install.transactional` [`config`] option will be used.
#'
#' @param exclude A subset of packages to be excluded during restore. This can
#'  be useful for when you'd like to restore all but a subset of packages from
#'  a lockfile. Note that if you attempt to exclude a package which is required
#'  as the recursive dependency of another package, your request will be
#'  ignored.
#'
#' @return A named list of package records which were installed by renv.
#'
#' @family reproducibility
#'
#' @export
#'
#' @example examples/examples-init.R
restore <- function(project = NULL,
                    ...,
                    library       = NULL,
                    lockfile      = NULL,
                    packages      = NULL,
                    exclude       = NULL,
                    rebuild       = FALSE,
                    repos         = NULL,
                    clean         = FALSE,
                    transactional = NULL,
                    prompt        = interactive())
{
  renv_consent_check()
  renv_scope_error_handler()
  renv_dots_check(...)

  renv_scope_binding(the, "restore_running", TRUE)

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

  # resolve library, lockfile arguments
  libpaths <- renv_libpaths_resolve(library)
  lockfile <- lockfile %||% renv_lockfile_load(project = project, strict = TRUE)

  # set up .renvignore defensively
  renv_load_cache_renvignore(project = project)

  # set up transactional param
  transactional <- transactional %||% config$install.transactional()
  renv_scope_options(renv.config.install.transactional = transactional)

  # check and ask user if they need to activate first
  renv_activate_prompt("restore", library, prompt, project)

  # activate the requested library (place at front of library paths)
  library <- nth(libpaths, 1L)
  ensure_directory(library)
  renv_scope_libpaths(libpaths)

  # resolve the lockfile
  if (is.character(lockfile))
    lockfile <- renv_lockfile_read(lockfile)

  # insert overrides (if any)
  lockfile <- renv_lockfile_override(lockfile)

  # repair potential issues in the lockfile
  lockfile <- renv_lockfile_repair(lockfile)

  # check for system requirements from these packages
  if (config$sysreqs.check(default = renv_platform_linux())) {
    records <- renv_lockfile_records(lockfile)
    sysreqs <- map(records, `[[`, "SystemRequirements")
    renv_sysreqs_check(sysreqs, prompt = prompt)
  }

  # override repositories if requested
  repos <- repos %||% config$repos.override() %||% lockfile$R$Repositories

  # transform PPM repositories if appropriate
  if (renv_ppm_enabled())
    repos <- renv_ppm_transform(repos)

  if (length(repos))
    renv_scope_options(repos = convert(repos, "character"))

  # if users have requested the use of pak, delegate there
  if (config$pak.enabled() && !recursing()) {

    renv_pak_init()
    records <- renv_pak_restore(
      lockfile = lockfile,
      packages = packages,
      exclude  = exclude,
      prompt   = prompt,
      project  = project
    )

    return(renv_restore_successful(records, prompt, project))

  }

  # set up Bioconductor version + repositories
  biocversion <- lockfile$Bioconductor$Version
  if (!is.null(biocversion)) {
    renv_bioconductor_init(library = library)
    biocversion <- package_version(biocversion)
    renv_scope_options(renv.bioconductor.version = biocversion)
  }

  # get records for R packages currently installed
  current <- snapshot(project  = project,
                      library  = libpaths,
                      lockfile = NULL,
                      type     = "all")

  # compare lockfile vs. currently-installed packages
  diff <- renv_lockfile_diff_packages(current, lockfile)

  # don't remove packages unless 'clean = TRUE'
  diff <- renv_vector_diff(diff, if (!clean) "remove")

  # only remove packages from the project library
  ispkg <- map_lgl(names(diff), function(package) {
    path <- find.package(package, lib.loc = libpaths, quiet = TRUE)
    identical(dirname(path), library)
  })
  diff <- diff[!(diff == "remove" & !ispkg)]

  # don't take any actions with ignored packages
  ignored <- renv_project_ignored_packages(project = project)
  diff <- diff[renv_vector_diff(names(diff), ignored)]

  # only take action with requested packages
  packages <- setdiff(packages %||% names(diff), exclude)
  diff <- diff[intersect(names(diff), packages)]

  if (!length(diff)) {
    name <- if (!missing(library)) "library" else "project"
    writef("- The %s is already synchronized with the lockfile.", name)
    return(renv_restore_successful(diff, prompt, project))
  }

  # transform binary repository URLs into source repository URLs
  current  <- renv_restore_normalize(current)
  lockfile <- renv_restore_normalize(lockfile)


  # TODO: should we avoid double-prompting here?
  # we prompt once here for the preflight check, and then again below based
  # on the actions we'll perform.
  if (!renv_restore_preflight(project, libpaths, diff, current, lockfile))
    cancel_if(prompt && !proceed())

  if (prompt || renv_verbose()) {
    renv_restore_report_actions(diff, current, lockfile)
    cancel_if(prompt && !proceed())
  }

  # perform the restore
  records <- renv_restore_run_actions(project, diff, current, lockfile, rebuild)
  renv_restore_successful(records, prompt, project)
}

renv_restore_run_actions <- function(project, actions, current, lockfile, rebuild) {

  packages <- names(actions)

  renv_scope_restore(
    project  = project,
    library  = renv_libpaths_active(),
    records  = renv_lockfile_records(lockfile),
    packages = packages,
    rebuild  = rebuild
  )

  # first, handle package removals
  removes <- actions[actions == "remove"]
  enumerate(removes, function(package, action) {
    renv_restore_remove(project, package, current)
  })

  # next, handle installs
  installs <- actions[actions != "remove"]
  packages <- names(installs)

  # perform the install
  records <- renv_retrieve_impl(packages)
  renv_install_impl(records)

  # detect dependency tree repair
  diff <- renv_lockfile_diff_packages(renv_lockfile_records(lockfile), records)
  diff <- diff[diff != "remove"]
  if (!empty(diff)) {
    renv_pretty_print_records(
      "The dependency tree was repaired during package installation:",
      records[names(diff)],
      "Call `renv::snapshot()` to capture these dependencies in the lockfile."
    )
  }

  # check installed packages and prompt for reload if needed
  renv_install_postamble(names(records))

  # return status
  invisible(records)

}

renv_restore_state <- function(key = NULL) {
  state <- the$restore_state
  if (is.null(key)) state else state[[key]]
}

renv_restore_begin <- function(project = NULL,
                               library = NULL,
                               records = NULL,
                               packages = NULL,
                               handler = NULL,
                               rebuild = NULL,
                               recursive = TRUE)
{
  # resolve rebuild request
  rebuild <- case(
    identical(rebuild, TRUE)  ~ packages,
    identical(rebuild, FALSE) ~ character(),
    identical(rebuild, "*")   ~ NA_character_,
    as.character(rebuild)
  )

  # get previous restore state (so we can restore it after if needed)
  oldstate <- the$restore_state

  # set new restore state
  the$restore_state <- env(

    # the active project (if any) used for restore
    project = project,

    # the library path into which packages will be installed.
    # this is set because some behaviors depend on whether the target
    # library is the project library, but during staged installs the
    # library paths might be mutated during restore
    library = library,

    # the package records used for restore, providing information
    # on the packages to be installed (their version, source, etc)
    records = records,

    # the set of packages to be installed in this restore session;
    # as explicitly requested by the user / front-end API call.
    # packages in this list should be re-installed even if a compatible
    # version appears to be already installed
    packages = packages,

    # an optional handler, to be used during retrieve / restore
    # TODO: should we split this into separate handlers?
    handler = handler %||% function(package, action) action,

    # packages which should be rebuilt (skipping the cache)
    rebuild = rebuild,

    # should package dependencies be crawled recursively? this is useful if
    # the records list is incomplete and needs to be built as packages are
    # downloaded
    recursive = recursive,

    # packages which we have attempted to retrieve
    retrieved = new.env(parent = emptyenv()),

    # packages which need to be installed
    install = mapping(),

    # a collection of the requirements imposed on dependent packages
    # as they are discovered
    requirements = new.env(parent = emptyenv()),

    # the number of packages that were downloaded
    downloaded = 0L

  )

  # return prior state
  oldstate

}

renv_restore_end <- function(state) {
  the$restore_state <- state
}

# nocov start

renv_restore_report_actions <- function(actions, current, lockfile) {

  if (!renv_verbose() || empty(actions))
    return(invisible(NULL))

  lhs <- renv_lockfile_records(current)
  rhs <- renv_lockfile_records(lockfile)
  renv_pretty_print_records_pair(
    "The following package(s) will be updated:",
    lhs[names(lhs) %in% names(actions)],
    rhs[names(rhs) %in% names(actions)]
  )

}

# nocov end

renv_restore_remove <- function(project, package, lockfile) {
  records <- renv_lockfile_records(lockfile)
  record <- records[[package]]
  printf("- Removing %s [%s] ... ", package, record$Version)
  paths <- renv_paths_library(project = project, package)
  recursive <- renv_file_type(paths) == "directory"
  unlink(paths, recursive = recursive)
  writef("OK [removed from library]")
  TRUE
}

renv_restore_preflight <- function(project, libpaths, actions, current, lockfile) {
  records <- renv_lockfile_records(lockfile)
  matching <- keep(records, names(actions))
  renv_install_preflight(project, libpaths, matching)
}

renv_restore_find <- function(package, record) {

  # skip packages whose installation was explicitly requested
  state <- renv_restore_state()
  record <- renv_record_validate(package, record)
  if (package %in% state$packages)
    return("")

  # check the active library paths to see if this package is already installed
  for (library in renv_libpaths_all()) {
    path <- renv_restore_find_impl(package, record, library)
    if (nzchar(path))
      return(path)
  }

  ""

}

renv_restore_find_impl <- function(package, record, library) {

  path <- file.path(library, package)
  if (!file.exists(path))
    return("")

  # attempt to read DESCRIPTION
  current <- catch(as.list(renv_description_read(path)))
  if (inherits(current, "error"))
    return("")

  # check for an up-to-date version from R package repository
  if (renv_record_source(record) %in% c("cran", "repository")) {
    fields <- c("Package", "Version")
    if (identical(record[fields], current[fields]))
      return(path)
  }

  # otherwise, match on remote fields
  fields <- renv_record_names(record, c("Package", "Version"))
  if (identical(record[fields], current[fields]))
    return(path)

  # failed to match; return empty path
  ""

}

renv_restore_rebuild_required <- function(record) {
  state <- renv_restore_state()
  any(c(NA_character_, record$Package) %in% state$rebuild)
}

renv_restore_successful <- function(records, prompt, project) {

  # ensure the activate script is up-to-date
  renv_infrastructure_write_activate(project, create = FALSE)

  # perform python-related restore steps
  renv_python_restore(project, prompt)

  # return restored records
  invisible(records)

}

renv_restore_normalize <- function(lockfile) {
  records <- renv_lockfile_records(lockfile)
  renv_lockfile_records(lockfile) <- map(records, renv_restore_normalize_impl)
  lockfile
}

renv_restore_normalize_impl <- function(record) {

  # transform binary repository URLs into source URLs
  if (config$ppm.enabled()) {
    repository <- record[["Repository"]] %||% ""
    if (nzchar(repository)) {
      srcurl <- renv_ppm_normalize(repository)
      binurl <- renv_ppm_transform(srcurl)
      record[["Repository"]] <- binurl
    }
  }

  # apply override if set
  override <- config$repos.override()
  if (length(override)) {
    record[["Repository"]] <- NULL
  }

  # return potentially mutated record
  record

}