renv: Project Environments for R

#' Restore a Project
#'
#' Restore a project's dependencies from a lockfile, as previously generated by
#' [snapshot()].
#'
#' @param lockfile The lockfile to be used for restoration of the associated
#'   project. When `NULL`, the most recently generated lockfile for this project
#'   is used.
#'
#' @param library The path to the library in which packages will be restored.
#'   When `NULL`, the project library is used.
#'
#' @param actions The restore actions to take. By default, all actions are
#'   taken, thereby synchronizing the state of the project library with that of
#'   the lockfile. See **Actions** for more details.
#'
#' @section Actions:
#'
#' `renv` classifies the different actions that will be taken during restore
#' into five fundamental types:
#'
#' \tabular{ll}{
#'
#' \code{install} \tab
#'   Install a package recorded in the lockfile,
#'   but not currently installed in the project library. \cr
#'
#' \code{remove} \tab
#'   Remove a package installed in the project library,
#'   but not currently recorded in the lockfile. \cr
#'
#' \code{upgrade} \tab
#'   Upgrade a package by replacing the (older) version of the package
#'   available in the project library with a newer version as defined
#'   in the lockfile. \cr
#'
#' \code{downgrade} \tab
#'   Downgrade a package by replacing the (newer) version of the package
#'   available in the project library with an older version as defined
#'   in the lockfile. \cr
#'
#' \code{crossgrade} \tab
#'   Install a package whose lockfile record differs from the inferred
#'   record associated with the currently-installed version. This could
#'   happen if, for example, the source of a particular package was changed
#'   (e.g. a package originally installed from GitHub was later installed
#'   from CRAN). \cr
#'
#' }
#'
#' This can be useful if you want to perform only non-destructive changes during
#' restore -- for example, you can invoke `renv::restore(actions = "install")`
#' to avoid modifying or removing packages that have already been installed into
#' your project's private library.
#'
#' @inheritParams renv-params
#'
#' @family reproducibility
#'
#' @export
restore <- function(project  = NULL,
                    library  = NULL,
                    lockfile = NULL,
                    actions  = c("install", "remove", "upgrade", "downgrade", "crossgrade"),
                    confirm  = interactive())
{
  renv_scope_error_handler()

  project  <- project %||% renv_project()
  library  <- library %||% renv_paths_library(project = project)
  lockfile <- lockfile %||% renv_lockfile_load(project = project)

  # activate the requested library
  ensure_directory(library)
  renv_scope_libpaths(library)

  # perform Python actions on exit
  on.exit(renv_python_restore(project), add = TRUE)

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

  # detect changes in R packages in the lockfile
  current <- snapshot(project = project, library = library, lockfile = NULL)
  diff <- renv_lockfile_diff_packages(current, lockfile)

  # only keep requested actions
  diff <- diff[diff %in% actions]

  # don't take any actions with ignored packages
  ignored <- settings$ignored.packages(project = project)
  diff <- diff[setdiff(names(diff), ignored)]

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

  if (!renv_restore_preflight(project, library, diff, current, lockfile, confirm)) {
    message("* Operation aborted.")
    return(FALSE)
  }

  if (confirm || renv_verbose())
    renv_restore_report_actions(diff, current, lockfile)

  if (confirm && !proceed()) {
    message("Operation aborted.")
    return(invisible(diff))
  }

  # perform the restore
  status <- renv_restore_run_actions(project, diff, current, lockfile)

  # check to see if the lockfile is now up to date; if it's not,
  # then the restore might've repaired the dependency tree and
  # we should snapshot to capture the new changes
  renv_restore_postamble(project, lockfile, confirm)

  invisible(status)
}

renv_restore_postamble <- function(project, lockfile, confirm) {

  actions <- renv_lockfile_diff_packages(
    lockfile,
    snapshot(project = project, lockfile = NULL)
  )

  if (empty(actions))
    return(NULL)

  msg <- stack()
  msg$push("The dependency tree was repaired during package restoration.")
  if (confirm)
    msg$push("You will be prompted to snapshot the newly-installed packages.")
  else
    msg$push("The lockfile will be updated with the newly-installed packages.")

  writeLines(as.character(msg$data()))
  snapshot(project = project, confirm = confirm)
}

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

  records <- renv_records(lockfile)
  renv_restore_begin(records, names(actions))
  on.exit(renv_restore_end(), add = TRUE)

  # 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)
  records <- renv_records(lockfile)

  # perform the install
  library <- renv_libpaths_default()
  records <- renv_retrieve(packages)
  renv_install(records, library, project)

}

renv_restore_state <- function() {
  renv_global_get("restore.state")
}

renv_restore_begin <- function(records = NULL,
                               packages = NULL,
                               handler = NULL,
                               recursive = TRUE)
{

  renv_global_set("restore.state", env(

    # 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 requested by the user / front-end API call
    packages = packages,

    # an optional custom error handler
    handler = handler %||% function(package, action) action,

    # 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 during restore
    retrieved = stack(),
    retrieved.env = new.env(parent = emptyenv()),

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

  ))

}

renv_restore_end <- function() {
  renv_global_clear("restore.state")
}

# nocov start

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

  if ("install" %in% actions) {
    renv_pretty_print_records(
      renv_records_select(lockfile, actions, "install"),
      "The following package(s) will be installed:"
    )
  }

  if ("remove" %in% actions) {
    renv_pretty_print_records(
      renv_records_select(current, actions, "remove"),
      "The following package(s) will be removed:"
    )
  }

  if ("upgrade" %in% actions) {
    renv_pretty_print_records(
      renv_records_select(lockfile, actions, "upgrade"),
      "The following package(s) will be upgraded:"
    )
  }

  if ("downgrade" %in% actions) {
    renv_pretty_print_records(
      renv_records_select(lockfile, actions, "downgrade"),
      "The following package(s) will be downgraded:"
    )
  }

  if ("crossgrade" %in% actions) {
    renv_pretty_print_records(
      renv_records_select(lockfile, actions, "crossgrade"),
      "The following package(s) will be modified:"
    )
  }

}

# nocov end

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

renv_restore_preflight_unknown_source <- function(actions, lockfile) {

  records <- renv_records(lockfile)
  matching <- records[intersect(names(records), names(actions))]
  unknown <- Filter(
    function(record) record$Source %in% "unknown",
    matching
  )

  if (empty(unknown))
    return(TRUE)

  if (renv_verbose()) {
    renv_pretty_print_records(
      unknown,
      "The following package(s) were installed from an unknown source:",
      "renv will attempt to install the latest version(s) from CRAN instead."
    )
  }

  FALSE

}

renv_restore_preflight_permissions <- function(library) {

  # check for inability to install in requested library
  access <- file.access(library, 7)
  if (access == 0L)
    return(TRUE)

  if (renv_verbose()) {
    renv_pretty_print(
      library,
      "You do not have permissions to read / write into the requested library:",
      "renv may be unable to restore packages."
    )
  }

  FALSE

}

renv_restore_preflight <- function(project, library, actions, current, lockfile, confirm) {

  # check for packages installed from an unknown source
  ok <- all(
    renv_restore_preflight_unknown_source(actions, lockfile),
    renv_restore_preflight_permissions(library)
  )

  if (!ok && confirm && !proceed())
    return(FALSE)

  TRUE

}

renv_restore_skip <- function(record) {

  # don't skip if installation was explicitly requested
  state <- renv_restore_state()
  if (record$Package %in% state$packages)
    return(FALSE)

  # need to restore if it's not yet installed
  library <- renv_global_get("install.library") %||% renv_libpaths_default()
  target <- file.path(library, record$Package)
  if (!file.exists(target))
    return(FALSE)

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

  # check for matching records
  source <- tolower(record$Source)
  if (empty(source))
    return(FALSE)

  # check for an up-to-date version from CRAN
  if (identical(source, "cran")) {
    fields <- c("Package", "Version")
    if (identical(record[fields], current[fields]))
      return(TRUE)
  }

  # otherwise, match on remote fields
  fields <- c("Package", "Version", grep("^Remote", names(record), value = TRUE))
  if (identical(record[fields], current[fields]))
    return(TRUE)

  FALSE

}