#
# Auto-generated by 'tools/tools-sync-renv.R' at 2022-08-09 16:19:51
# with 'git clone --branch 0.15.5-48 --depth 1 https://github.com/rstudio/renv'.
# renv (0.15.5-48 a74721479861a7015bbb661ee8836fa65cfd18a8)
#


renv_abi_check <- function(packages = NULL,
                           ...,
                           libpaths = NULL,
                           project  = NULL)
{
  if (renv_platform_windows()) {
    writef("* ABI conflict checks are not yet implemented on Windows.")
    return()
  }

  # disable via option if necessary
  enabled <- getOption("renv.abi.check", default = TRUE)
  if (identical(enabled, FALSE))
    return()

  # resolve arguments
  project <- renv_project_resolve(project)
  libpaths <- libpaths %||% renv_libpaths_all()

  # read installed packages
  packages <- packages %||% renv_abi_packages(project, libpaths)

  # analyze each package
  problems <- stack()
  map(packages, function(package) {
    tryCatch(
      renv_abi_check_impl(package, problems),
      error = warning
    )
  })

  # report problmes
  data <- problems$data()
  if (empty(data)) {
    fmt <- "* No ABI conflicts were detected in the set of installed packages."
    writef(fmt)
    return(invisible(data))
  }

  # combine everything together
  tbl <- bind(data)

  # make reports for each different type
  reasons <- unique(tbl$reason)
  if ("Rcpp_precious_list" %in% reasons) {
    packages <- sort(unique(tbl$package[tbl$reason == "Rcpp_precious_list"]))
    renv_pretty_print(
      values    = packages,
      preamble  = "The following packages were built against a newer version of Rcpp than is currently available:",
      postamble = c(
        paste(
          "These packages depend on Rcpp (>= 1.0.7);",
          "however, Rcpp", renv_package_version("Rcpp"), "is currently installed."
        ),
        "Consider installing a new version of Rcpp with 'install.packages(\"Rcpp\")'."
      ),
      wrap = FALSE
    )
  }

  invisible(tbl)

}

renv_abi_check_impl <- function(package, problems) {

  # find path to package
  pkgpath <- renv_package_find(package)

  # look for an associated shared object
  shlib <- renv_package_shlib(pkgpath)
  if (!file.exists(shlib))
    return()

  # read symbols from LinkingTo dependency packages
  pkgdesc <- renv_description_read(path = pkgpath)
  if (is.null(pkgdesc$LinkingTo))
    return()

  # read symbols from the library
  symbols <- renv_abi_symbols(shlib)

  # handle Rcpp
  linkdeps <- renv_description_parse_field(pkgdesc$LinkingTo)
  if ("Rcpp" %in% linkdeps$Package)
    renv_abi_check_impl_rcpp(package, symbols, problems)

  # TODO: other checks? more direct symbol checks for other packages?

}

renv_abi_check_impl_rcpp <- function(package, symbols, problems) {

  # read Rcpp symbols
  rcpplib <- renv_package_shlib("Rcpp")
  rcppsyms <- renv_abi_symbols(rcpplib)

  # perform checks for different versions of Rcpp
  renv_abi_check_impl_rcpp_preciouslist(package, symbols, rcppsyms, problems)

}

renv_abi_check_impl_rcpp_preciouslist <- function(package, symbols, rcppsyms, problems) {

  # check for dependency on Rcpp_precious APIs
  required <- grep("Rcpp_precious", symbols$symbol, value = TRUE)
  if (empty(required))
    return()

  # check for Rcpp_precious APIs being available
  available <- grep("Rcpp_precious", rcppsyms$symbol, value = TRUE)
  if (length(available))
    return()

  problem <- renv_abi_problem(
    package    = paste(package, renv_package_version(package)),
    dependency = paste("Rcpp", renv_package_version("Rcpp")),
    reason     = "Rcpp_precious_list"
  )

  problems$push(problem)

}

renv_abi_symbols <- function(path, args = NULL) {

  # invoke nm to read symbols
  output <- renv_system_exec(
    command = "nm",
    args    = c(args, renv_shell_path(path)),
    action  = "reading symbols"
  )

  # parse output
  parts <- strsplit(output, "\\s+")
  data <- .mapply(c, parts, NULL)
  names(data) <- c("offset", "type", "symbol")

  # join into data.frame
  as.data.frame(
    data,
    row.names = NULL,
    stringsAsFactors = FALSE
  )

}

renv_abi_problem <- function(package, dependency, reason) {

  list(
    package    = package,
    dependency = dependency,
    reason     = reason
  )

}

renv_abi_packages <- function(project, libpaths) {

  # create a lockfile
  lockfile <- snapshot(
    library  = libpaths,
    lockfile = NULL,
    type     = "all",
    project  = project
  )

  # return package names
  names(lockfile$Packages)

}

renv_acls_reset <- function(source, target = dirname(source)) {

  # only run on Linux for now
  if (!renv_platform_linux())
    return(FALSE)

  # skip if we don't have 'getfacl', 'setfacl'
  getfacl <- Sys.which("getfacl"); setfacl <- Sys.which("setfacl")
  if (!nzchar(getfacl) || !nzchar(setfacl))
    return(FALSE)

  # build command
  fmt <- "getfacl %s 2> /dev/null | setfacl -R --set-file=- %s"
  cmd <- sprintf(fmt, renv_shell_path(target), renv_shell_path(source))

  # execute it
  # TODO: Should we report errors? If so, how?
  catch(
    renv_system_exec(
      command = cmd,
      action = "resetting ACLs",
      quiet = TRUE
    )
  )

}

actions <- function(action = c("snapshot", "restore"),
                    ...,
                    project = NULL,
                    library = NULL,
                    lockfile = NULL,
                    type = settings$snapshot.type(project = project),
                    clean = FALSE)
{
  action   <- match.arg(action)
  project  <- renv_project_resolve(project)
  lockfile <- lockfile %||% renv_lockfile_path(project = project)

  renv_scope_lock(project = project)

  switch(
    action,
    snapshot = renv_actions_snapshot(project, library, lockfile, type),
    restore  = renv_actions_restore(project, library, lockfile, clean)
  )
}

renv_actions_merge <- function(snap, lock, diff) {

  fields <- c("Package", "Version", "Source")
  defaults <- data.frame(
    "Package"          = character(),
    "Library Version"  = character(),
    "Library Source"   = character(),
    "Lockfile Version" = character(),
    "Lockfile Source"  = character(),
    check.names = FALSE,
    stringsAsFactors = FALSE
  )

  lhs <- bapply(unname(renv_records(snap)), `[`, fields)
  if (length(lhs))
    names(lhs) <- c("Package", paste("Library",  names(lhs)[-1L]))

  rhs <- bapply(unname(renv_records(lock)), `[`, fields)
  if (length(rhs))
    names(rhs) <- c("Package", paste("Lockfile", names(rhs)[-1L]))

  merged <- if (length(lhs) && length(rhs))
    merge(lhs, rhs, by = "Package", all = TRUE)
  else if (length(lhs))
    lhs
  else if (length(rhs))
    rhs
  else
    defaults

  actions <- data.frame(Package = names(diff),
                        Action = as.character(diff),
                        check.names = FALSE,
                        stringsAsFactors = FALSE)

  all <- merge(merged, actions, by = "Package")

  missing <- setdiff(names(defaults), names(all))
  all[missing] <- NA_character_

  all

}

renv_actions_snapshot <- function(project, library, lockfile, type) {

  lock <- renv_lockfile_load(project = project)
  snap <- snapshot(project = project,
                   library = library,
                   lockfile = NULL,
                   type = type)

  diff <- renv_lockfile_diff_packages(lock, snap)
  renv_actions_merge(snap, lock, diff)

}

renv_actions_restore <- function(project, library, lockfile, clean) {

  # NOTE: we use a simple snapshot here as we just want to know the
  # difference in library state before and after applying the lockfile;
  # that is, we want to know what the library looks like without any
  # filtering of what records would be reported from the library
  lock <- renv_lockfile_load(project = project)
  snap <- snapshot(project = project,
                   library = library,
                   lockfile = NULL,
                   type = "all")

  diff <- renv_lockfile_diff_packages(snap, lock)
  actions <- renv_actions_merge(snap, lock, diff)
  renv_actions_restore_clean(actions, clean, project)

}

renv_actions_restore_clean <- function(actions, clean, project) {

  # if not cleaning, then we don't do any removals
  if (!clean) {
    filtered <- actions[actions$Action != "remove", ]
    return(filtered)
  }

  # otherwise, only process removals in the project library
  projlib <- renv_paths_library(project = project)
  locations <- renv_package_find(actions$Package)

  keep <- actions$Action != "remove" | dirname(locations) == projlib
  actions[keep, ]

}

#' Activate a Project
#'
#' Activate a project, thereby loading it in the current session and also
#' writing the infrastructure necessary to ensure the project is auto-loaded
#' for newly-launched \R sessions.
#'
#' Using `activate()` will:
#'
#' 1. Load the requested project via [renv::load()],
#'
#' 2. Add `source("renv/init.R")` to the project `.Rprofile`, thereby
#'    instructing newly-launched \R sessions to automatically load the
#'    current project.
#'
#' Normally, `activate()` is called as part of [renv::init()] when a project
#' is first initialized. However, `activate()` can be used to activate
#' (or re-activate) an `renv` project -- for example, if the project was shared
#' without the auto-loader included in the project `.Rprofile`, or because
#' that project was previously deactivated (via [renv::deactivate()]).
#'
#' @inherit renv-params
#'
#' @family renv
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # activate the current project
#' renv::activate()
#'
#' # activate a separate project
#' renv::activate("~/projects/analysis")
#'
#' }
activate <- function(project = NULL, profile = NULL) {

  renv_consent_check()
  renv_scope_error_handler()

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  renv_profile_set(profile)

  renv_activate_impl(
    project = project,
    profile = profile,
    version = NULL,
    restart = FALSE,
    quiet   = FALSE
  )

  invisible(project)

}

renv_activate_impl <- function(project,
                               profile,
                               version,
                               restart,
                               quiet)
{
  # prepare renv infrastructure
  renv_infrastructure_write(
    project = project,
    profile = profile,
    version = version
  )

  # try to load the project
  load(project, quiet = quiet)

  # ensure renv is imbued into the new library path if necessary
  if (!renv_tests_running())
    renv_imbue_self(project)

  # restart session if requested
  if (restart)
    renv_restart_request(project, reason = "renv activated")
  else if (renv_rstudio_available())
    renv_rstudio_initialize(project)

}

renv_activate_version <- function(project) {

  # try to get version from activate.R
  methods <- list(
    renv_activate_version_lockfile,
    renv_activate_version_activate,
    renv_activate_version_default
  )

  for (method in methods) {
    version <- catch(method(project))
    if (is.character(version))
      return(version)
  }

  fmt <- "failed to determine renv version for project '%s'"
  stopf(fmt, aliased_path(project))

}

renv_activate_version_activate <- function(project) {

  activate <- renv_paths_activate(project = project)
  if (!file.exists(activate))
    return(NULL)

  contents <- readLines(activate, warn = FALSE)
  line <- grep("^\\s*version", contents, value = TRUE)
  parsed <- parse(text = line)[[1]]
  parsed[[3]]

}

renv_activate_version_lockfile <- function(project) {

  path <- renv_lockfile_path(project)
  if (!file.exists(path))
    return(NULL)

  lockfile <- renv_lockfile_read(path)
  lockfile$Packages[["renv"]]$Version %||% lockfile$renv$Version

}

renv_activate_version_default <- function(project) {
  renv_namespace_version("renv")
}

renv_activate_prompt <- function(action, library, prompt, project) {

  # check whether we should ask user to activate
  ask <-
    config$activate.prompt() &&
    prompt &&
    interactive() &&
    is.null(library) &&
    !identical(project, Sys.getenv("RENV_PROJECT"))

  if (!ask)
    return(FALSE)

  fmt <- lines(
    "",
    "This project has not yet been activated.",
    "Activating this project will ensure the project library is used during %s.",
    "Please see `?renv::activate` for more details.",
    ""
  )

  notice <- sprintf(fmt, action)
  vwritef(notice)

  fmt <- "Would you like to activate this project before %s?"
  question <- sprintf(fmt, action)
  response <- ask(question, default = TRUE)
  if (!response)
    return(FALSE)

  activate(project = project)
  return(TRUE)

}

renv_addins_embed_ui <- function() {

  miniUI::miniPage(
    miniUI::gadgetTitleBar("Embed a Lockfile"),
    miniUI::miniContentPanel(
      shiny::verticalLayout(
        shiny::fileInput(
          inputId     = "lockfile",
          label       = "Lockfile path:",
          placeholder = "(Use default)"
        )
      )
    )
  )

}

renv_addins_embed_server <- function(input, output, session) {

  shiny::observeEvent(input$done, {

    # notify the user that we're working now
    progress <- shiny::Progress$new(
      session = shiny::getDefaultReactiveDomain(),
      style   = "notification"
    )

    progress$set(message = "Embedding lockfile...")

    # get editor context
    context <- rstudioapi::getSourceEditorContext()

    # validate we have a path
    path <- context$path
    if (!nzchar(path))
      stop("cannot embed lockfile into an unsaved file", call. = FALSE)

    # get project path
    project <- rstudioapi::getActiveProject()

    # read lockfile
    lockfile <- input$lockfile
    if (!is.null(lockfile))
      lockfile <- renv_lockfile_read(file = lockfile$datapath)

    # save document and run embed
    rstudioapi::documentSave(id = context$id)
    embed(path = path, lockfile = lockfile, project = project)

    # stop app
    invisible(shiny::stopApp())

  })

}

renv_addins_embed <- function() {

  # first, check that shiny and miniUI are available
  for (package in c("miniUI", "rstudioapi", "shiny")) {
    if (!requireNamespace(package, quietly = TRUE)) {
      fmt <- "required package '%s' is not available"
      stopf(fmt, package)
    }
  }

  # ask the user to save the document first if necessary
  context <- rstudioapi::getSourceEditorContext()
  if (!nzchar(context$path))
    stop("this addin cannot be run with an unsaved document")

  # okay, we can run the addin
  shiny::runGadget(
    app    = renv_addins_embed_ui(),
    server = renv_addins_embed_server,
    viewer = shiny::dialogViewer(
      dialogName = "Embed Lockfile",
      width  = 400,
      height = 200
    )
  )
}


# aliases used primarily for nicer / normalized text output
`_renv_aliases` <- list(
  bioconductor = "Bioconductor",
  bitbucket    = "Bitbucket",
  cellar       = "Cellar",
  cran         = "CRAN",
  git2r        = "Git",
  github       = "GitHub",
  gitlab       = "GitLab",
  local        = "Local",
  repository   = "Repository",
  standard     = "Repository",
  url          = "URL",
  xgit         = "Git"
)

alias <- function(text) {
  `_renv_aliases`[[text]] %||% text
}

renv_archive_type <- function(archive) {

  ext <- fileext(archive)

  if (ext %in% c(".tgz", ".tar", ".tar.gz"))
    return("tar")
  else if (ext %in% c(".zip"))
    return("zip")
  else
    return("unknown")

}

renv_archive_list <- function(archive) {
  suppressWarnings(renv_archive_list_impl(archive))
}

renv_archive_list_impl <- function(archive) {

  switch(
    renv_archive_type(archive),
    tar = untar(archive, list = TRUE),
    zip = unzip(archive, list = TRUE)[["Name"]],
    stopf("don't know how to list files in archive '%s'", basename(archive))
  )

}

renv_archive_decompress <- function(archive, files = NULL, exdir = ".", ...) {

  switch(
    renv_archive_type(archive),
    tar = renv_archive_decompress_tar(archive, files = files, exdir = exdir, ...),
    zip = renv_archive_decompress_zip(archive, files = files, exdir = exdir, ...),
    stopf("don't know how to decompress archive '%s'", basename(archive))
  )

}

renv_archive_decompress_tar <- function(archive, files = NULL, exdir = ".", ...) {

  # if an appropriate system tar is available, use it
  tar <- renv_tar_exe()
  if (nzchar(tar))
    return(renv_tar_decompress(tar, archive = archive, files = files, exdir = exdir, ...))

  # when using internal TAR, we want to suppress warnings
  # (otherwise we get noise about global PAX headers)
  suppressWarnings(untar(archive, files = files, exdir = exdir, tar = "internal", ...))
  return(TRUE)

}

renv_archive_decompress_zip <- function(archive, files = NULL, exdir = ".", ...) {

  # the default unzip tool will give warnings rather than
  # errors if R was unable to extract from a zip archive
  status <- tryCatch(
    unzip(archive, files = files, exdir = exdir, ...),
    condition = identity
  )

  if (inherits(status, "condition")) {
    fmt <- "failed to decompress '%s' [%s]"
    message <- sprintf(fmt, basename(archive), conditionMessage(status))
    stop(simpleError(message))
  }

  TRUE

}

renv_archive_find <- function(archive, pattern) {
  files <- renv_archive_list(archive)
  grep(pattern, files, value = TRUE)
}

renv_archive_read <- function(archive, file) {

  type <- renv_archive_type(archive)
  case(
    type == "tar" ~ renv_archive_read_tar(archive, file),
    type == "zip" ~ renv_archive_read_zip(archive, file),
    ~ stopf("don't know how to read file from archive %s", renv_path_pretty(archive))
  )

}

renv_archive_read_tar <- function(archive, file) {

  # if an appropriate tar is available, use it
  tar <- renv_tar_exe()
  if (nzchar(tar)) {
    args <- c("xf", renv_shell_path(archive), "-O", renv_shell_path(file))
    return(renv_system_exec(tar, args, action = "reading file from archive"))
  }

  # create extraction directory
  exdir <- renv_scope_tempfile("renv-archive-")
  ensure_directory(exdir)

  # unpack the requested file
  suppressWarnings(untar(archive, files = file, exdir = exdir, tar = "internal"))

  # and read it
  archive <- file.path(exdir, file)
  readLines(archive, warn = FALSE)

}

renv_archive_read_zip <- function(archive, file) {
  renv_scope_tempdir()
  conn <- unz(archive, file, encoding = "native.enc")
  on.exit(close(conn), add = TRUE)
  readLines(conn, warn = FALSE)
}

#' Auto-load the Active Project
#'
#' Automatically load the `renv` project associated with a particular directory.
#' `renv` will search parent directories for the `renv` project root; if found,
#' that project will be loaded via [renv::load()].
#'
#' To enable the `renv` auto-loader, you can place:
#'
#' ```
#' renv::autoload()
#' ````
#'
#' into your site-wide or user `.Rprofile` to ensure that `renv` projects are
#' automatically loaded for any newly-launched \R sessions, even if those \R
#' sessions are launched within the sub-directory of an `renv` project.
#'
#' If you'd like to launch \R within the sub-directory of an `renv` project
#' without auto-loading `renv`, you can set the environment variable:
#'
#' ```
#' RENV_AUTOLOAD_ENABLED = FALSE
#' ```
#'
#' before starting \R.
#'
#' Note that `renv::autoload()` is only compatible with projects using
#' `renv 0.15.3` or newer, as it relies on features within the `renv/activate.R`
#' script that are only generated with newer versions of `renv`.
#'
#' @export
autoload <- function() {
  invisible(renv_autoload_impl())
}

renv_autoload_impl <- function() {

  # check if we're disabled
  enabled <- Sys.getenv("RENV_AUTOLOAD_ENABLED", unset = "TRUE")
  if (falsy(enabled, FALSE))
    return(FALSE)

  # bail if load is already being called
  loading <- getOption("renv.load.running")
  if (identical(loading, TRUE))
    return(FALSE)

  # avoid recursion
  running <- getOption("renv.autoload.running")
  if (identical(running, TRUE))
    return(FALSE)

  # set our flag
  renv_scope_options(renv.autoload.running = TRUE)

  # try to find a project
  project <- catch(renv_project_find())
  if (inherits(project, "error"))
    return(FALSE)

  # move to project directory
  owd <- setwd(project)
  on.exit(setwd(owd), add = TRUE)

  # if we have a project profile, source it
  profile <- file.path(project, ".Rprofile")
  if (file.exists(profile)) {
    sys.source(profile, envir = globalenv())
    return(TRUE)
  }

  # if we have an activate script, run it
  activate <- file.path(project, "renv/activate.R")
  if (file.exists(activate)) {
    sys.source(activate, envir = globalenv())
    return(TRUE)
  }

  # otherwise, just try to load the project
  load(project)
  TRUE

}

# tools for querying information about packages available on CRAN.
# note that this does _not_ merge package entries from multiple repositories;
# rather, a list of databases is returned (one for each repository)
renv_available_packages <- function(type, repos = NULL, limit = NULL, quiet = FALSE) {

  limit <- limit %||% Sys.getenv("R_AVAILABLE_PACKAGES_CACHE_CONTROL_MAX_AGE", "3600")
  repos <- renv_repos_normalize(repos %||% getOption("repos"))
  if (empty(repos))
    return(NULL)

  # invalidate cache if http_proxy or https_proxy environment variables change,
  # since those could effect (or even re-direct?) repository URLs
  envkeys <- c("http_proxy", "https_proxy", "HTTP_PROXY", "HTTPS_PROXY")
  envvals <- Sys.getenv(envkeys, unset = NA)

  # invalidate the cache if 'renv.download.headers' changes as well
  headers <- getOption("renv.download.headers")
  key <- list(repos = repos, type = type, headers = headers, envvals)

  timecache(
    key     = key,
    value   = renv_available_packages_impl(type, repos, quiet),
    limit   = as.integer(limit),
    timeout = renv_available_packages_timeout
  )

}

renv_available_packages_impl <- function(type, repos, quiet = FALSE) {

  if (quiet)
    renv_scope_options(renv.verbose = FALSE)

  fmt <- "* Querying repositories for available %s packages ... "
  vprintf(fmt, type)

  # request repositories
  urls <- contrib.url(repos, type)
  errors <- new.env(parent = emptyenv())
  dbs <- lapply(urls, renv_available_packages_query, errors = errors)
  names(dbs) <- names(repos)

  # notify finished
  vwritef("Done!")

  # propagate errors
  errors <- as.list(errors)
  enumerate(errors, function(url, output) {

    warnings <- output$warnings
    messages <- output$messages
    if (empty(warnings) && empty(messages))
      return()

    fmt <- "could not retrieve available packages for url %s"
    warningf(fmt, shQuote(url))

  })

  # filter results
  Filter(Negate(is.null), dbs)

}

renv_available_packages_query_packages_rds <- function(url) {
  path <- file.path(url, "PACKAGES.rds")
  destfile <- tempfile("renv-packages-", fileext = ".rds")
  download(url = path, destfile = destfile, quiet = TRUE)
  suppressWarnings(readRDS(destfile))
}

renv_available_packages_query_packages_gz <- function(url) {
  path <- file.path(url, "PACKAGES.gz")
  destfile <- tempfile("renv-packages-", fileext = ".gz")
  download(url = path, destfile = destfile, quiet = TRUE)
  suppressWarnings(read.dcf(destfile))
}

renv_available_packages_query_packages <- function(url) {
  path <- file.path(url, "PACKAGES")
  destfile <- tempfile("renv-packages-")
  download(url = path, destfile = destfile, quiet = TRUE)
  suppressWarnings(read.dcf(destfile))
}

renv_available_packages_query <- function(url, errors) {

  # check for a cached value
  name <- sprintf("repos_%s.rds.cache", URLencode(url, reserved = TRUE))
  path <- file.path(tempdir(), name)
  if (file.exists(path)) {
    db <- readRDS(path)
    unlink(path)
    return(as.data.frame(db, stringsAsFactors = FALSE))
  }

  # define query methods for the different PACKAGES
  methods <- list(
    renv_available_packages_query_packages_rds,
    renv_available_packages_query_packages_gz,
    renv_available_packages_query_packages
  )

  seize <- function(stack, restart) {
    function(condition) {
      stack$push(condition)
      invokeRestart(restart)
    }
  }

  warnings <- stack()
  messages <- stack()
  for (method in methods) {

    db <- withCallingHandlers(
      catch(method(url)),
      warning = seize(warnings, "muffleWarning"),
      message = seize(messages, "muffleMessage")
    )

    if (!inherits(db, "error"))
      return(renv_available_packages_success(db, url))

  }

  data <- list(
    warnings = warnings$data(),
    messages = messages$data()
  )

  assign(url, data, envir = errors)
  NULL

}

renv_available_packages_success <- function(db, url) {

  db <- as.data.frame(db, stringsAsFactors = FALSE)
  if (nrow(db) == 0)
    return(db)

  # remove packages which won't work on this OS
  ostype <- db$OS_type
  if (is.character(ostype)) {
    ok <- is.na(ostype) | ostype %in% .Platform$OS.type
    db <- db[ok, ]
  }


  # tag with repository
  db$Repository <- url

  db

}

renv_available_packages_entry <- function(package,
                                          type   = "source",
                                          repos  = NULL,
                                          filter = NULL,
                                          quiet  = FALSE,
                                          prefer = NULL)
{

  # if filter is a string, treat it as an explicit version requirement
  version <- NULL
  if (is.character(filter)) {
    version <- filter
    filter <- function(entries) {
      matches <- which(entries$Version == version)
      candidate <- head(matches, n = 1L)
      entries[candidate, ]
    }
  }

  # by default, provide a filter that selects the newest-available package
  filter <- filter %||% function(entries) {
    version <- numeric_version(entries$Version)
    ordered <- order(version, decreasing = TRUE)
    entries[ordered[[1]], ]
  }

  # read available packages
  dbs <- renv_available_packages(
    type  = type,
    repos = repos,
    quiet = quiet
  )

  # if a preferred repository is marked and available, prefer using that
  if (length(prefer) == 1L && prefer %in% names(dbs)) {
    idx <- match(prefer, names(dbs))
    ord <- c(idx, setdiff(seq_along(dbs), idx))
    dbs <- dbs[ord]
  }

  # iterate through repositories, and find first matching
  for (i in seq_along(dbs)) {

    db <- dbs[[i]]
    matches <- which(db$Package == package)
    if (empty(matches))
      next

    entries <- db[matches, ]
    entry <- filter(entries)
    if (nrow(entry) == 0)
      next

    entry[["Type"]] <- type
    entry[["Name"]] <- names(dbs)[[i]] %||% ""
    return(entry)

  }

  # report package + version if both available
  pkgver <- if (length(version))
    paste(package, version)
  else
    package

  fmt <- "failed to find %s for '%s' in package repositories"
  stopf(fmt, type, pkgver)

}

renv_available_packages_timeout <- function(data) {
  urls <- contrib.url(data$repos, data$type)
  for (url in urls) {
    name <- sprintf("repos_%s.rds", URLencode(url, reserved = TRUE))
    path <- file.path(tempdir(), name)
    unlink(path)
  }
}

renv_available_packages_record <- function(entry, type) {

  # check to see if this is already a proper record
  attrs <- attributes(entry)
  keys <- c("type", "url")
  if (all(keys %in% names(attrs)))
    return(entry)

  # otherwise, construct it
  record <- entry

  if (identical(record$Name, "__renv_cellar__")) {
    record$Source     <- "Cellar"
    record$Repository <- NULL
    record$Name       <- NULL
  } else {
    record$Source     <- "Repository"
    record$Repository <- entry$Name
    record$Name       <- NULL
  }

  # form url
  url <- entry$Repository
  path <- entry$Path
  if (is.character(path) && !is.na(path))
    url <- paste(url, path, sep = "/")

  attr(record, "type") <- type
  attr(record, "url")  <- url

  record

}

renv_available_packages_latest_repos_impl <- function(package, type, repos) {

  # get available packages
  dbs <- renv_available_packages(
    type  = type,
    repos = repos,
    quiet = TRUE
  )

  # prepend local sources if available
  cellar <- renv_available_packages_cellar(type = type)
  if (!is.null(cellar)) {
    db <- list("__renv_cellar__" = cellar)
    dbs <- c(db, dbs)
  }

  fields <- c(
    "Package", "Version",
    "OS_type", "NeedsCompilation",
    "Repository", "Path", "File"
  )

  entries <- bapply(dbs, function(db) {

    # extract entries for this package
    rows <- db[db$Package == package, ]
    if (nrow(rows) == 0L)
      return(rows)

    # only keep entries for which this version of R is compatible
    deps <- rows$Depends %||% rep.int("", nrow(rows))
    compatible <- map_lgl(deps, function(dep) {

      # skip NAs
      if (is.na(dep))
        return(TRUE)

      # read 'R' entries from Depends (if any)
      parsed <- catch(renv_description_parse_field(dep))
      if (inherits(parsed, "error")) {
        warning(parsed)
        return(FALSE)
      }

      # read requirements for R
      r <- parsed[parsed$Package == "R", ]
      if (nrow(r) == 0)
        return(TRUE)

      # build code to validate requirements
      fmt <- "getRversion() %s \"%s\""
      all <- sprintf(fmt, r$Require, r$Version)
      code <- paste(all, collapse = " && ")

      # evaluate it
      status <- catch(eval(parse(text = code), envir = baseenv()))
      if (inherits(status, "error")) {
        warning(status)
        return(TRUE)
      }

      # all done
      status

    })

    # keep only compatible rows + the required fields
    rows[compatible, intersect(fields, names(db))]

  }, index = "Name")

  if (is.null(entries))
    return(NULL)

  # sort based on version
  version <- numeric_version(entries$Version)
  ordered <- order(version, decreasing = TRUE)

  # extract newest entry
  entry <- as.list(entries[ordered[[1L]], ])

  # remove an NA file entry if necessary
  # https://github.com/rstudio/renv/issues/1045
  if (length(entry$File) && is.na(entry$File))
    entry$File <- NULL

  # return newest-available version
  renv_available_packages_record(entry, type)

}

renv_available_packages_latest <- function(package,
                                           type = NULL,
                                           repos = NULL)
{
  methods <- list(
    renv_available_packages_latest_repos,
    if (renv_mran_enabled())
      renv_available_packages_latest_mran
  )

  errors <- stack()

  entries <- lapply(methods, function(method) {

    if (is.null(method))
      return(NULL)

    entry <- catch(method(package, type, repos))
    if (inherits(entry, "error")) {
      errors$push(entry)
      return(NULL)
    }

    entry

  })

  # if both entries are null, error
  if (all(map_lgl(entries, is.null))) {
    map(errors$data(), warning)
    stopf("package '%s' is not available", package)
  } else if (is.null(entries[[2L]])) {
    return(entries[[1L]])
  } else if (is.null(entries[[1L]])) {
    return(entries[[2L]])
  }

  # extract both entries
  lhs <- entries[[1L]]
  rhs <- entries[[2L]]

  # extract versions
  lhsv <- package_version(lhs$Version %||% "0.0")
  rhsv <- package_version(rhs$Version %||% "0.0")

  # if the versions don't match, take the newest one
  if (lhsv > rhsv)
    return(lhs)
  else if (rhsv > lhsv)
    return(rhs)

  # otherwise, if we have a binary from the active package repositories,
  # use those; otherwise, use the mran binary
  if (identical(lhsv, rhsv)) {
    if (identical(attr(lhs, "type", exact = TRUE), "binary"))
      return(lhs)
    else
      return(rhs)
  }

  # otherwise, return the regular repository entry
  lhs

}

renv_available_packages_latest_mran <- function(package,
                                                type = NULL,
                                                repos = NULL)
{
  if (!config$mran.enabled())
    stop("MRAN is not enabled")

  type <- type %||% getOption("pkgType")
  if (identical(type, "source"))
    stop("MRAN database requires binary packages to be available")

  # ensure local MRAN database is up-to-date
  renv_mran_database_refresh(explicit = FALSE)

  # attempt to read it
  database <- catch(renv_mran_database_load())
  if (inherits(database, "error"))
    return(database)

  # get entry for this version of R + platform
  suffix <- contrib.url("", type = "binary")
  entry <- database[[suffix]]
  if (is.null(entry))
    stopf("no MRAN records available from repository URL '%s'", suffix)

  # find all available packages
  keys <- ls(envir = entry)
  pattern <- paste0("^", package, " ")
  matching <- grep(pattern, keys, perl = TRUE, value = TRUE)
  if (empty(matching))
    stopf("package '%s' is not available from MRAN", package)

  # take the latest-available package
  entries <- unlist(mget(matching, envir = entry))
  sorted <- sort(entries, decreasing = TRUE)
  key <- names(sorted)[[1L]]
  idate <- sorted[[1L]]

  # split into package, version
  index <- regexpr(" ", key, fixed = TRUE)
  version <- substring(key, index + 1)

  # return an appropriate record
  record <- list(
    Package    = package,
    Version    = version,
    Source     = "Repository",
    Repository = "MRAN"
  )

  # convert from integer to date
  date <- as.Date(idate, origin = "1970-01-01")

  # form url to binary package
  base <- renv_mran_url(date, suffix)
  name <- renv_retrieve_name(record, type = "binary")
  url <- file.path(base, name)

  # tag record with url + type
  attr(record, "url")  <- dirname(url)
  attr(record, "type") <- "binary"

  record
}

renv_available_packages_latest_repos <- function(package,
                                                 type = NULL,
                                                 repos = NULL)
{
  type <- type %||% getOption("pkgType")

  # detect requests for only source packages
  if (identical(type, "source"))
    return(renv_available_packages_latest_repos_impl(package, "source", repos))

  # detect requests for only binary packages
  if (grepl("\\bbinary\\b", type))
    return(renv_available_packages_latest_repos_impl(package, "binary", repos))

  # otherwise, check both source and binary repositories
  src <- renv_available_packages_latest_repos_impl(package, "source", repos)
  bin <- renv_available_packages_latest_repos_impl(package, "binary", repos)

  # choose an appropriate record
  if (is.null(src) && is.null(bin))
    stopf("package '%s' is not available", package)
  else if (is.null(src))
    renv_available_packages_record(bin, "binary")
  else if (is.null(bin))
    renv_available_packages_record(src, "source")
  else
    renv_available_packages_latest_select(src, bin)
}

renv_available_packages_latest_select <- function(src, bin) {

  # if the binary is at least as old as the source version,
  # then use the binary version
  if (renv_version_compare(bin$Version, src$Version) >= 0)
    return(renv_available_packages_record(bin, "binary"))

  # if the user has requested we skip source repositories,
  # use the binary anyway
  ipcs <- getOption("install.packages.check.source", default = "yes")
  if (!identical(ipcs, "yes"))
    return(renv_available_packages_record(bin, "binary"))

  # if the package requires compilation, check to see whether
  # the user has opted in to compiling packages from source
  nc <- identical(src$NeedsCompilation, "yes")
  if (nc) {

    # check user preference re: compilation from source
    ipcfs <- getOption(
      "install.packages.compile.from.source",
      default = Sys.getenv("R_COMPILE_AND_INSTALL_PACKAGES")
    )

    # if make is not available, then we can't build from source
    make <- Sys.getenv("MAKE", unset = "make")
    if (!nzchar(Sys.which(make)))
      ipcfs <- "never"

    # if we're on macOS and command line tools are not available,
    # then we can't build from sources
    if (renv_platform_macos() && !renv_xcode_available())
      ipcfs <- "never"

    if (identical(ipcfs, "never"))
      return(renv_available_packages_record(bin, "binary"))

  }

  # take the source version
  renv_available_packages_record(src, "source")

}

renv_available_packages_cellar <- function(type, project = NULL) {

  # look in the cellar
  project <- renv_project_resolve(project)
  roots <- renv_cellar_roots(project = project)

  # look for packages
  all <- list.files(
    path         = roots,
    all.files    = TRUE,
    full.names   = TRUE,
    recursive    = TRUE,
    include.dirs = FALSE
  )

  # keep only files with matching extensions
  ext <- renv_package_ext(type = type)
  keep <- all[fileext(all) %in% ext]

  # construct records for each cellar entry
  records <- lapply(keep, function(path) {

    # infer package name, version from tarball name
    base <- basename(keep)
    idx <- regexpr("_", base, fixed = TRUE)
    package <- substring(base, 1L, idx - 1L)
    version <- substring(base, idx + 1L, nchar(base) - nchar(ext))

    # set the Repository field
    prefix <- if (renv_platform_windows()) "file:///" else "file://"
    repository <- paste0(prefix, dirname(path))

    # build record
    list(
      Package = package,
      Version = version,
      OS_type = NA,
      NeedsCompilation = NA,
      Repository = repository
    )

  })

  bind(records)

}

if (getRversion() < "3.2.0") {
  dir.exists <- function(paths) {
    info <- renv_file_info(paths)
    info$isdir %in% TRUE
  }
}

renv_base64_encode_table <- function() {
  renv_global("base64.encode.table", {
    text <- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
    as.integer(charToRaw(text))
  })
}

renv_base64_encode_main <- function(input) {

  ni <- as.integer(length(input))
  if (ni < 3L)
    return(integer())

  no <- ni %/% 3L * 4L
  output <- integer(no)

  i0 <- seq.int(1L, ni - 2L, by = 3L)
  i1 <- seq.int(2L, ni - 1L, by = 3L)
  i2 <- seq.int(3L, ni - 0L, by = 3L)

  o0 <- seq.int(1L, no - 3L, by = 4L)
  o1 <- seq.int(2L, no - 2L, by = 4L)
  o2 <- seq.int(3L, no - 1L, by = 4L)
  o3 <- seq.int(4L, no - 0L, by = 4L)

  t <- renv_base64_encode_table()

  output[o0] <- t[1L + bitwShiftR(input[i0], 2L)]

  output[o1] <- t[1L + bitwOr(
    bitwShiftL(bitwAnd(input[i0], 0x03L), 4L),
    bitwShiftR(bitwAnd(input[i1], 0xF0L), 4L)
  )]

  output[o2] <- t[1L + bitwOr(
    bitwShiftL(bitwAnd(input[i1], 0x0FL), 2L),
    bitwShiftR(bitwAnd(input[i2], 0xC0L), 6L)
  )]

  output[o3] <- t[1L + bitwAnd(input[i2], 0x3FL)]

  output

}

renv_base64_encode_rest <- function(input) {

  ni <- as.integer(length(input))
  remaining <- ni %% 3L
  if (remaining == 0L)
    return(integer())

  output <- rep.int(61L, 4L)
  i <- ni - remaining + 1
  t <- renv_base64_encode_table()

  output[1L] <- t[1L + bitwShiftR(input[i + 0L], 2L)]

  if (remaining == 1L) {

    output[2L] <- t[1L + bitwShiftL(bitwAnd(input[i + 0L], 0x03L), 4L)]

  } else if (remaining == 2L) {

    output[2L] <- t[1L + bitwOr(
      bitwShiftL(bitwAnd(input[i + 0L], 0x03L), 4L),
      bitwShiftR(bitwAnd(input[i + 1L], 0xF0L), 4L)
    )]

    output[3L] <- t[1L + bitwShiftL(bitwAnd(input[i + 1L], 0x0FL), 2L)]

  }

  output

}

renv_base64_encode <- function(text) {

  # convert to raw vector
  input <- case(
    is.character(text) ~ as.integer(charToRaw(text)),
    is.raw(text)       ~ as.integer(text),
    ~ stopf("unexpected input type '%s'", typeof(text))
  )

  encoded <- c(
    renv_base64_encode_main(input),
    renv_base64_encode_rest(input)
  )

  rawToChar(as.raw(encoded))

}

renv_base64_decode_table <- function() {
  renv_global("base64.decode.table", {
    table <- integer(255)
    text <- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
    table[utf8ToInt(text)] <- seq_len(nchar(text)) - 1L
    table
  })
}

renv_base64_decode_main <- function(input) {

  ni <- length(input)
  no <- (ni * 3L) %/% 4L

  output <- integer(no)

  i0 <- seq(from = 1L, to = ni - 3L, by = 4L)
  i1 <- seq(from = 2L, to = ni - 2L, by = 4L)
  i2 <- seq(from = 3L, to = ni - 1L, by = 4L)
  i3 <- seq(from = 4L, to = ni - 0L, by = 4L)

  o0 <- seq.int(1L, no - 2L, by = 3L)
  o1 <- seq.int(2L, no - 1L, by = 3L)
  o2 <- seq.int(3L, no - 0L, by = 3L)

  t <- renv_base64_decode_table()

  output[o0] <- bitwOr(
    bitwAnd(bitwShiftL(t[input[i0]], 2L), 255L),
    bitwAnd(bitwShiftR(t[input[i1]], 4L), 255L)
  )

  output[o1] <- bitwOr(
    bitwAnd(bitwShiftL(t[input[i1]], 4L), 255L),
    bitwAnd(bitwShiftR(t[input[i2]], 2L), 255L)
  )

  output[o2] <- bitwOr(
    bitwAnd(bitwShiftL(t[input[i2]], 6L), 255L),
    bitwAnd(bitwShiftR(t[input[i3]], 0L), 255L)
  )

  output

}

renv_base64_decode <- function(encoded) {

  # remove newlines
  if (c(regexpr("\n", encoded, fixed = TRUE)) != -1L)
    encoded <- gsub("\n", "", encoded, fixed = TRUE)

  # convert to raw vector
  input <- case(
    is.character(encoded) ~ as.integer(charToRaw(encoded)),
    is.raw(encoded)       ~ as.integer(encoded),
    ~ stopf("unexpected input type '%s'", typeof(encoded))
  )

  # decode vector
  output <- renv_base64_decode_main(input)

  # trim off padded bits
  n <- length(input)
  if (input[n - 1L] == 61L)
    output <- head(output, n = -2L)
  else if (input[n] == 61L)
    output <- head(output, n = -1L)

  # convert back to string
  rawToChar(as.raw(output))

}

bind <- function(data, names = NULL, index = "Index") {

  # keep only non-empty data
  filtered <- Filter(NROW, data)
  if (!length(filtered))
    return(NULL)

  # ensure all datasets have the same column names
  # try to preserve the ordering of names if possible
  # (try to find one dataset which has all column relevant column names)
  nms <- character()
  for (i in seq_along(filtered)) {
    names(filtered[[i]]) <- names(filtered[[i]]) %||% names
    nmsi <- names(filtered[[i]])
    if (empty(setdiff(nms, nmsi)))
      nms <- nmsi
  }

  # check now if we've caught all relevant names; if we didn't,
  # just fall back to a "dumb" union
  allnms <- unique(unlist(lapply(filtered, names)))
  if (!setequal(nms, allnms))
    nms <- allnms

  # we've collected all names; now fill with NAs as necessary
  filled <- map(filtered, function(datum) {
    datum[setdiff(nms, names(datum))] <- NA
    datum[nms]
  })

  # we've collected and ordered each data.frame, now merge them
  rhs <- .mapply(c, filled, list(use.names = FALSE))
  names(rhs) <- names(filled[[1L]])

  if (is.null(names(data))) {
    names(rhs) <- names(rhs) %||% names
    return(as.data.frame(rhs, stringsAsFactors = FALSE))
  }

  if (index %in% names(rhs)) {
    fmt <- "name collision: bound list already contains column called '%s'"
    stopf(fmt, index)
  }

  lhs <- list()
  rows <- function(item) nrow(item) %||% length(item[[1]])
  lhs[[index]] <- rep.int(names(filled), times = map_dbl(filled, rows))

  cbind(
    as.data.frame(lhs, stringsAsFactors = FALSE),
    as.data.frame(rhs, stringsAsFactors = FALSE)
  )

}






renv_binding_replace <- function(symbol, replacement, envir) {

  base <- .BaseNamespaceEnv

  # get the original definition
  original <- envir[[symbol]]

  # if the binding is locked, temporarily unlock it
  if (base$bindingIsLocked(symbol, envir)) {
    base$unlockBinding(symbol, envir)
    on.exit(base$lockBinding(symbol, envir), add = TRUE)
  }

  # update the binding
  assign(symbol, replacement, envir = envir)

  # return old definition
  original

}

renv_bioconductor_init <- function() {
  if (getRversion() >= "3.5.0")
    renv_bioconductor_init_biocmanager()
  else
    renv_bioconductor_init_biocinstaller()
}

renv_bioconductor_init_biocmanager <- function() {

  if (renv_package_available("BiocManager"))
    return(TRUE)

  install("BiocManager")
  TRUE

}

renv_bioconductor_init_biocinstaller <- function() {

  if (renv_package_available("BiocInstaller"))
    return(TRUE)

  url <- "https://bioconductor.org/biocLite.R"
  destfile <- tempfile("renv-bioclite-", fileext = ".R")
  on.exit(unlink(destfile), add = TRUE)
  download(url, destfile = destfile, quiet = TRUE)

  source(destfile)
  TRUE

}

renv_bioconductor_version <- function(project, refresh = FALSE) {

  # check and see if we have an override via option
  version <- getOption("renv.bioconductor.version")
  if (!is.null(version))
    return(version)

  # check and see if the project has been configured to use a specific
  # Bioconductor release
  if (!refresh) {
    version <- settings$bioconductor.version(project = project)
    if (length(version))
      return(version)
  }

  # otherwise, infer the Bioconductor version from installed packages
  case(

    renv_package_available("BiocVersion") ~ {
      format(packageVersion("BiocVersion")[1, 1:2])
    },

    renv_package_available("BiocManager") ~ {
      BiocManager <- renv_namespace_load("BiocManager")
      format(BiocManager$version())
    },

    renv_package_available("BiocVersion") ~ {
      BiocInstaller <- renv_namespace_load("BiocInstaller")
      format(BiocInstaller$biocVersion())
    }

  )

}

renv_bioconductor_repos <- function(project, version = NULL) {

  # allow bioconductor repos override
  repos <- getOption("renv.bioconductor.repos")
  if (!is.null(repos))
    return(repos)

  # read Bioconductor version (normally set during restore)
  version <- version %||% renv_bioconductor_version(project = project)

  # read Bioconductor repositories (prefer BiocInstaller for older R)
  if (getRversion() < "3.5.0")
    renv_bioconductor_repos_biocinstaller(version)
  else
    renv_bioconductor_repos_biocmanager(version)

}

renv_bioconductor_repos_biocmanager <- function(version) {

  renv_scope_options(BiocManager.check_repositories = FALSE)
  BiocManager <- asNamespace("BiocManager")
  version <- version %||% BiocManager$version()

  tryCatch(
    BiocManager$.repositories(site_repository = character(), version = version),
    error = function(e) {
      BiocManager$repositories(version = version)
    }
  )

}

renv_bioconductor_repos_biocinstaller <- function(version) {
  BiocInstaller <- asNamespace("BiocInstaller")
  version <- version %||% BiocInstaller$biocVersion()
  BiocInstaller$biocinstallRepos(version = version)
}

`%||%` <- function(x, y) {
  if (is.environment(x) || length(x)) x else y
}

bootstrap <- function(version, library) {

  # attempt to download renv
  tarball <- tryCatch(renv_bootstrap_download(version), error = identity)
  if (inherits(tarball, "error"))
    stop("failed to download renv ", version)

  # now attempt to install
  status <- tryCatch(renv_bootstrap_install(version, tarball, library), error = identity)
  if (inherits(status, "error"))
    stop("failed to install renv ", version)

}

renv_bootstrap_tests_running <- function() {
  getOption("renv.tests.running", default = FALSE)
}

renv_bootstrap_repos <- function() {

  # check for repos override
  repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA)
  if (!is.na(repos))
    return(repos)

  # check for lockfile repositories
  repos <- tryCatch(renv_bootstrap_repos_lockfile(), error = identity)
  if (!inherits(repos, "error") && length(repos))
    return(repos)

  # if we're testing, re-use the test repositories
  if (renv_bootstrap_tests_running())
    return(getOption("renv.tests.repos"))

  # retrieve current repos
  repos <- getOption("repos")

  # ensure @CRAN@ entries are resolved
  repos[repos == "@CRAN@"] <- getOption(
    "renv.repos.cran",
    "https://cloud.r-project.org"
  )

  # add in renv.bootstrap.repos if set
  default <- c(FALLBACK = "https://cloud.r-project.org")
  extra <- getOption("renv.bootstrap.repos", default = default)
  repos <- c(repos, extra)

  # remove duplicates that might've snuck in
  dupes <- duplicated(repos) | duplicated(names(repos))
  repos[!dupes]

}

renv_bootstrap_repos_lockfile <- function() {

  lockpath <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = "renv.lock")
  if (!file.exists(lockpath))
    return(NULL)

  lockfile <- tryCatch(renv_json_read(lockpath), error = identity)
  if (inherits(lockfile, "error")) {
    warning(lockfile)
    return(NULL)
  }

  repos <- lockfile$R$Repositories
  if (length(repos) == 0)
    return(NULL)

  keys <- vapply(repos, `[[`, "Name", FUN.VALUE = character(1))
  vals <- vapply(repos, `[[`, "URL", FUN.VALUE = character(1))
  names(vals) <- keys

  return(vals)

}

renv_bootstrap_download <- function(version) {

  # if the renv version number has 4 components, assume it must
  # be retrieved via github
  nv <- numeric_version(version)
  components <- unclass(nv)[[1]]

  # if this appears to be a development version of 'renv', we'll
  # try to restore from github
  dev <- length(components) == 4L

  # begin collecting different methods for finding renv
  methods <- c(
    renv_bootstrap_download_tarball,
    if (dev)
      renv_bootstrap_download_github
    else c(
      renv_bootstrap_download_cran_latest,
      renv_bootstrap_download_cran_archive
    )
  )

  for (method in methods) {
    path <- tryCatch(method(version), error = identity)
    if (is.character(path) && file.exists(path))
      return(path)
  }

  stop("failed to download renv ", version)

}

renv_bootstrap_download_impl <- function(url, destfile) {

  mode <- "wb"

  # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17715
  fixup <-
    Sys.info()[["sysname"]] == "Windows" &&
    substring(url, 1L, 5L) == "file:"

  if (fixup)
    mode <- "w+b"

  utils::download.file(
    url      = url,
    destfile = destfile,
    mode     = mode,
    quiet    = TRUE
  )

}

renv_bootstrap_download_cran_latest <- function(version) {

  spec <- renv_bootstrap_download_cran_latest_find(version)

  message("* Downloading renv ", version, " ... ", appendLF = FALSE)

  type  <- spec$type
  repos <- spec$repos

  info <- tryCatch(
    utils::download.packages(
      pkgs    = "renv",
      destdir = tempdir(),
      repos   = repos,
      type    = type,
      quiet   = TRUE
    ),
    condition = identity
  )

  if (inherits(info, "condition")) {
    message("FAILED")
    return(FALSE)
  }

  # report success and return
  message("OK (downloaded ", type, ")")
  info[1, 2]

}

renv_bootstrap_download_cran_latest_find <- function(version) {

  # check whether binaries are supported on this system
  binary <-
    getOption("renv.bootstrap.binary", default = TRUE) &&
    !identical(.Platform$pkgType, "source") &&
    !identical(getOption("pkgType"), "source") &&
    Sys.info()[["sysname"]] %in% c("Darwin", "Windows")

  types <- c(if (binary) "binary", "source")

  # iterate over types + repositories
  for (type in types) {
    for (repos in renv_bootstrap_repos()) {

      # retrieve package database
      db <- tryCatch(
        as.data.frame(
          utils::available.packages(type = type, repos = repos),
          stringsAsFactors = FALSE
        ),
        error = identity
      )

      if (inherits(db, "error"))
        next

      # check for compatible entry
      entry <- db[db$Package %in% "renv" & db$Version %in% version, ]
      if (nrow(entry) == 0)
        next

      # found it; return spec to caller
      spec <- list(entry = entry, type = type, repos = repos)
      return(spec)

    }
  }

  # if we got here, we failed to find renv
  fmt <- "renv %s is not available from your declared package repositories"
  stop(sprintf(fmt, version))

}

renv_bootstrap_download_cran_archive <- function(version) {

  name <- sprintf("renv_%s.tar.gz", version)
  repos <- renv_bootstrap_repos()
  urls <- file.path(repos, "src/contrib/Archive/renv", name)
  destfile <- file.path(tempdir(), name)

  message("* Downloading renv ", version, " ... ", appendLF = FALSE)

  for (url in urls) {

    status <- tryCatch(
      renv_bootstrap_download_impl(url, destfile),
      condition = identity
    )

    if (identical(status, 0L)) {
      message("OK")
      return(destfile)
    }

  }

  message("FAILED")
  return(FALSE)

}

renv_bootstrap_download_tarball <- function(version) {

  # if the user has provided the path to a tarball via
  # an environment variable, then use it
  tarball <- Sys.getenv("RENV_BOOTSTRAP_TARBALL", unset = NA)
  if (is.na(tarball))
    return()

  # allow directories
  info <- file.info(tarball, extra_cols = FALSE)
  if (identical(info$isdir, TRUE)) {
    name <- sprintf("renv_%s.tar.gz", version)
    tarball <- file.path(tarball, name)
  }

  # bail if it doesn't exist
  if (!file.exists(tarball)) {

    # let the user know we weren't able to honour their request
    fmt <- "* RENV_BOOTSTRAP_TARBALL is set (%s) but does not exist."
    msg <- sprintf(fmt, tarball)
    warning(msg)

    # bail
    return()

  }

  fmt <- "* Bootstrapping with tarball at path '%s'."
  msg <- sprintf(fmt, tarball)
  message(msg)

  tarball

}

renv_bootstrap_download_github <- function(version) {

  enabled <- Sys.getenv("RENV_BOOTSTRAP_FROM_GITHUB", unset = "TRUE")
  if (!identical(enabled, "TRUE"))
    return(FALSE)

  # prepare download options
  pat <- Sys.getenv("GITHUB_PAT")
  if (nzchar(Sys.which("curl")) && nzchar(pat)) {
    fmt <- "--location --fail --header \"Authorization: token %s\""
    extra <- sprintf(fmt, pat)
    saved <- options("download.file.method", "download.file.extra")
    options(download.file.method = "curl", download.file.extra = extra)
    on.exit(do.call(base::options, saved), add = TRUE)
  } else if (nzchar(Sys.which("wget")) && nzchar(pat)) {
    fmt <- "--header=\"Authorization: token %s\""
    extra <- sprintf(fmt, pat)
    saved <- options("download.file.method", "download.file.extra")
    options(download.file.method = "wget", download.file.extra = extra)
    on.exit(do.call(base::options, saved), add = TRUE)
  }

  message("* Downloading renv ", version, " from GitHub ... ", appendLF = FALSE)

  url <- file.path("https://api.github.com/repos/rstudio/renv/tarball", version)
  name <- sprintf("renv_%s.tar.gz", version)
  destfile <- file.path(tempdir(), name)

  status <- tryCatch(
    renv_bootstrap_download_impl(url, destfile),
    condition = identity
  )

  if (!identical(status, 0L)) {
    message("FAILED")
    return(FALSE)
  }

  message("OK")
  return(destfile)

}

renv_bootstrap_install <- function(version, tarball, library) {

  # attempt to install it into project library
  message("* Installing renv ", version, " ... ", appendLF = FALSE)
  dir.create(library, showWarnings = FALSE, recursive = TRUE)

  # invoke using system2 so we can capture and report output
  bin <- R.home("bin")
  exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R"
  r <- file.path(bin, exe)

  args <- c(
    "--vanilla", "CMD", "INSTALL", "--no-multiarch",
    "-l", shQuote(path.expand(library)),
    shQuote(path.expand(tarball))
  )

  output <- system2(r, args, stdout = TRUE, stderr = TRUE)
  message("Done!")

  # check for successful install
  status <- attr(output, "status")
  if (is.numeric(status) && !identical(status, 0L)) {
    header <- "Error installing renv:"
    lines <- paste(rep.int("=", nchar(header)), collapse = "")
    text <- c(header, lines, output)
    writeLines(text, con = stderr())
  }

  status

}

renv_bootstrap_platform_prefix <- function() {

  # construct version prefix
  version <- paste(R.version$major, R.version$minor, sep = ".")
  prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-")

  # include SVN revision for development versions of R
  # (to avoid sharing platform-specific artefacts with released versions of R)
  devel <-
    identical(R.version[["status"]],   "Under development (unstable)") ||
    identical(R.version[["nickname"]], "Unsuffered Consequences")

  if (devel)
    prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r")

  # build list of path components
  components <- c(prefix, R.version$platform)

  # include prefix if provided by user
  prefix <- renv_bootstrap_platform_prefix_impl()
  if (!is.na(prefix) && nzchar(prefix))
    components <- c(prefix, components)

  # build prefix
  paste(components, collapse = "/")

}

renv_bootstrap_platform_prefix_impl <- function() {

  # if an explicit prefix has been supplied, use it
  prefix <- Sys.getenv("RENV_PATHS_PREFIX", unset = NA)
  if (!is.na(prefix))
    return(prefix)

  # if the user has requested an automatic prefix, generate it
  auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA)
  if (auto %in% c("TRUE", "True", "true", "1"))
    return(renv_bootstrap_platform_prefix_auto())

  # empty string on failure
  ""

}

renv_bootstrap_platform_prefix_auto <- function() {

  prefix <- tryCatch(renv_bootstrap_platform_os(), error = identity)
  if (inherits(prefix, "error") || prefix %in% "unknown") {

    msg <- paste(
      "failed to infer current operating system",
      "please file a bug report at https://github.com/rstudio/renv/issues",
      sep = "; "
    )

    warning(msg)

  }

  prefix

}

renv_bootstrap_platform_os <- function() {

  sysinfo <- Sys.info()
  sysname <- sysinfo[["sysname"]]

  # handle Windows + macOS up front
  if (sysname == "Windows")
    return("windows")
  else if (sysname == "Darwin")
    return("macos")

  # check for os-release files
  for (file in c("/etc/os-release", "/usr/lib/os-release"))
    if (file.exists(file))
      return(renv_bootstrap_platform_os_via_os_release(file, sysinfo))

  # check for redhat-release files
  if (file.exists("/etc/redhat-release"))
    return(renv_bootstrap_platform_os_via_redhat_release())

  "unknown"

}

renv_bootstrap_platform_os_via_os_release <- function(file, sysinfo) {

  # read /etc/os-release
  release <- utils::read.table(
    file             = file,
    sep              = "=",
    quote            = c("\"", "'"),
    col.names        = c("Key", "Value"),
    comment.char     = "#",
    stringsAsFactors = FALSE
  )

  vars <- as.list(release$Value)
  names(vars) <- release$Key

  # get os name
  os <- tolower(sysinfo[["sysname"]])

  # read id
  id <- "unknown"
  for (field in c("ID", "ID_LIKE")) {
    if (field %in% names(vars) && nzchar(vars[[field]])) {
      id <- vars[[field]]
      break
    }
  }

  # read version
  version <- "unknown"
  for (field in c("UBUNTU_CODENAME", "VERSION_CODENAME", "VERSION_ID", "BUILD_ID")) {
    if (field %in% names(vars) && nzchar(vars[[field]])) {
      version <- vars[[field]]
      break
    }
  }

  # join together
  paste(c(os, id, version), collapse = "-")

}

renv_bootstrap_platform_os_via_redhat_release <- function() {

  # read /etc/redhat-release
  contents <- readLines("/etc/redhat-release", warn = FALSE)

  # infer id
  id <- if (grepl("centos", contents, ignore.case = TRUE))
    "centos"
  else if (grepl("redhat", contents, ignore.case = TRUE))
    "redhat"
  else
    "unknown"

  # try to find a version component (very hacky)
  version <- "unknown"

  parts <- strsplit(contents, "[[:space:]]")[[1L]]
  for (part in parts) {

    nv <- tryCatch(numeric_version(part), error = identity)
    if (inherits(nv, "error"))
      next

    version <- nv[1, 1]
    break

  }

  paste(c("linux", id, version), collapse = "-")

}

renv_bootstrap_library_root_name <- function(project) {

  # use project name as-is if requested
  asis <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT_ASIS", unset = "FALSE")
  if (asis)
    return(basename(project))

  # otherwise, disambiguate based on project's path
  id <- substring(renv_bootstrap_hash_text(project), 1L, 8L)
  paste(basename(project), id, sep = "-")

}

renv_bootstrap_library_root <- function(project) {

  prefix <- renv_bootstrap_profile_prefix()

  path <- Sys.getenv("RENV_PATHS_LIBRARY", unset = NA)
  if (!is.na(path))
    return(paste(c(path, prefix), collapse = "/"))

  path <- renv_bootstrap_library_root_impl(project)
  if (!is.null(path)) {
    name <- renv_bootstrap_library_root_name(project)
    return(paste(c(path, prefix, name), collapse = "/"))
  }

  renv_bootstrap_paths_renv("library", project = project)

}

renv_bootstrap_library_root_impl <- function(project) {

  root <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA)
  if (!is.na(root))
    return(root)

  type <- renv_bootstrap_project_type(project)
  if (identical(type, "package")) {
    userdir <- renv_bootstrap_user_dir()
    return(file.path(userdir, "library"))
  }

}

renv_bootstrap_validate_version <- function(version) {

  loadedversion <- utils::packageDescription("renv", fields = "Version")
  if (version == loadedversion)
    return(TRUE)

  # assume four-component versions are from GitHub; three-component
  # versions are from CRAN
  components <- strsplit(loadedversion, "[.-]")[[1]]
  remote <- if (length(components) == 4L)
    paste("rstudio/renv", loadedversion, sep = "@")
  else
    paste("renv", loadedversion, sep = "@")

  fmt <- paste(
    "renv %1$s was loaded from project library, but this project is configured to use renv %2$s.",
    "Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile.",
    "Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library.",
    sep = "\n"
  )

  msg <- sprintf(fmt, loadedversion, version, remote)
  warning(msg, call. = FALSE)

  FALSE

}

renv_bootstrap_hash_text <- function(text) {

  hashfile <- tempfile("renv-hash-")
  on.exit(unlink(hashfile), add = TRUE)

  writeLines(text, con = hashfile)
  tools::md5sum(hashfile)

}

renv_bootstrap_load <- function(project, libpath, version) {

  # try to load renv from the project library
  if (!requireNamespace("renv", lib.loc = libpath, quietly = TRUE))
    return(FALSE)

  # warn if the version of renv loaded does not match
  renv_bootstrap_validate_version(version)

  # load the project
  renv::load(project)

  TRUE

}

renv_bootstrap_profile_load <- function(project) {

  # if RENV_PROFILE is already set, just use that
  profile <- Sys.getenv("RENV_PROFILE", unset = NA)
  if (!is.na(profile) && nzchar(profile))
    return(profile)

  # check for a profile file (nothing to do if it doesn't exist)
  path <- renv_bootstrap_paths_renv("profile", profile = FALSE)
  if (!file.exists(path))
    return(NULL)

  # read the profile, and set it if it exists
  contents <- readLines(path, warn = FALSE)
  if (length(contents) == 0L)
    return(NULL)

  # set RENV_PROFILE
  profile <- contents[[1L]]
  if (!profile %in% c("", "default"))
    Sys.setenv(RENV_PROFILE = profile)

  profile

}

renv_bootstrap_profile_prefix <- function() {
  profile <- renv_bootstrap_profile_get()
  if (!is.null(profile))
    return(file.path("profiles", profile, "renv"))
}

renv_bootstrap_profile_get <- function() {
  profile <- Sys.getenv("RENV_PROFILE", unset = "")
  renv_bootstrap_profile_normalize(profile)
}

renv_bootstrap_profile_set <- function(profile) {
  profile <- renv_bootstrap_profile_normalize(profile)
  if (is.null(profile))
    Sys.unsetenv("RENV_PROFILE")
  else
    Sys.setenv(RENV_PROFILE = profile)
}

renv_bootstrap_profile_normalize <- function(profile) {

  if (is.null(profile) || profile %in% c("", "default"))
    return(NULL)

  profile

}

renv_bootstrap_path_absolute <- function(path) {

  substr(path, 1L, 1L) %in% c("~", "/", "\\") || (
    substr(path, 1L, 1L) %in% c(letters, LETTERS) &&
    substr(path, 2L, 3L) %in% c(":/", ":\\")
  )

}

renv_bootstrap_paths_renv <- function(..., profile = TRUE, project = NULL) {
  renv <- Sys.getenv("RENV_PATHS_RENV", unset = "renv")
  root <- if (renv_bootstrap_path_absolute(renv)) NULL else project
  prefix <- if (profile) renv_bootstrap_profile_prefix()
  components <- c(root, renv, prefix, ...)
  paste(components, collapse = "/")
}

renv_bootstrap_project_type <- function(path) {

  descpath <- file.path(path, "DESCRIPTION")
  if (!file.exists(descpath))
    return("unknown")

  desc <- tryCatch(
    read.dcf(descpath, all = TRUE),
    error = identity
  )

  if (inherits(desc, "error"))
    return("unknown")

  type <- desc$Type
  if (!is.null(type))
    return(tolower(type))

  package <- desc$Package
  if (!is.null(package))
    return("package")

  "unknown"

}

renv_bootstrap_user_dir <- function() {
  dir <- renv_bootstrap_user_dir_impl()
  path.expand(chartr("\\", "/", dir))
}

renv_bootstrap_user_dir_impl <- function() {

  # use local override if set
  override <- getOption("renv.userdir.override")
  if (!is.null(override))
    return(override)

  # use R_user_dir if available
  tools <- asNamespace("tools")
  if (is.function(tools$R_user_dir))
    return(tools$R_user_dir("renv", "cache"))

  # try using our own backfill for older versions of R
  envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME")
  for (envvar in envvars) {
    root <- Sys.getenv(envvar, unset = NA)
    if (!is.na(root))
      return(file.path(root, "R/renv"))
  }

  # use platform-specific default fallbacks
  if (Sys.info()[["sysname"]] == "Windows")
    file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv")
  else if (Sys.info()[["sysname"]] == "Darwin")
    "~/Library/Caches/org.R-project.R/R/renv"
  else
    "~/.cache/R/renv"

}


# tools for interacting with the renv global package cache
renv_cache_version <- function() {
  # NOTE: users should normally not override the cache version;
  # this is provided just to make testing easier
  Sys.getenv("RENV_CACHE_VERSION", unset = "v5")
}

renv_cache_version_previous <- function() {
  version <- renv_cache_version()
  number <- as.integer(substring(version, 2L))
  paste("v", number - 1L, sep = "")
}

# given a record, find a compatible version of that package in the cache,
# using a computed hash if available; if no hash is available, then try
# to match based on the package name + version
renv_cache_find <- function(record) {

  # validate required fields -- if any are missing, we can't use the cache
  required <- c("Package", "Version")
  missing <- renv_vector_diff(required, names(record))
  if (length(missing))
    return("")

  # if we have a hash, use it directly
  if (!is.null(record$Hash)) {

    # generate path to package installations in cache
    paths <- with(record, renv_paths_cache(Package, Version, Hash, Package))

    # if there are multiple cache entries, return the first existing one
    # if no entries exist, return path into first cache entry
    for (path in paths)
      if (file.exists(path))
        return(path)

    return(paths[[1L]])

  }

  # if the record doesn't have a hash, check to see if we can still locate a
  # compatible package version within the cache
  root <- with(record, renv_paths_cache(Package, Version))
  hashes <- list.files(root, full.names = TRUE)
  packages <- list.files(hashes, full.names = TRUE)

  # iterate over package paths, read DESCRIPTION, and look
  # for something compatible with the requested record
  for (package in packages) {

    # try to read the DESCRIPTION file
    dcf <- catch(as.list(renv_description_read(package)))
    if (inherits(dcf, "error"))
      next

    # if we're requesting an install from an R package repository,
    # and the cached package has a "Repository" field, then use it
    source <- renv_record_source(record)
    hasrepo <-
      source %in% c("cran", "repository") &&
      "Repository" %in% names(dcf)

    if (hasrepo)
      return(package)

    # check for compatible fields
    fields <- unique(c(
      renv_record_names(record, c("Package", "Version")),
      renv_record_names(dcf, c("Package", "Version"))
    ))

    # drop unnamed fields
    record <- record[nzchar(record)]
    dcf <- dcf[nzchar(dcf)]

    # check identical
    lhs <- keep(record, fields)
    rhs <- keep(dcf, fields)
    if (identical(lhs, rhs))
      return(package)

  }

  # failed; return "" as proxy for missing file
  ""

}

# given the path to a package's description file,
# compute the location it would be assigned if it
# were moved to the renv cache
renv_cache_path <- function(path) {
  record <- renv_description_read(path)
  record$Hash <- renv_hash_description(path)
  renv_cache_find(record)
}

renv_cache_path_components <- function(path) {

  data.frame(
    Package = renv_path_component(path, 1L),
    Hash    = renv_path_component(path, 2L),
    Version = renv_path_component(path, 3L),
    stringsAsFactors = FALSE
  )

}

renv_cache_synchronize <- function(record, linkable = FALSE) {

  # construct path to package in library
  library <- renv_libpaths_default()
  path <- file.path(library, record$Package)
  if (!file.exists(path))
    return(FALSE)

  # bail if the package source is unknown (assume that packages with an
  # unknown source are not cacheable)
  desc <- renv_description_read(path)
  source <- renv_snapshot_description_source(desc)
  if (identical(source, list(Source = "Unknown")))
    return(FALSE)

  # bail if record not cacheable
  if (!renv_record_cacheable(record))
    return(FALSE)

  # if we don't have a hash, compute it now
  record$Hash <- record$Hash %||% renv_hash_description(path)

  # construct cache entry
  cache <- renv_cache_find(record)

  copied <- FALSE
  for (cachePath in cache) {
    copied <- renv_cache_synchronize_impl(cachePath, record, linkable, path)
    if (copied)
      return(TRUE)
  }
  return(FALSE)

}

renv_cache_synchronize_impl <- function(cache, record, linkable, path) {

  # double-check we have a valid cache path
  if (!nzchar(cache))
    return(FALSE)

  # if our cache -> path link is already up to date, then nothing to do
  if (renv_file_same(cache, path))
    return(TRUE)

  # try to create the cache directory target
  # (catch errors due to permissions, etc)
  parent <- dirname(cache)
  status <- catchall(ensure_directory(parent))
  if (inherits(status, "error"))
    return(FALSE)

  # double-check that the cache is writable
  writable <- local({
    file <- tempfile("renv-tempfile-", tmpdir = parent)
    on.exit(unlink(file, force = TRUE), add = TRUE)
    status <- catchall(file.create(file))
    file.exists(file)
  })

  if (!writable)
    return(FALSE)

  # if we already have a cache entry, back it up
  restore <- renv_file_backup(cache)
  on.exit(restore(), add = TRUE)

  # get ready to copy / move into cache
  fmt <- "%s %s [%s] into the cache ..."
  vwritef(fmt, if (linkable) "Moving" else "Copying", record$Package, record$Version)

  before <- Sys.time()

  # copy package from source location into the cache
  if (linkable) {
    renv_cache_move(path, cache, overwrite = TRUE)
    renv_file_link(cache, path, overwrite = TRUE)
  } else {
    renv_cache_copy(path, cache, overwrite = TRUE)
  }

  if (renv_platform_unix()) {

    # change the cache owner if set
    user <- Sys.getenv("RENV_CACHE_USER", unset = NA)
    if (!is.na(user)) {
      parent <- dirname(dirname(dirname(cache)))
      renv_system_exec(
        command = "chown",
        args    = c("-Rf", renv_shell_quote(user), renv_shell_path(parent)),
        action  = "chowning cached package",
        quiet   = TRUE,
        success = NULL
      )
    }

    # change file modes after copy if set
    mode <- Sys.getenv("RENV_CACHE_MODE", unset = NA)
    if (!is.na(mode)) {
      parent <- dirname(dirname(dirname(cache)))
      renv_system_exec(
        command = "chmod",
        args    = c("-Rf", renv_shell_quote(mode), renv_shell_path(parent)),
        action  = "chmoding cached package",
        quiet   = TRUE,
        success = NULL
      )
    }

    # finally, allow for an arbitrary callback if set
    callback <- getOption("renv.cache.callback")
    if (is.function(callback))
      callback(cache)

  }

  after <- Sys.time()

  time <- difftime(after, before, units = "auto")

  # report status to user
  fmt <- "\tOK [%s to cache in %s]"
  vwritef(fmt, if (linkable) "moved" else "copied", renv_difftime_format(time))

  TRUE

}

renv_cache_list <- function(cache = NULL, packages = NULL) {
  caches <- cache %||% renv_paths_cache()
  paths <- map(caches, renv_cache_list_impl, packages = packages)
  unlist(paths, recursive = TRUE, use.names = FALSE)
}

renv_cache_list_impl <- function(cache, packages) {

  # paths to packages in the cache have the following format:
  #
  #    <package>/<version>/<hash>/<package>
  #
  # so find entries in the cache by listing files in each directory
  names <- file.path(cache, packages %||% list.files(cache))
  versions <- list.files(names, full.names = TRUE)
  hashes <- list.files(versions, full.names = TRUE)
  paths <- list.files(hashes, full.names = TRUE)

  # only keep paths that appear to be valid
  valid <- grep(renv_regexps_package_name(), basename(paths))
  paths[valid]

}

renv_cache_problems <- function(paths, reason) {

  data.frame(
    Package = renv_path_component(paths, 1L),
    Version = renv_path_component(paths, 3L),
    Path    = paths,
    Reason  = reason,
    stringsAsFactors = FALSE
  )

}

renv_cache_diagnose_corrupt_metadata <- function(paths, problems, verbose) {

  # check for missing metadata files
  metapaths <- file.path(paths, "Meta/package.rds")
  ok <- file.exists(metapaths)
  bad <- paths[!ok]

  if (length(bad)) {

    # nocov start
    if (verbose) {
      renv_pretty_print(
        renv_cache_format_path(bad),
        "The following package(s) are missing 'Meta/package.rds':",
        "These packages should be purged and reinstalled.",
        wrap = FALSE
      )
    }
    # nocov end

    data <- renv_cache_problems(
      paths  = bad,
      reason = "'Meta/package.rds' does not exist"
    )

    problems$push(data)

  }

  # check for corrupt / unreadable metadata files
  ok <- map_lgl(metapaths, function(path) {
    rds <- catch(readRDS(path))
    !inherits(rds, "error")
  })

  bad <- paths[!ok]

  if (length(bad)) {

    # nocov start
    if (verbose) {
      renv_pretty_print(
        renv_cache_format_path(bad),
        "The following package(s) have corrupt 'Meta/package.rds' files:",
        "These packages should be purged and reinstalled.",
        wrap = FALSE
      )
    }
    # nocov end

    data <- renv_cache_problems(
      paths  = bad,
      reason = "'Meta/package.rds' does not exist"
    )

    problems$push(data)

  }

  paths

}

renv_cache_diagnose_missing_descriptions <- function(paths, problems, verbose) {

  descpaths <- file.path(paths, "DESCRIPTION")
  exists <- file.exists(descpaths)
  bad <- paths[!exists]
  if (empty(bad))
    return(paths)

  # nocov start
  if (verbose) {
    renv_pretty_print(
      renv_cache_format_path(bad),
      "The following packages are missing DESCRIPTION files in the cache:",
      "These packages should be purged and reinstalled.",
      wrap = FALSE
    )
  }
  # nocov end

  data <- renv_cache_problems(
    paths  = bad,
    reason = "'DESCRIPTION' file does not exist"
  )

  problems$push(data)
  paths[exists]

}

renv_cache_diagnose_bad_hash <- function(paths, problems, verbose) {

  expected <- map_chr(paths, renv_cache_path)
  wrong <- paths != expected & !file.exists(expected)
  if (!any(wrong))
    return(paths)

  # nocov start
  if (verbose) {

    lhs <- renv_cache_path_components(paths[wrong])
    rhs <- renv_cache_path_components(expected[wrong])

    fmt <- "%s %s [Hash: %s != %s]"
    entries <- sprintf(fmt, lhs$Package, lhs$Version, lhs$Hash, rhs$Hash)

    renv_pretty_print(
      entries,
      "The following packages have incorrect hashes:",
      "Consider using `renv::rehash()` to re-hash these packages.",
      wrap = FALSE
    )
  }
  # nocov end

  data <- renv_cache_problems(
    paths  = paths[wrong],
    reason = "unexpected hash"
  )

  problems$push(data)
  paths

}

renv_cache_diagnose_wrong_built_version <- function(paths, problems, verbose) {

  # form paths to DESCRIPTION files
  descpaths <- file.path(paths, "DESCRIPTION")

  # parse the version of R each was built for
  versions <- map_chr(descpaths, function(descpath) {

    tryCatch(
      renv_description_built_version(descpath),
      error = function(e) {
        warning(e)
        NA
      }
    )

  })

  # check for NAs, report and remove them
  isna <- is.na(versions)
  if (any(isna)) {

    # nocov start
    if (verbose) {

      renv_pretty_print(
        paths[isna],
        "The following packages have no 'Built' field recorded in their DESCRIPTION file:",
        "renv is unable to validate the version of R this package was built for.",
        wrap = FALSE
      )

    }
    # nocov end

    data <- renv_cache_problems(
      paths = paths[isna],
      reason = "missing Built field"
    )

    problems$push(data)

    paths    <- paths[!isna]
    versions <- versions[!isna]

  }

  # check for incompatible versions
  wrong <- map_lgl(versions, function(version) {
    tryCatch(
      renv_version_compare(version, getRversion(), 2L) != 0,
      error = function(e) {
        warning(e)
        TRUE
      }
    )
  })

  if (!any(wrong))
    return(paths)

  # nocov start
  if (verbose) {

    renv_pretty_print(
      renv_cache_format_path(paths[wrong]),
      "The following packages in the cache were built for a different version of R:",
      "These packages will need to be purged and reinstalled.",
      wrap = FALSE
    )

  }
  # nocov end

  data <- renv_cache_problems(
    paths = paths[wrong],
    reason = "built for different version of R"
  )

  problems$push(data)
  paths

}

renv_cache_diagnose <- function(verbose = NULL) {

  verbose <- verbose %||% renv_verbose()

  problems <- stack()
  paths <- renv_cache_list()
  paths <- renv_cache_diagnose_corrupt_metadata(paths, problems, verbose)
  paths <- renv_cache_diagnose_missing_descriptions(paths, problems, verbose)
  paths <- renv_cache_diagnose_bad_hash(paths, problems, verbose)
  paths <- renv_cache_diagnose_wrong_built_version(paths, problems, verbose)

  invisible(bind(problems$data()))

}

renv_cache_acls_reset <- function(target) {

  enabled <- Sys.getenv("RENV_CACHE_ACLS", unset = "TRUE")
  if (enabled)
    renv_acls_reset(target)

}

# copies a package at location 'source' to cache location 'target'
renv_cache_copy <- function(source, target, overwrite = FALSE) {
  ensure_parent_directory(target)
  renv_file_copy(source, target, overwrite = overwrite)
  renv_cache_acls_reset(target)
}

# moves a package from location 'source' to cache location 'target',
# and then links back from 'target' to 'source'
renv_cache_move <- function(source, target, overwrite = FALSE) {

  # move package into the cache if requested
  if (overwrite || !file.exists(target)) {
    ensure_parent_directory(target)
    renv_file_move(source, target, overwrite = TRUE)
  }

  # try to reset ACLs on the cache directory
  renv_cache_acls_reset(target)

  # link from the cache back to the target location
  renv_file_link(target, source, overwrite = TRUE)

}

# nocov start
renv_cache_format_path <- function(paths) {

  # extract path components
  names    <- format(renv_path_component(paths, 1L))
  hashes   <- format(renv_path_component(paths, 2L))
  versions <- format(renv_path_component(paths, 3L))

  # format and write
  fmt <- "%s %s [Hash: %s]"
  sprintf(fmt, names, versions, hashes)

}
# nocov end

renv_cache_clean_empty <- function(cache = NULL) {

  # no-op for Solaris
  if (renv_platform_solaris())
    return(FALSE)

  # move to cache root
  caches <- cache %||% renv_paths_cache()
  for (cache in caches)
    renv_cache_clean_empty_impl(cache)

  TRUE

}

renv_cache_clean_empty_impl <- function(cache) {

  # move to cache directory
  owd <- setwd(cache)
  on.exit(setwd(owd), add = TRUE)

  # construct system command for removing empty directories
  action <- "removing empty directories"
  if (renv_platform_windows()) {
    args <- c(".", ".", "/S", "/MOVE")
    renv_system_exec("robocopy", args, action, 0:8)
  } else {
    args <- c(".", "-type", "d", "-empty", "-delete")
    renv_system_exec("find", args, action)
  }

  TRUE

}

renv_cache_package_validate <- function(path) {

  if (renv_project_type(path) == "package")
    return(TRUE)

  type <- renv_file_type(path, symlinks = FALSE)
  if (!nzchar(type))
    return(FALSE)

  name <- if (type == "directory") "directory" else "file"
  fmt <- "%s %s exists but does not appear to be an R package"
  warningf(fmt, name, shQuote(path))

  FALSE

}

renv_cache_config_enabled <- function(project) {
  config$cache.enabled() && settings$use.cache(project = project)
}

renv_cache_config_symlinks <- function(project) {

  usesymlinks <-
    config$cache.symlinks(default = NULL) %||%
    renv_cache_config_symlinks_default(project = project)

  usesymlinks && settings$use.cache(project = project)

}

renv_cache_config_symlinks_default <- function(project) {

  # on linux, we can always use symlinks
  if (renv_platform_unix())
    return(TRUE)

  # on Windows, only try to use symlinks (junction points) if the cache
  # and the project library appear to live on the same drive
  libpath <- renv_paths_library(project = project)
  cachepath <- renv_paths_cache()

  # TODO: with this change, anyone using networks not mapped to a local drive
  # would need to opt-in to using symlinks, but that's probably okay?
  all(
    substring(libpath, 1L, 2L) == substring(cachepath, 1L, 2L),
    substring(libpath, 2L, 2L) == ":",
    substring(cachepath, 2L, 2L) == ":"
  )


}

renv_cache_linkable <- function(project, library) {
  renv_cache_config_enabled(project = project) &&
    renv_cache_config_symlinks(project = project) &&
    getOption(
      "renv.cache.linkable",
      renv_path_same(library, renv_paths_library(project = project))
    )
}

# given a call of the form e.g. 'pkg::foo()' or 'foo()',
# check that method 'foo()' is truly being called and
# strip off the 'pkg::' part for easier parsing
renv_call_expect <- function(node, package, methods) {

  if (!is.call(node))
    return(NULL)

  # check for call of the form 'pkg::foo(a, b, c)'
  colon <-
    is.call(node[[1L]]) &&
    is.name(node[[1L]][[1L]]) &&
    as.character(node[[1L]][[1L]]) %in% c("::", ":::")

  if (colon) {

    # validate the package name
    lhs <- node[[1L]][[2L]]
    if (as.character(lhs) != package)
      return(NULL)

    # extract the inner call
    rhs <- node[[1L]][[3L]]
    node[[1L]] <- rhs
  }

  # check for method match
  match <-
    is.name(node[[1L]]) &&
    as.character(node[[1L]]) %in% methods

  if (!match)
    return(NULL)

  node

}

renv_call_normalize <- function(node, stack) {

  # check for magrittr pipe -- if this part of the expression is
  # being piped into, then we need to munge the call
  ispipe <-
    is.call(node) &&
    is.symbol(node[[1L]]) &&
    as.character(node[[1L]]) %in% c("%>%", "%T>%", "%<>%")

  if (!ispipe)
    return(node)

  # get lhs and rhs of piped expression
  lhs <- node[[2L]]
  rhs <- node[[3L]]

  # handle rhs symbols
  if (is.symbol(rhs))
    rhs <- call(as.character(rhs))

  # check for usage of '.'
  # if it exists, replace each with lhs
  hasdot <- FALSE
  dot <- as.symbol(".")
  for (i in seq_along(rhs)) {
    if (identical(dot, rhs[[i]])) {
      hasdot <- TRUE
      rhs[[i]] <- lhs
    }
  }

  if (hasdot)
    return(rhs)

  # otherwise, mutate rhs call with lhs passed as first argument
  args <- as.list(rhs)
  as.call(c(args[[1L]], lhs, args[-1L]))

}

renv_cellar_roots <- function(project = NULL) {
  c(
    renv_paths_renv("cellar", project = project),
    renv_paths_renv("local", project = project),
    renv_paths_cellar(),
    renv_paths_local()
  )
}

renv_cellar_database <- function(project = NULL) {

  # find cellar root directories
  project <- renv_project_resolve(project)
  roots <- renv_cellar_roots(project)

  # list files both at top-level + one nested level
  paths <- list.files(roots, full.names = TRUE)
  paths <- c(paths, list.files(paths, full.names = TRUE))

  # grab files that look like packages
  extpat <- "(?:\\.tar\\.gz|\\.tgz|\\.zip)$"
  paths <- grep(extpat, paths, value = TRUE)

  # parse into data.frame
  base <- basename(paths)
  parts <- strsplit(base, "_", fixed = TRUE)
  package <- map_chr(parts, `[[`, 1L)
  rest <- map_chr(parts, `[[`, 2L)
  version <- sub(extpat, "", rest)

  data.frame(
    Package = package,
    Version = version,
    Path    = paths,
    stringsAsFactors = FALSE
  )

}

renv_cellar_latest <- function(package, project) {

  db <- renv_cellar_database(project = project)
  db <- db[db$Package == package, ]
  db <- db[order(package_version(db$Version), decreasing = TRUE), ]
  if (nrow(db) == 0L)
    return(record)

  entry <- db[1, ]
  list(
    Package = entry$Package,
    Version = entry$Version,
    Source  = "Cellar"
  )

}

renv_check_unknown_source <- function(records, project = NULL) {

  # nothing to do if we have no records
  if (empty(records))
    return(TRUE)

  # for testing, we ignore renv
  if (renv_tests_running())
    records$renv <- NULL

  # keep only records which have unknown source
  unknown <- filter(records, function(record) {

    source <- renv_record_source(record)
    if (source != "unknown")
      return(FALSE)

    localpath <- tryCatch(
      renv_retrieve_cellar_find(record, project),
      error = function(e) ""
    )

    if (file.exists(localpath))
      return(FALSE)

    TRUE

  })

  # if all records have a known source, return TRUE
  if (empty(unknown))
    return(TRUE)

  # provide warning
  if (!renv_tests_running())
    renv_warnings_unknown_sources(unknown)

  # return FALSE to indicate failed validation
  FALSE

}



#' Checkout a Repository
#'
#' `renv::checkout()` can be used to install the latest packages available from
#' the requested repositories.
#'
#' @inheritParams renv-params
#'
#' @param repos The \R package repositories to check out. When `NULL` (the default),
#'   `renv` will attempt to determine the packages used in the project via
#'   a call to [renv::dependencies()].
#'
#' @param packages The packages to be installed. When `NULL` (the default),
#'   all packages currently used in the project will be installed.
#'
#' @keywords internal
checkout <- function(repos = getOption("repos"),
                     ...,
                     packages = NULL,
                     clean    = FALSE,
                     project  = NULL)
{
  renv_consent_check()
  renv_scope_error_handler()
  renv_dots_check(...)

  project  <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  # set new repositories
  options(repos = repos)

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

  # install all of these packages, effectively attempting to update
  # to the latest version of each package
  latest <- lapply(packages, function(package) {

    # ignore base packages (these are never distributed on CRAN)
    priority <- renv_package_priority(package)
    if (identical(priority, "base"))
      return(NULL)

    # try to get latest package record
    catch(renv_available_packages_latest(package))

  })

  # notify user if packages are unavailable
  unavailable <- filter(latest, inherits, "error")
  renv_pretty_print(
    values    = names(unavailable),
    preamble  = "The following package(s) are not available:",
    postamble = "These packages will be ignored.",
    wrap      = FALSE
  )

  # take only 'real' records
  records <- filter(latest, is.list)

  # ignore renv (just because someone might be using the development version
  # of renv to perform this action; we wouldn't want to downgrade here)
  records[["renv"]] <- NULL

  # create lockfile matching this request
  lockfile <- renv_lockfile_init(project = project)
  renv_records(lockfile) <- records

  # perform restore
  restore(
    project  = project,
    lockfile = lockfile,
    repos    = repos,
    clean    = clean
  )

  invisible(project)

}

renv_checkout_packages <- function(project) {

  # TODO: how should we select which packages are checked out?
  deps <- dependencies(project, progress = FALSE)
  packages <- unique(deps$Package)
  all <- renv_package_dependencies(packages, project = project)
  names(all)

}

renv_ci_dependencies <- function() {

  # ensure ci directory exists
  ensure_directory("ci")

  # save R version
  saveRDS(R.version, file = "ci/version.rds", version = 2L)

  # find the packages used in this project
  records <- renv_project_remotes(project = getwd())
  packages <- extract_chr(records, "Package")

  # find recursive dependencies of these packages
  revdeps <- tools::package_dependencies(packages, recursive = TRUE)

  # collapse into unique list
  all <- sort(unique(unlist(revdeps)))

  # get versions of these dependencies
  db <- as.data.frame(
    available.packages(filters = c("OS_type", "duplicates")),
    stringsAsFactors = FALSE
  )

  # retrieve fields
  resolved <- db[db$Package %in% all, c("Package", "Version")]
  rownames(resolved) <- NULL

  # set version if available
  envvar <- case(
    renv_platform_linux()   ~ "RENV_CI_CACHE_VERSION_LINUX",
    renv_platform_macos()   ~ "RENV_CI_CACHE_VERSION_MACOS",
    renv_platform_windows() ~ "RENV_CI_CACHE_VERSION_WINDOWS"
  )

  # set cache version
  version <- Sys.getenv(envvar, unset = NA)
  if (!is.na(version))
    attr(resolved, "cache") <- version

  # print it out, just for our own information
  print(resolved)

  # save to file for hashing
  saveRDS(resolved, file = "ci/dependencies.rds", version = 2L)

}

renv_ci_repair <- function() {

  # get installed packages
  library <- renv_libpaths_default()
  db <- renv_installed_packages(lib.loc = library)

  # attempt to load these packages
  packages <- db$Package
  names(packages) <- packages
  ok <- map_lgl(packages, requireNamespace, quietly = TRUE)

  # check which failed to load
  broken <- packages[!ok]
  if (empty(broken)) {
    vwritef("* All installed packages can be successfully loaded.")
    return(broken)
  }

  # notify the user
  renv_pretty_print(
    values    = paste("-", packages),
    preamble  = "The following package(s) could not be successfully loaded:",
    postamble = "These packages will be removed and later reinstalled.",
    wrap      = FALSE
  )

  # remove each broken package
  paths <- file.path(library, broken)
  unlink(paths, recursive = TRUE)

  return(broken)

}

# TODO
#
# Different citation styles:
# - https://pandoc.org/MANUAL.html#citations
# - https://www.zotero.org/styles
# - https://pandoc.org/MANUAL.html#option--csl
#
# Path to pandoc? Safe pandoc invocation?
# Output formats? (text, markdown, etc)
# Write to file? (e.g. file called PACKAGE-CITATIONS?)
# Include only top-level packages? All recursive dependencies?
# Allow package-defined citations, or form only from DESCRIPTION?
# What about packages with multiple bibtex entries?
cite <- function(type = c("plain", "bibtex"),
                 ...,
                 project = NULL)
{
  renv_scope_error_handler()
  renv_dots_check(...)

  project <- project %||% renv_project()
  type <- match.arg(type)

  packages <- sort(.packages(all.available = TRUE))
  names(packages) <- packages
  vprintf("Generating citations ... ")
  citations <- lapply(packages, function(package) {
    catchall(citation(package))
  })
  vwritef("Done!")

  erridx <- map_lgl(citations, inherits, what = "condition")
  errs <- citations[erridx]
  if (length(errs)) {

      msg <- paste(
      format(paste0(names(errs), ":")),
      map_chr(errs, conditionMessage)
    )

    renv_pretty_print(
      msg,
      "renv could not generate citations for the following packages:",
      "You may need to manually form a citation for these packages.",
      wrap = FALSE
    )

  }

  bibtex <-
    enumerate(citations, renv_citation_bibtex) %>%
    filter(is.character) %>%
    unlist()

  for (i in seq_along(bibtex)) {
    replacement <- sprintf("{citation%i,", i)
    bibtex[[i]] <- sub("{,", replacement, bibtex[[i]], fixed = TRUE)
    bibtex[[i]] <- sub("title = \\{(.*)\\}", "title = {{\\1}}", bibtex[[i]])
  }

  dir <- tempfile("renv-cite-")
  dir.create(dir, recursive = TRUE)
  owd <- setwd(dir)
  on.exit(setwd(owd), add = TRUE)

  writeLines(paste(bibtex, collapse = "\n"), con = "bibliography.bib")

  md <- c(
    "---",
    "bibliography: bibliography.bib",
    "biblio-style: apalike",
    "nocite: '@*'",
    "---",
    "",
    "# Bibliography"
  )

  writeLines(md, con = "input.md")

  args <- c(
    "--bibliography=bibliography.bib",
    "--standalone",
    "input.md",
    "-o",
    "output.html"
  )

  system2("pandoc", args)
  system("open output.html")

}

renv_citation_bibtex <- function(package, citation) {

  status <- catch(toBibtex(citation))
  if (inherits(status, "error")) {
    fmt <- "could not generate bibtex for package '%s'"
    warningf(fmt, package)
    return(NULL)
  }

  status

}

#' Clean a Project
#'
#' Clean up a project and its associated \R libraries.
#'
#' @section Actions:
#'
#' The following clean actions are available:
#'
#' \describe{
#'
#' \item{`package.locks`}{
#'
#'   During package installation, \R will create package locks in the
#'   library path, typically named `00LOCK-<package>`. On occasion, if package
#'   installation fails or \R is terminated while installing a package, these
#'   locks can be left behind and will inhibit future attempts to reinstall
#'   that package. Use this action to remove such left-over package locks.
#'
#' }
#'
#' \item{`library.tempdirs`}{
#'
#'   During package installation, \R may create temporary directories with
#'   names of the form `file\w{12}`, and on occasion those files can be
#'   left behind even after they are no longer in use. Use this action to
#'   remove such left-over directories.
#' }
#'
#' \item{`system.library`}{
#'
#'   In general, it is recommended that only packages distributed with \R
#'   are installed into the system library (the library path referred to
#'   by `.Library`). Use this action to remove any user-installed packages
#'   that have been installed to the system library.
#'
#'   Because this action is destructive, it is by default never run -- it
#'   must be explicitly requested by the user.
#'
#' }
#'
#' \item{`unused.packages`}{
#'
#'   Remove packages that are installed in the project library, but no longer
#'   appear to be used in the project sources.
#'
#'   Because this action is destructive, it is by default only run in
#'   interactive sessions when prompting is enabled.
#'
#' }
#'
#' }
#'
#'
#' @inherit renv-params
#'
#' @param actions The set of clean actions to take. See the documentation in
#'   **Actions** for a list of available actions, and the default actions
#'   taken when no actions are supplied.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # clean the current project
#' renv::clean()
#'
#' }
clean <- function(project = NULL,
                  ...,
                  actions = NULL,
                  prompt  = interactive())
{
  renv_scope_error_handler()
  renv_dots_check(...)

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  renv_activate_prompt("clean", NULL, prompt, project)

  renv_dependencies_scope(project, action = "clean")

  actions <- actions %||% renv_clean_actions(prompt)

  all <- list(
    package.locks     = renv_clean_package_locks,
    library.tempdirs  = renv_clean_library_tempdirs,
    system.library    = renv_clean_system_library,
    unused.packages   = renv_clean_unused_packages
  )

  methods <- all[actions]
  for (method in methods)
    tryCatch(method(project, prompt), error = warning)

  vwritef("* The project has been cleaned.")
  invisible(project)
}

renv_clean_actions <- function(prompt) {

  default <- c(
    "package.locks",
    "library.tempdirs"
  )

  unsafe <- c(
    # "system.library",
    "unused.packages"
  )

  c(default, if (prompt) unsafe)

}

renv_clean_library_tempdirs <- function(project, prompt) {

  ntd <- function() {
    vwritef("* No temporary directories were found in the project library.")
    FALSE
  }

  library <- renv_paths_library(project = project)
  children <- list.files(library, full.names = TRUE)

  bad <- grep("/file\\w{12}$", children, value = TRUE)
  if (empty(bad))
    return(ntd())

  # nocov start
  if (prompt || renv_verbose()) {

    renv_pretty_print(
      bad,
      "The following directories will be removed:",
      wrap = FALSE
    )

    if (prompt && !proceed())
      return(FALSE)

  }
  # nocov end

  unlink(bad, recursive = TRUE)
  TRUE

}


# remove user packages in system library
renv_clean_system_library <- function(project, prompt) {

  ntd <- function() {
    vwritef("* No non-system packages were discovered in the system library.")
    FALSE
  }

  # explicitly query for packages
  syslib <- renv_path_normalize(renv_libpaths_system(), winslash = "/", mustWork = FALSE)
  db <- renv_installed_packages(lib.loc = syslib, priority = "NA")
  packages <- setdiff(db$Package, "translations")

  # also look for leftover package folders
  # (primarily for Windows, where .dlls from old packages can be left behind)

  # nocov start
  if (renv_platform_windows()) {
    folders <- list.files(syslib, full.names = TRUE)
    descpaths <- file.path(folders, "DESCRIPTION")
    missing <- !file.exists(descpaths)
    packages <- union(packages, basename(folders)[missing])
  }
  # nocov end

  # check for any packages needing removal
  if (empty(packages))
    return(ntd())

  # nocov start
  if (prompt || renv_verbose()) {

    renv_pretty_print(
      packages,
      "The following non-system packages are installed in the system library:",
      c(
        "Normally, only packages distributed with R should be installed in the system library.",
        "These packages will be removed.",
        "If necessary, consider reinstalling these packages in your site library."
      )
    )

    if (prompt && !proceed())
      return(FALSE)

  }
  # nocov end

  remove(packages, library = syslib)
  TRUE

}

renv_clean_unused_packages <- function(project, prompt) {

  ntd <- function() {
    vwritef("* No unused packages were found in the project library.")
    FALSE
  }

  # find packages installed in the project library
  library <- renv_paths_library(project = project)
  installed <- list.files(library)
  if (empty(installed))
    return(ntd())

  # find packages used in the project and their dependencies
  deps <- dependencies(project, progress = FALSE)
  paths <- renv_package_dependencies(deps$Package, project = project)
  packages <- names(paths)

  # figure out which packages aren't needed
  removable <- renv_vector_diff(installed, packages)
  if (empty(removable))
    return(ntd())

  # nocov start
  if (prompt || renv_verbose()) {

    renv_pretty_print(
      removable,
      c(
        "The following packages are installed in the project library,",
        "but appear to be no longer used in your project."
      ),
      "These packages will be removed."
    )

    if (prompt && !proceed())
      return(FALSE)

  }
  # nocov end

  remove(removable, library = library)
  return(TRUE)

}

renv_clean_package_locks <- function(project, prompt) {

  ntd <- function() {
    vwritef("* No stale package locks were found.")
    FALSE
  }

  # find 00LOCK directories in library
  library <- renv_paths_library(project = project)
  lock <- list.files(path = library, pattern = "^00LOCK", full.names = TRUE)
  if (empty(lock))
    return(ntd())

  # check to see which are old
  now <- Sys.time()
  mtime <- file.mtime(lock)
  mtime[is.na(mtime)] <- now
  diff <- difftime(now, mtime, units = "mins")
  old <- lock[diff > 2]
  if (empty(old))
    return(ntd())

  # nocov start
  if (prompt || renv_verbose()) {

    renv_pretty_print(
      basename(old),
      "The following stale package locks were discovered in your library:",
      "These locks will be removed.",
      wrap = FALSE
    )

    if (prompt && !proceed())
      return(FALSE)

  }
  # nocov end

  unlink(old, recursive = TRUE)
  TRUE
}

# nocov start
renv_clean_cache <- function(project, prompt) {

  ntd <- function() {
    vwritef("* No unused packages were found in the renv cache.")
    FALSE
  }

  # find projects monitored by renv
  projects <- renv_paths_root("projects")
  projlist <- character()
  if (file.exists(projects))
    projlist <- readLines(projects, warn = FALSE, encoding = "UTF-8")

  # inform user if any projects are missing
  missing <- !file.exists(projlist)
  if (any(missing)) {

    renv_pretty_print(
      projlist[missing],
      "The following projects are monitored by renv, but no longer exist:",
      "These projects will be removed from renv's project list.",
      wrap = FALSE
    )

    if (prompt && !proceed())
      return(FALSE)

    writeLines(projlist[!missing], projects, useBytes = TRUE)

  }

  action <- function(project) {
    library <- renv_paths_library(project = project)
    packages <- list.files(library, full.names = TRUE)
    descs <- file.path(packages, "DESCRIPTION")
    existing <- file.exists(descs)
    map_chr(descs[existing], renv_cache_path, USE.NAMES = FALSE)
  }

  # for each project, find packages used in their renv private library,
  # and look for entries in the cache
  projlist <- projlist[!missing]
  callback <- renv_progress_callback(action, length(projlist))
  used <- uapply(projlist, callback)

  # check what packages are actually available in the cache
  available <- renv_cache_list()

  diff <- renv_vector_diff(available, used)
  if (empty(diff))
    return(ntd())

  if (prompt || renv_verbose()) {

    renv_pretty_print(
      renv_cache_format_path(diff),
      "The following packages are installed in the cache but no longer used:",
      "These packages will be removed.",
      wrap = FALSE
    )

    if (prompt && !proceed())
      return(FALSE)

  }

  # remove the directories
  unlink(diff, recursive = TRUE)
  renv_cache_clean_empty()
  vwritef("* %i package(s) have been removed.", length(diff))
  TRUE

}
# nocov end

renv_cli_install <- function(target = NULL) {

  # get path to bundled tool
  exe <- if (renv_platform_windows()) "bin/renv.bat" else "bin/renv"
  path <- system.file(exe, package = "renv")

  # copy into directory on PATH
  target <- target %||% path.expand("~/bin/renv")
  ensure_parent_directory(target)
  file.copy(path, target)

  writef("* renv binary copied to %s.", renv_path_pretty(target))
  invisible(target)

}

renv_cli_exec <- function(clargs = commandArgs(trailingOnly = TRUE)) {
  invisible(renv_cli_exec_impl(clargs))
}

renv_cli_exec_impl <- function(clargs) {

  # check for tool called without arguments, or called with '--help'
  usage <-
    length(clargs) == 0 ||
    clargs[1L] %in% c("help", "--help")

  if (usage)
    return(renv_cli_usage())

  # extract method
  method <- clargs[1L]

  # check request for help on requested method
  help <-
    clargs[2L] %in% c("help", "--help")

  if (help)
    return(renv_cli_help(method))

  # check for known function in renv
  exports <- getNamespaceExports("renv")
  if (!method %in% exports)
    return(renv_cli_unknown(method, exports))

  # begin building call
  args <- list(call("::", as.name("renv"), as.name(method)))

  for (clarg in clargs[-1L]) {

    # convert '--no-<flag>' into a FALSE parameter
    if (grepl("^--no-", clarg)) {
      key <- substring(clarg, 6L)
      args[[key]] <- FALSE
    }

    # convert '--param=value' flags
    else if (grepl("^--[^=]+=", clarg)) {
      index <- regexpr("=", clarg, fixed = TRUE)
      key <- substring(clarg, 3L, index - 1L)
      val <- substring(clarg, index + 1L)
      args[[key]] <- renv_cli_parse(val)
    }

    # convert '--flag' into a TRUE parameter
    else if (grepl("^--", clarg)) {
      key <- substring(clarg, 3L)
      args[[key]] <- TRUE
    }

    # convert 'param=value' flags
    else if (grepl("=", clarg, fixed = TRUE)) {
      index <- regexpr("=", clarg, fixed = TRUE)
      key <- substring(clarg, 1L, index - 1L)
      val <- substring(clarg, index + 1L)
      args[[key]] <- renv_cli_parse(val)
    }

    # take other parameters as-is
    else {
      args[[length(args) + 1L]] <- renv_cli_parse(clarg)
    }

  }

  # invoke method with parsed arguments
  expr <- as.call(args)
  eval(expr = expr, envir = globalenv())

}

renv_cli_usage <- function() {

  usage <- "
Usage: renv [method] [args...]

[method] should be the name of a function exported from renv.
[args...] should be arguments accepted by that function.

Use renv [method] --help for more information about the associated function.

Examples:

  # basic commands
  renv init      # initialize a project
  renv snapshot  # snapshot project library
  renv restore   # restore project library
  renv status    # check project status

  # install a package
  renv install dplyr

  # run a script in an renv project
  renv run path/to/script.R
"

  writeLines(usage, con = stderr())

}

renv_cli_help <- function(method) {
  print(help(method, package = "renv"))
}

renv_cli_unknown <- function(method, exports) {

  # report unknown command
  fmt <- "renv: '%s' is not a known command."
  writef(fmt, method, con = stderr())

  # check for similar commands
  distance <- c(adist(method, exports))
  names(distance) <- exports
  n <- min(distance)
  if (n > 2)
    return(1L)

  candidates <- names(distance)[distance == n]
  fmt <- "did you mean %s?"
  vwritef(fmt, paste(shQuote(candidates), collapse = " or "))
  return(1L)

}

renv_cli_parse <- function(text) {

  # handle logical-like values up-front
  if (text %in% c("true", "True", "TRUE"))
    return(TRUE)
  else if (text %in% c("false", "False", "FALSE"))
    return(FALSE)

  # parse the expression
  value <- parse(text = text)[[1L]]
  if (is.language(value)) text else value

}

# given the path to a Python installation managed by conda, attempt to
# find the conda installation + executable used to create it
renv_conda_find <- function(python) {

  tryCatch(
    renv_conda_find_impl(python),
    error = function(e) {
      warning(e)
      ""
    }
  )

}

renv_conda_find_impl <- function(python) {

  # read the conda environment's history to try to find conda
  base <- dirname(python)
  if (!renv_platform_windows())
    base <- dirname(base)

  history <- file.path(base, "conda-meta/history")
  if (!file.exists(history))
    return("")

  contents <- readLines(history, n = 2L, warn = FALSE)
  if (length(contents) < 2)
    return("")

  line <- substring(contents[2L], 8L)
  index <- regexpr(" ", line, fixed = TRUE)
  if (index == -1L)
    return("")

  conda <- substring(line, 1L, index - 1L)
  if (renv_platform_windows())
    conda <- file.path(dirname(conda), "conda.exe")

  # prefer condabin if it exists
  condabin <- file.path(dirname(conda), "../condabin", basename(conda))
  if (file.exists(condabin))
    conda <- condabin

  # bail if conda wasn't found
  if (!file.exists(conda))
    return("")

  renv_path_canonicalize(conda)

}

renv_condition_signal <- function(class = NULL, data = NULL) {
  condition <- list(message = character(), call = NULL, data = data)
  class(condition) <- c(class, "renv.condition", "condition")
  signalCondition(condition)
}

renv_condition_data <- function(condition) {
  condition$data
}

# Auto-generated by 'tools/tools-generate-config.R'

#' @rdname config
#' @export
config <- list(

  activate.prompt = function(..., default = TRUE) {
    renv_config_get(
      name    = "activate.prompt",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  autoloader.enabled = function(..., default = TRUE) {
    renv_config_get(
      name    = "autoloader.enabled",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  auto.snapshot = function(..., default = FALSE) {
    renv_config_get(
      name    = "auto.snapshot",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  bitbucket.host = function(..., default = "api.bitbucket.org/2.0") {
    renv_config_get(
      name    = "bitbucket.host",
      type    = "character[1]",
      default = default,
      args    = list(...)
    )
  },

  copy.method = function(..., default = "auto") {
    renv_config_get(
      name    = "copy.method",
      type    = "*",
      default = default,
      args    = list(...)
    )
  },

  connect.timeout = function(..., default = 20L) {
    renv_config_get(
      name    = "connect.timeout",
      type    = "integer[1]",
      default = default,
      args    = list(...)
    )
  },

  connect.retry = function(..., default = 3L) {
    renv_config_get(
      name    = "connect.retry",
      type    = "integer[1]",
      default = default,
      args    = list(...)
    )
  },

  cache.enabled = function(..., default = TRUE) {
    renv_config_get(
      name    = "cache.enabled",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  cache.symlinks = function(..., default = .Platform$OS.type == "unix") {
    renv_config_get(
      name    = "cache.symlinks",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  dependency.errors = function(..., default = "reported") {
    renv_config_get(
      name    = "dependency.errors",
      type    = "character[1]",
      default = default,
      args    = list(...)
    )
  },

  exported.functions = function(..., default = "*") {
    renv_config_get(
      name    = "exported.functions",
      type    = "character[*]",
      default = default,
      args    = list(...)
    )
  },

  external.libraries = function(..., default = NULL) {
    renv_config_get(
      name    = "external.libraries",
      type    = "character[*]",
      default = default,
      args    = list(...)
    )
  },

  filebacked.cache = function(..., default = TRUE) {
    renv_config_get(
      name    = "filebacked.cache",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  github.host = function(..., default = "api.github.com") {
    renv_config_get(
      name    = "github.host",
      type    = "character[1]",
      default = default,
      args    = list(...)
    )
  },

  gitlab.host = function(..., default = "gitlab.com") {
    renv_config_get(
      name    = "gitlab.host",
      type    = "character[1]",
      default = default,
      args    = list(...)
    )
  },

  hydrate.libpaths = function(..., default = NULL) {
    renv_config_get(
      name    = "hydrate.libpaths",
      type    = "character[*]",
      default = default,
      args    = list(...)
    )
  },

  install.build = function(..., default = FALSE) {
    renv_config_get(
      name    = "install.build",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  install.shortcuts = function(..., default = TRUE) {
    renv_config_get(
      name    = "install.shortcuts",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  install.staged = function(..., default = TRUE) {
    renv_config_get(
      name    = "install.staged",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  install.transactional = function(..., default = TRUE) {
    renv_config_get(
      name    = "install.transactional",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  install.verbose = function(..., default = FALSE) {
    renv_config_get(
      name    = "install.verbose",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  locking.enabled = function(..., default = FALSE) {
    renv_config_get(
      name    = "locking.enabled",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  mran.enabled = function(..., default = TRUE) {
    renv_config_get(
      name    = "mran.enabled",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  pak.enabled = function(..., default = FALSE) {
    renv_config_get(
      name    = "pak.enabled",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  repos.override = function(..., default = NULL) {
    renv_config_get(
      name    = "repos.override",
      type    = "character[*]",
      default = default,
      args    = list(...)
    )
  },

  rspm.enabled = function(..., default = TRUE) {
    renv_config_get(
      name    = "rspm.enabled",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  sandbox.enabled = function(..., default = FALSE) {
    renv_config_get(
      name    = "sandbox.enabled",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  shims.enabled = function(..., default = TRUE) {
    renv_config_get(
      name    = "shims.enabled",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  snapshot.validate = function(..., default = TRUE) {
    renv_config_get(
      name    = "snapshot.validate",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  startup.quiet = function(..., default = NULL) {
    renv_config_get(
      name    = "startup.quiet",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  synchronized.check = function(..., default = TRUE) {
    renv_config_get(
      name    = "synchronized.check",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  updates.check = function(..., default = FALSE) {
    renv_config_get(
      name    = "updates.check",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  updates.parallel = function(..., default = 2L) {
    renv_config_get(
      name    = "updates.parallel",
      type    = "*",
      default = default,
      args    = list(...)
    )
  },

  user.environ = function(..., default = TRUE) {
    renv_config_get(
      name    = "user.environ",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  user.library = function(..., default = FALSE) {
    renv_config_get(
      name    = "user.library",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  },

  user.profile = function(..., default = FALSE) {
    renv_config_get(
      name    = "user.profile",
      type    = "logical[1]",
      default = default,
      args    = list(...)
    )
  }

)

#' User-Level Configuration of renv
#'
#' Configure different behaviors of `renv`.
#'
#' For a given configuration option:
#'
#' 1. If an \R option of the form `renv.config.<name>` is available,
#'    then that option's value will be used;
#'
#' 2. If an environment variable of the form `RENV_CONFIG_<NAME>` is available,
#'   then that option's value will be used;
#'
#' 3. Otherwise, the default for that particular configuration value is used.
#'
#' Any periods (`.`)s in the option name are transformed into underscores (`_`)
#' in the environment variable name, and vice versa. For example, the
#' configuration option `auto.snapshot` could be configured as:
#'
#' - `options(renv.config.auto.snapshot = <...>)`
#' - `Sys.setenv(RENV_CONFIG_AUTO_SNAPSHOT = <...>)`
#'
#' Note that if both the R option and the environment variable are defined, the
#' R option will be used instead. Environment variables can be more useful when
#' you want a particular configuration to be automatically inherited by child
#' processes; if that behavior is not desired, then the R option may be
#' preferred.
#'
#' If you want to set and persist these options across multiple projects, it is
#' recommended that you set them in a a startup `.Renviron` file; e.g. in your
#' own `~/.Renviron`, or in the R installation's `etc/Rprofile.site` file. See
#' [Startup] for more details.
#'
#' @eval renv_roxygen_config_section()
#'
#' @section Copy Methods:
#'
#' If you find that `renv` is unable to copy some directories in your
#' environment, you may want to try setting the `copy.method` option. By
#' default, `renv` will try to choose a system tool that is likely to succeed in
#' copying files on your system -- `robocopy` on Windows, and `cp` on Unix.
#' `renv` will also instruct these tools to preserve timestamps and attributes
#' when copying files. However, you can select a different method as
#' appropriate.
#'
#' The following methods are supported:
#'
#' \tabular{ll}{
#' `auto`     \tab Use `robocopy` on Windows, and `cp` on Unix-alikes. \cr
#' `R`        \tab Use \R's built-in `file.copy()` function. \cr
#' `cp`       \tab Use `cp` to copy files. \cr
#' `robocopy` \tab Use `robocopy` to copy files. (Only available on Windows.) \cr
#' `rsync`    \tab Use `rsync` to copy files. \cr
#' }
#'
#' You can also provide a custom copy method if required; e.g.
#'
#' ```
#' options(renv.config.copy.method = function(src, dst) {
#'   # copy a file from 'src' to 'dst'
#' })
#' ```
#'
#' Note that `renv` will always first attempt to copy a directory first to a
#' temporary path within the target folder, and then rename that temporary path
#' to the final target destination. This helps avoid issues where a failed
#' attempt to copy a directory could leave a half-copied directory behind
#' in the final location.
#'
#' @section Project-Local Settings:
#'
#' For settings that should persist alongside a particular project, the
#' various settings available in [settings] can be used.
#'
#' @examples
#'
#' # disable automatic snapshots
#' options(renv.config.auto.snapshot = FALSE)
#'
#' # disable with environment variable
#' Sys.setenv(RENV_CONFIG_AUTO_SNAPSHOT = FALSE)
#'
#' @rdname config
#' @name config
NULL

renv_config_get <- function(name,
                            scope   = "config",
                            type    = "*",
                            default = NULL,
                            args    = NULL)
{
  # check for R option of associated name
  optname <- tolower(name)
  optkey <- paste("renv", scope, optname, sep = ".")
  optval <- getOption(optkey)
  if (!is.null(optval))
    return(renv_config_validate(name, optval, type, default, args))

  # check for environment variable
  envname <- gsub(".", "_", toupper(name), fixed = TRUE)
  envkey <- paste("RENV", toupper(scope), envname, sep = "_")
  envval <- Sys.getenv(envkey, unset = NA)
  if (!is.na(envval) && nzchar(envval)) {
    decoded <- renv_config_decode_envvar(envkey, envval)
    return(renv_config_validate(name, decoded, type, default, args))
  }

  # return default if nothing found
  default

}

renv_config_decode_envvar <- function(envname, envval) {

  map <- env(
    "NULL" = NULL,
    "NA"   = NA,
    "NaN"  = NaN,
    "true" = TRUE,
    "True" = TRUE,
    "TRUE" = TRUE,
    "false" = FALSE,
    "False" = FALSE,
    "FALSE" = FALSE
  )

  if (exists(envval, envir = map, inherits = FALSE))
    return(get(envval, envir = map, inherits = FALSE))

  libvars <- c("RENV_CONFIG_EXTERNAL_LIBRARIES", "RENV_CONFIG_HYDRATE_LIBPATHS")
  pattern <- if (envname %in% libvars)
    "\\s*[:;,]\\s*"
  else
    "\\s*,\\s*"

  strsplit(envval, pattern, perl = TRUE)[[1L]]

}

renv_config_validate <- function(name, value, type, default, args) {

  # no validation required for type = '*'
  if (identical(type, "*"))
    return(value)

  # if 'value' is a function, invoke it with args
  if (is.function(value)) {
    value <- catch(do.call(value, args))
    if (inherits(value, "error")) {
      warning(value, call. = FALSE)
      return(default)
    }
  }

  # parse the type string
  pattern <- paste0(
    "^",          # start of specifier
    "([^[(]+)",   # type name
    "[[(]",       # opening bracket
    "([^])]+)",   # length specifier
    "[])]",       # closing bracket
    "$"           # end of specifier
  )

  m <- regexec(pattern, type)
  matches <- regmatches(type, m)
  fields <- matches[[1L]]

  # extract declared mode, size
  mode <- fields[[2L]]
  size <- fields[[3L]]

  # validate the requested size for this option
  if (!renv_config_validate_size(value, size)) {
    fmt <- "value for option '%s' does not satisfy constraint '%s'"
    warningf(fmt, name, type)
  }

  # convert NULL values to requested type
  if (is.null(value)) {
    value <- convert(value, mode)
    return(value)
  }

  # otherwise, validate that this is a valid option
  if (identical(storage.mode(value), mode))
    return(value)

  # try converting
  converted <- catchall(convert(value, mode))
  if (any(is.na(converted)) || inherits(converted, "condition")) {
    fmt <- "'%s' does not satisfy constraint '%s' for config '%s'; using default '%s' instead"
    warningf(fmt, renv_deparse(value), type, name, renv_deparse(default))
    return(default)
  }

  # ok, validated + converted option
  converted

}

renv_config_validate_size <- function(value, size) {

  case(
    size == "*" ~ TRUE,
    size == "+" ~ length(value) > 0,
    size == "?" ~ length(value) %in% c(0, 1),
    TRUE        ~ as.numeric(size) == length(value)
  )

}

renv_config_install_staged <- function(default = TRUE) {

  values <- c(
    config$install.staged(default = NULL),
    config$install.transactional(default = NULL),
    default
  )

  values[[1L]]

}

#' Consent to usage of renv
#'
#' Provide consent to `renv`, allowing it to write and update certain files
#' on your filesystem.
#'
#' As part of its normal operation, `renv` will write and update some files
#' in your project directory, as well as an application-specific cache
#' directory. These paths are documented within [paths].
#'
#' In accordance with the
#' [CRAN Repository Policy](https://cran.r-project.org/web/packages/policies.html),
#' `renv` must first obtain consent from you, the user, before these actions
#' can be taken. Please call `renv::consent()` first to provide this consent.
#'
#' You can also set the \R option:
#'
#' ```
#' options(renv.consent = TRUE)
#' ```
#'
#' to implicitly provide consent for e.g. non-interactive \R sessions.
#'
#' @param provided The default provided response. If you need to provide
#'   consent from a non-interactive \R session, you can invoke
#'   `renv::consent(provided = TRUE)` explicitly.
#'
#' @return `TRUE` if consent is provided, or an \R error otherwise.
#'
#' @export
consent <- function(provided = FALSE) {

  # compute path to root directory
  root <- renv_paths_root()
  if (renv_file_type(root) == "directory") {
    vwritef("* Consent to use renv has already been provided -- nothing to do.")
    return(invisible(TRUE))
  }

  # write welcome message
  template <- system.file("resources/WELCOME", package = "renv")
  contents <- readLines(template)
  replacements <- list(RENV_PATHS_ROOT = renv_path_pretty(root))
  welcome <- renv_template_replace(contents, replacements)
  writeLines(welcome)

  # ask user if they want to proceed
  response <- catchall(proceed(default = provided))
  if (!identical(response, TRUE)) {
    msg <- "consent was not provided; operation aborted"
    stop(msg, call. = FALSE)
  }

  # cache the user response
  options(renv.consent = TRUE)
  ensure_directory(root)
  vwritef("* %s has been created.", renv_path_pretty(root))

  invisible(TRUE)

}

renv_consent_check <- function() {

  # check for explicit consent
  consent <- getOption("renv.consent")
  if (identical(consent, TRUE))
    return(TRUE)
  else if (identical(consent, FALSE))
    stopf("consent has been explicitly withdrawn")

  # check for existence of root
  root <- renv_paths_root()
  if (renv_file_type(root) == "directory")
    return(TRUE)

  # check for implicit consent
  consented <-
    !interactive() ||
    !is.na(Sys.getenv("CI", unset = NA)) ||
    !is.na(Sys.getenv("GITHUB_ACTION", unset = NA)) ||
    !is.na(Sys.getenv("RENV_PATHS_ROOT", unset = NA)) ||
    file.exists("/.singularity.d") ||
    file.exists("/.dockerenv")

  if (consented) {
    ensure_directory(root)
    return(TRUE)
  }

  # looks like the user's first interactive use of renv
  consent()

}

# nocov start

renv_cran_status <- function(email   = NULL,
                             package = NULL,
                             view    = "maintainer")
{
  case(
    view == "maintainer" ~ renv_cran_status_maintainer(email, package),
    TRUE                 ~ stopf("unrecognized view '%s'", view)
  )

}

renv_cran_status_maintainer <- function(email, package) {

  email <- email %||% renv_cran_status_maintainer_email(package = package)
  parts <- strsplit(email, "@", fixed = TRUE)[[1L]]

  fmt <- "https://cran.r-project.org/web/checks/check_results_%s_at_%s.html"
  url <- sprintf(fmt, parts[[1L]], parts[[2L]])

  browseURL(url)

}

renv_cran_status_maintainer_email <- function(package = NULL) {

  mtr <- renv_package_description_field(
    package = package %||% "renv",
    field   = "Maintainer"
  )

  indices <- gregexpr("[<>]", mtr, perl = TRUE)[[1L]]
  substring(mtr, indices[[1L]] + 1L, indices[[2L]] - 1L)

}

# nocov end

# similar to base::read.dcf(), but:
# - allows for whitespace between fields
# - allows for non-indented field continuations
# - always keeps whitespace
renv_dcf_read <- function(file, text = NULL, ...) {

  # read the file as binary first to get encoding
  contents <- text %||% renv_dcf_read_impl(file, ...)

  # normalize newlines
  contents <- gsub("\r\n", "\n", contents, fixed = TRUE)

  # look for tags
  pattern <- "(?:^|\n)[^\\s][^:\n]*:"
  matches <- gregexpr(pattern, contents, perl = TRUE)[[1L]]

  # compute substring indices
  starts <- matches
  ends   <- c(tail(matches, n = -1L), nchar(contents))
  parts <- substring(contents, starts, ends)

  # read as property list
  properties <- renv_properties_read(text = parts, dequote = FALSE)

  # set encoding if necessary
  if (identical(properties$Encoding, "UTF-8"))
    properties[] <- lapply(properties, renv_encoding_mark, "UTF-8")

  # return as data.frame
  as.list(properties)

}

renv_dcf_read_impl_encoding <- function(contents) {

  # try to find encoding -- if none is declared, assume native encoding?
  start <- grepRaw("(?:^|\n)Encoding:", contents)
  if (empty(start))
    return(NULL)

  # try to find the end of the encoding field
  end   <- grepRaw("(?:\r?\n|$)", contents, offset = start + 1L)
  field <- rawToChar(contents[start:end])

  # parse it
  properties <- renv_properties_read(text = field)
  properties[["Encoding"]]

}

renv_dcf_read_impl <- function(file, ...) {

  # first, read the file as bytes to get encoding
  contents <- readBin(
    con  = file,
    what = "raw",
    n    = renv_file_size(file)
  )

  # try to guess the encoding
  encoding <- tryCatch(
    renv_dcf_read_impl_encoding(contents),
    error = function(e) NULL
  )

  # try a bunch of candidate encodings
  encodings <- c(encoding, "UTF-8", "latin1", "")
  for (encoding in unique(encodings)) {
    result <- iconv(list(contents), from = encoding, to = "UTF-8")
    if (!is.na(result))
      return(result)
  }

  # all else fails, just pretend it's in the native encoding
  rawToChar(contents)

}

renv_dcf_write <- function(x, file = "") {
  keep.white <- c("Description", "Authors@R", "Author", "Built", "Packaged")
  write.dcf(as.list(x), file = file, indent = 4L, width = 80L, keep.white = keep.white)
}

#' Deactivate a Project
#'
#' Use `deactivate()` to remove the infrastructure used by `renv` to activate
#' projects for newly-launched \R sessions. In particular, this implies removing
#' the requisite code from the project `.Rprofile` that automatically activates
#' the project when new \R sessions are launched in the project directory.
#'
#' @inherit renv-params
#'
#' @family renv
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # deactivate the currently-activated project
#' renv::deactivate()
#'
#' }
deactivate <- function(project = NULL) {

  renv_scope_error_handler()

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  renv_infrastructure_remove_rprofile(project)

  unload(project)

  renv_restart_request(project, reason = "renv deactivated")
  invisible(project)

}

renv_debugging <- function() {
  getOption("renv.debugging", default = FALSE)
}

defer <- function(expr, envir = parent.frame()) {

  handler <- renv_exit_handlers_add(
    list(expr = substitute(expr), envir = parent.frame()),
    envir = envir
  )

  invisible(handler)

}


`_renv_dependencies` <- new.env(parent = emptyenv())

#' Find R Package Dependencies in a Project
#'
#' Find \R packages used within a project.
#'
#' `dependencies()` will crawl files within your project, looking for \R files
#' and the packages used within those \R files. This is done primarily by
#' parsing the code and looking for calls of the form:
#'
#' - `library(package)`
#' - `require(package)`
#' - `requireNamespace("package")`
#' - `package::method()`
#'
#' For \R package projects, dependencies expressed in the `DESCRIPTION` file
#' will also be discovered. Note that the `rmarkdown` package is required in
#' order to crawl dependencies in R Markdown files.
#'
#' @section Suppressing Errors:
#'
#' Depending on how you've structured your code, `renv` may emit errors when
#' attempting to enumerate dependencies within `.Rmd` / `.Rnw` documents.
#' For code chunks that you'd explicitly like `renv` to ignore, you can
#' include `renv.ignore=TRUE` in the chunk header. For example:
#'
#'     ```{r chunk-label, renv.ignore=TRUE}
#'     # code in this chunk will be ignored by renv
#'     ```
#'
#' Similarly, if you'd like `renv` to parse a chunk that is otherwise ignored
#' (e.g. because it has `eval=FALSE` as a chunk header), you can set:
#'
#'     ```{r chunk-label, eval=FALSE, renv.ignore=FALSE}
#'     # code in this chunk will _not be ignored
#'     ```
#'
#' @section Ignoring Files:
#'
#' By default, `renv` will read your project's `.gitignore`s (if any) to
#' determine whether certain files or folders should be included when traversing
#' directories. If preferred, you can also create a `.renvignore` file (with
#' entries of the same format as a standard `.gitignore` file) to tell `renv`
#' which files to ignore within a directory. If both `.renvignore` and
#' `.gitignore` exist within a folder, the `.renvignore` will be used in lieu of
#' the `.gitignore`.
#'
#' See <https://git-scm.com/docs/gitignore> for documentation on the
#' `.gitignore` format. Some simple examples here:
#'
#' ```
#' # ignore all R Markdown files
#' *.Rmd
#'
#' # ignore all data folders
#' data/
#'
#' # ignore only data folders from the root of the project
#' /data/
#' ```
#'
#' @inheritParams renv-params
#'
#' @param path The path to a (possibly multi-mode) \R file, or a directory
#'   containing such files. By default, all files within the current working
#'   directory are checked, recursively.
#'
#' @param root The root directory to be used for dependency discovery.
#'   Defaults to the active project directory. You may need to set this
#'   explicitly to ensure that your project's `.renvignore`s (if any) are
#'   properly handled.
#'
#' @param progress Boolean; report progress output while enumerating
#'   dependencies?
#'
#' @param errors How should errors that occur during dependency enumeration be
#'   handled? See **Errors** for more details.
#'
#' @param dev Boolean; include 'development' dependencies as well? That is,
#'   packages which may be required during development but are unlikely to be
#'   required during runtime for your project. By default, only runtime
#'   dependencies are returned.
#'
#' @return An \R `data.frame` of discovered dependencies, mapping inferred
#'   package names to the files in which they were discovered.
#'
#' @section Errors:
#'
#' `renv`'s attempts to enumerate package dependencies in your project can fail
#' -- most commonly, because of parse errors in your \R code. The `errors`
#' parameter can be used to control how `renv` responds to errors that occur.
#'
#' \tabular{ll}{
#' **Name** \tab **Action** \cr
#' `"reported"` \tab Errors are reported to the user, but are otherwise ignored. \cr
#' `"fatal"`    \tab Errors are fatal and stop execution. \cr
#' `"ignored"`  \tab Errors are ignored and not reported to the user. \cr
#' }
#'
#' Depending on the structure of your project, you may want `renv` to ignore
#' errors that occur when attempting to enumerate dependencies. However, a more
#' robust solution would be to use an `.renvignore` file to tell `renv` not to
#' scan such files for dependencies, or to configure the project to require
#' explicit dependency management (`renv::settings$snapshot.type("explicit")`)
#' and enumerate your dependencies in a project `DESCRIPTION` file.
#'
#' @section Development Dependencies:
#'
#' `renv` attempts to distinguish between 'development' dependencies and
#' 'runtime' dependencies. For example, you might rely on e.g.
#' [devtools](https://cran.r-project.org/package=devtools) and
#' [roxygen2](https://cran.r-project.org/package=roxygen2) during development
#' for a project, but may not actually require these packages at runtime.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # find R package dependencies in the current directory
#' renv::dependencies()
#'
#' }
dependencies <- function(
  path = getwd(),
  root = NULL,
  ...,
  progress = TRUE,
  errors = c("reported", "fatal", "ignored"),
  dev = FALSE)
{
  renv_scope_error_handler()

  deps <- renv_dependencies_impl(
    path     = path,
    root     = root,
    progress = progress,
    errors   = errors,
    dev      = dev,
    ...
  )

  if (empty(deps) || nrow(deps) == 0L)
    return(renv_dependencies_list_empty())

  # drop NAs, and only keep 'dev' dependencies if requested
  deps <- deps[deps$Dev %in% c(dev, FALSE), ]

  deps
}

renv_dependencies_impl <- function(
  path = getwd(),
  root = NULL,
  ...,
  progress = TRUE,
  errors = c("reported", "fatal", "ignored"),
  dev = FALSE)
{
  # special case: if 'path' is a function, parse its body for dependencies
  if (is.function(path))
    return(renv_dependencies_discover_r(expr = body(path)))

  path <- renv_path_normalize(path, winslash = "/", mustWork = TRUE)
  root <- root %||% renv_dependencies_root(path)

  # ignore errors when testing, unless explicitly asked for
  if (renv_tests_running() && missing(errors))
    errors <- "ignored"

  # resolve errors
  errors <- match.arg(errors)

  # check and see if we've pre-computed dependencies for this path, and
  # retrieve those pre-computed dependencies if so
  if (length(path) == 1)
    if (exists(path, envir = `_renv_dependencies`))
      return(get(path, envir = `_renv_dependencies`))

  renv_dependencies_begin(root = root)
  on.exit(renv_dependencies_end(), add = TRUE)

  dots <- list(...)
  if (identical(dots[["quiet"]], TRUE)) {
    progress <- FALSE
    errors <- "ignored"
  }

  files <- renv_dependencies_find(path, root)
  deps <- renv_dependencies_discover(files, progress, errors)
  renv_dependencies_report(errors)

  deps
}

renv_dependencies_root <- function(path = getwd()) {

  path <- renv_path_normalize(path, winslash = "/", mustWork = TRUE)

  project <- Sys.getenv("RENV_PROJECT", unset = NA)
  if (!is.na(project) && all(renv_path_within(path, project)))
    return(project)

  roots <- uapply(path, renv_dependencies_root_impl)
  if (empty(roots))
    return(NULL)

  uniroot <- unique(roots)
  if (length(uniroot) > 1)
    return(NULL)

  uniroot

}

renv_dependencies_root_impl <- function(path) {

  renv_file_find(path, function(parent) {
    anchors <- c("DESCRIPTION", ".git", ".Rproj.user", "renv.lock", "renv")
    for (anchor in anchors)
      if (file.exists(file.path(parent, anchor)))
        return(parent)
  })

}

renv_dependencies_callback <- function(path) {

  cbname <- list(
    ".Rprofile"     = function(path) renv_dependencies_discover_r(path),
    "DESCRIPTION"   = function(path) renv_dependencies_discover_description(path),
    "_bookdown.yml" = function(path) renv_dependencies_discover_bookdown(path),
    "_pkgdown.yml"  = function(path) renv_dependencies_discover_pkgdown(path),
    "_quarto.yml"   = function(path) renv_dependencies_discover_quarto(path),
    "renv.lock"     = function(path) renv_dependencies_discover_renv_lock(path),
    "rsconnect"     = function(path) renv_dependencies_discover_rsconnect(path)
  )

  cbext <- list(
    ".rproj"       = function(path) renv_dependencies_discover_rproj(path),
    ".r"           = function(path) renv_dependencies_discover_r(path),
    ".qmd"         = function(path) renv_dependencies_discover_multimode(path, "qmd"),
    ".rmd"         = function(path) renv_dependencies_discover_multimode(path, "rmd"),
    ".rmarkdown"   = function(path) renv_dependencies_discover_multimode(path, "rmd"),
    ".rnw"         = function(path) renv_dependencies_discover_multimode(path, "rnw")
  )

  name <- basename(path)
  ext  <- tolower(fileext(path))

  callback <- cbname[[name]] %||% cbext[[ext]]
  if (!is.null(callback))
    return(callback)

  # for files without an extension, check if those might be executable by R
  if (!nzchar(ext)) {
    shebang <- renv_file_shebang(path)
    if (grepl("\\b(?:R|r|Rscript)\\b", shebang))
      return(function(path) renv_dependencies_discover_r(path))
  }

}

renv_dependencies_find_extra <- function(root) {

  # if we don't have a root, we don't have a project
  if (is.null(root))
    return(NULL)

  # only run for root-level dependency checks
  project <- renv_project_resolve()
  if (!renv_path_same(root, project))
    return(NULL)

  # only run if we have a custom profile
  profile <- renv_profile_get()
  if (is.null(profile))
    return(NULL)

  # look for dependencies in the associated 'renv' folder
  path <- renv_paths_renv(project = project)
  renv_dependencies_find_impl(path, root, 0L)

}

renv_dependencies_find <- function(path = getwd(), root = getwd()) {
  files <- lapply(path, renv_dependencies_find_impl, root = root, depth = 0)
  extra <- renv_dependencies_find_extra(root)
  unlist(c(files, extra), recursive = TRUE, use.names = FALSE)
}

renv_dependencies_find_impl <- function(path, root, depth) {

  # check file type
  info <- renv_file_info(path)

  # the file might have been removed after listing -- if so, just ignore it
  if (is.na(info$isdir))
    return(NULL)

  # if this is a directory, recurse
  if (info$isdir)
    return(renv_dependencies_find_dir(path, root, depth))

  # otherwise, check and see if we have a registered callback
  callback <- renv_dependencies_callback(path)
  if (is.function(callback))
    return(path)

}

renv_dependencies_find_dir <- function(path, root, depth) {

  # check if this path should be ignored
  excluded <- renv_renvignore_exec(path, root, path)
  if (excluded)
    return(character())

  # check if we've already scanned this directory
  # (necessary to guard against recursive symlinks)
  if (!renv_platform_windows()) {
    norm <- renv_path_normalize(path, mustWork = FALSE)
    state <- renv_dependencies_state()
    if (visited(norm, state$scanned))
      return(character())
  }

  # list children
  children <- renv_dependencies_find_dir_children(path, root, depth)

  # find recursive dependencies
  depth <- depth + 1
  paths <- map(children, renv_dependencies_find_impl, root = root, depth = depth)

  # explicitly include rsconnect folder
  # (so we can infer a dependency on rsconnect when appropriate)
  rsconnect <- file.path(path, "rsconnect")
  if (file.exists(rsconnect))
    paths <- c(rsconnect, paths)

  paths

}

# return the set of files / subdirectories within a directory that should be
# crawled for dependencies
renv_dependencies_find_dir_children <- function(path, root, depth) {

  # list files in the folder
  children <- renv_file_list(path, full.names = TRUE)

  # remove files which are broken symlinks
  children <- children[file.exists(children)]

  # remove hard-coded ignores
  # (only keep DESCRIPTION files at the top level)
  ignored <- c("renv", "packrat", "revdep", if (depth) "DESCRIPTION")
  children <- children[!basename(children) %in% ignored]

  # compute exclusions
  excluded <- renv_renvignore_exec(path, root, children)

  # keep only non-excluded children
  children[!excluded]

}

renv_dependencies_discover <- function(paths, progress, errors) {

  if (!renv_dependencies_discover_preflight(paths, errors))
    return(invisible(NULL))

  # short path if we're not showing progress
  if (identical(progress, FALSE))
    return(bapply(paths, renv_dependencies_discover_impl))

  # otherwise, run with progress reporting

  # nocov start
  vprintf("Finding R package dependencies ... ")
  callback <- renv_progress_callback(renv_dependencies_discover_impl, length(paths))
  deps <- lapply(paths, callback)
  vwritef("Done!")

  bind(deps)
  # nocov end

}

renv_dependencies_discover_impl <- function(path) {

  callback <- renv_dependencies_callback(path)
  if (is.null(callback)) {
    fmt <- "internal error: no callback registered for file %s"
    warningf(fmt, renv_path_pretty(path))
  }

  result <- tryCatch(callback(path), error = warning)
  if (inherits(result, "condition"))
    return(NULL)

  result

}

renv_dependencies_discover_preflight <- function(paths, errors) {

  if (identical(errors, "ignored"))
    return(TRUE)

  # TODO: worth customizing?
  limit <- 1000L
  if (length(paths) < limit)
    return(TRUE)

  lines <- c(
    "A large number of files (%i in total) have been discovered.",
    "It may take renv a long time to crawl these files for dependencies.",
    "Consider using .renvignore to ignore irrelevant files.",
    "See `?dependencies` for more information.",
    "Set `options(renv.config.dependencies.limit = Inf)` to disable this warning.",
    ""
  )
  vwritef(lines, length(paths))

  if (identical(errors, "reported"))
    return(TRUE)

  if (interactive() && !proceed()) {
    renv_report_user_cancel()
    return(FALSE)
  }

  TRUE

}

renv_dependencies_discover_renv_lock <- function(path) {
  renv_dependencies_list(path, "renv")
}

renv_dependencies_discover_description <- function(path,
                                                   fields = NULL,
                                                   subdir = NULL,
                                                   project = NULL)
{
  dcf <- catch(renv_description_read(path = path, subdir = subdir))
  if (inherits(dcf, "error"))
    return(renv_dependencies_error(path, error = dcf))

  # read fields from project options if available
  fields <-
    fields %||%
    renv_dependencies_discover_description_fields() %||%
    c("Depends", "Imports", "LinkingTo")

  # build pattern used to split DESCRIPTION fields
  pattern <- paste0(
    "([a-zA-Z0-9._]+)",                      # package name
    "(?:\\s*\\(([><=]+)\\s*([0-9.-]+)\\))?"  # optional version specification
  )

  # if this is the DESCRIPTION file for the active project, include
  # Suggests since they're often needed as well. such packages will be
  # considered development dependencies, except for package projects
  type <- "unknown"
  project <-
    project %||%
    renv_dependencies_state(key = "root") %||%
    renv_project_resolve()

  if (renv_path_same(file.path(project, "DESCRIPTION"), path)) {

    # collect profile-specific dependencies as well
    profile <- renv_profile_get()
    field <- if (length(profile))
      sprintf("Config/renv/profiles/%s/dependencies", profile)

    fields <- c(fields, "Suggests", field)
    type <- renv_description_type(desc = dcf)

  }

  data <- lapply(fields, function(field) {

    # read field
    contents <- dcf[[field]]
    if (!is.character(contents))
      return(list())

    # split on commas
    parts <- strsplit(dcf[[field]], "\\s*,\\s*")[[1]]

    # drop any empty fields
    x <- parts[nzchar(parts)]

    # match to split on package name, version
    m <- regexec(pattern, x)
    matches <- regmatches(x, m)
    if (empty(matches))
      return(list())

    # create dependency list
    dev <- field == "Suggests" && type != "package"
    renv_dependencies_list(
      path,
      extract_chr(matches, 2L),
      extract_chr(matches, 3L),
      extract_chr(matches, 4L),
      dev
    )

  })

  bind(data)

}

renv_dependencies_discover_description_fields <- function() {

  # this is all very gross -- the project should be passed
  # along by the caller instead
  project <- NULL

  # are we being called as part of renv::dependencies()?
  # if so, then use the root directory as the project root
  state <- renv_dependencies_state()
  if (!is.null(state))
    project <- state$root

  # are we being called as part of renv::restore()?
  # if so, then use the associated project directory
  state <- renv_restore_state()
  if (!is.null(state))
    project <- state$project

  # all else fails, use the active project
  project <- project %||% renv_project()
  settings$package.dependency.fields(project = project)

}

renv_dependencies_discover_bookdown <- function(path) {
  # TODO: other dependencies to parse from bookdown?
  renv_dependencies_list(path, "bookdown")
}

renv_dependencies_discover_pkgdown <- function(path) {
  # TODO: other dependencies to parse from pkgdown?
  renv_dependencies_list(path, "pkgdown")
}

renv_dependencies_discover_quarto <- function(path) {
  # TODO: other dependencies to parse from quarto?
  #
  # NOTE: we previously inferred a dependency on the R 'quarto' package here,
  # but quarto is normally invoked directly (rather than via the package) and
  # so such a dependency is not strictly necessary.
  #
  # https://github.com/rstudio/renv/issues/995
  renv_dependencies_list_empty()
}

renv_dependencies_discover_rsconnect <- function(path) {
  renv_dependencies_list(path, "rsconnect")
}

renv_dependencies_discover_multimode <- function(path, mode) {

  # TODO: find in-line R code?
  deps <- stack()

  if (mode %in% c("rmd", "qmd"))
    deps$push(renv_dependencies_discover_rmd_yaml_header(path, mode))

  deps$push(renv_dependencies_discover_chunks(path, mode))

  bind(Filter(NROW, deps$data()))

}

renv_dependencies_discover_rmd_yaml_header <- function(path, mode) {

  deps <- stack(mode = "character")

  # R Markdown documents always depend on rmarkdown
  if (identical(mode, "rmd"))
    deps$push("rmarkdown")

  # try and read the document's YAML header
  contents <- renv_file_read(path)
  pattern <- "(?:^|\n)\\s*---\\s*(?:$|\n)"
  matches <- gregexpr(pattern, contents, perl = TRUE)[[1L]]

  # check that we have something that looks like a YAML header
  ok <- length(matches) > 1L && matches[[1L]] == 1L
  if (!ok)
    return(renv_dependencies_list(path, packages = deps$data()))

  # require yaml package for parsing YAML header
  name <- case(
    mode == "rmd" ~ "R Markdown",
    mode == "qmd" ~ "Quarto Markdown"
  )

  # validate that we actually have the yaml package available
  if (!renv_dependencies_require("yaml", name)) {
    packages <- deps$data()
    return(renv_dependencies_list(path, packages))
  }

  # extract YAML text
  yamltext <- substring(contents, matches[[1L]] + 4L, matches[[2L]] - 1L)
  yaml <- catch(renv_yaml_load(yamltext))
  if (inherits(yaml, "error"))
    return(renv_dependencies_error(path, error = yaml, packages = "rmarkdown"))

  # check for Shiny runtime
  runtime <- yaml[["runtime"]] %||% ""
  if (pstring(runtime) && grepl("shiny", runtime, fixed = TRUE))
    deps$push("shiny")

  server <- yaml[["server"]] %||% ""
  if (identical(server, "shiny"))
    deps$push("shiny")

  if (is.list(server) && identical(server[["type"]], "shiny"))
    deps$push("shiny")

  pattern <- renv_regexps_package_name()

  # check recursively for package usages of the form 'package::method'
  recurse(yaml, function(node, stack) {

    # look for keys of the form 'package::method'
    values <- c(names(node), if (pstring(node)) node)
    for (value in values) {
      parts <- strsplit(value, ":{2,3}")[[1L]]
      if (length(parts) == 2L) {
        name <- parts[[1L]]
        if (grepl(pattern, name))
          deps$push(parts[[1L]])
      }
    }

  })

  # check for dependency on bslib
  theme <- catchall(yaml[[c("output", "html_document", "theme")]])
  if (!inherits(theme, "error") && is.list(theme))
    deps$push("bslib")

  # check for parameterized documents
  status <- catch(renv_dependencies_discover_rmd_yaml_header_params(yaml, deps))
  if (inherits(status, "error"))
    renv_error_report(status)

  # get list of dependencies
  packages <- deps$data()
  renv_dependencies_list(path, packages)

}

renv_dependencies_discover_rmd_yaml_header_params <- function(yaml, deps) {

  # check for declared params
  params <- yaml[["params"]]
  if (!is.list(params))
    return()

  # infer dependency on shiny
  deps$push("shiny")

  # iterate through params, parsing dependencies from R code
  for (param in params) {

    # check for r types
    type <- attr(param, "type", exact = TRUE)
    if (!identical(type, "r"))
      next

    # attempt to parse dependencies
    rdeps <- catch(renv_dependencies_discover_r(text = param))
    if (inherits(rdeps, "error"))
      next

    # add each dependency
    for (package in sort(unique(rdeps$Package)))
      deps$push(package)

  }

}

renv_dependencies_discover_chunks_ignore <- function(chunk) {

  # if renv.ignore is set, respect it
  ignore <- chunk$params[["renv.ignore"]]
  if (!is.null(ignore))
    return(truthy(ignore))

  # skip non-R chunks
  engine <- chunk$params[["engine"]]
  ok <- is.character(engine) && engine %in% c("r", "rscript")
  if (!ok)
    return(TRUE)

  # skip un-evaluated chunks
  if (!truthy(chunk$params[["eval"]], default = TRUE))
    return(TRUE)

  # skip learnr exercises
  if (truthy(chunk$params[["exercise"]], default = FALSE))
    return(TRUE)

  # skip chunks whose labels end in '-display'
  label <- chunk$params[["label"]] %||% ""
  if (grepl("-display$", label))
    return(TRUE)

  # ok, don't ignore this chunk
  FALSE

}

renv_dependencies_discover_chunks <- function(path, mode) {

  # figure out the appropriate begin, end patterns
  type <- tolower(tools::file_ext(path))
  if (type %in% c("rmd", "qmd", "rmarkdown"))
    type <- "md"

  allpatterns <- renv_knitr_patterns()
  patterns <- allpatterns[[type]]
  if (is.null(patterns)) {
    condition <- simpleCondition("not a recognized multi-mode R document")
    return(renv_dependencies_error(path, error = condition))
  }

  # parse the chunks within
  # NOTE: we need to proceed line-by-line since the chunk end pattern might
  # end chunks not started by the chunk begin pattern (sad face)
  encoding <- if (type == "md") "UTF-8" else "unknown"
  contents <- readLines(path, warn = FALSE, encoding = encoding)
  ranges <- renv_dependencies_discover_chunks_ranges(path, contents, patterns)

  # extract chunk code from the used ranges
  chunks <- .mapply(function(lhs, rhs) {

    # parse params in header
    header <- contents[[lhs]]
    params <- renv_knitr_options_header(header, type)

    # extract chunk contents (preserve newlines for nicer error reporting)
    range <- seq.int(lhs + 1, length.out = rhs - lhs - 1)
    code <- rep.int("", length(contents))
    code[range] <- contents[range]

    # also parse chunk options
    params <- modifyList(params, renv_knitr_options_chunk(code))

    # return list of outputs
    list(params = params, code = code)

  }, ranges, NULL)

  # iterate over chunks, and attempt to parse dependencies from each
  cdeps <- bapply(chunks, function(chunk) {

    # check whether this chunk should be ignored
    if (renv_dependencies_discover_chunks_ignore(chunk))
      return(character())

    # remove reused chunk placeholders
    pattern <- "<<[^>]+>>"
    code <- gsub(pattern, "", chunk$code)

    # okay, now we can discover deps
    deps <- catch(renv_dependencies_discover_r(path = path, text = code))
    if (inherits(deps, "error"))
      return(renv_dependencies_error(path, error = deps))

    deps

  })

  # check for dependencies in inline chunks as well
  ideps <- renv_dependencies_discover_chunks_inline(path, contents)

  # if this is a .qmd, infer a dependency on rmarkdown if we have any R chunks
  qdeps <- NULL
  if (mode %in% "qmd") {
    for (chunk in chunks) {
      engine <- chunk$params[["engine"]]
      if (is.character(engine) && engine %in% c("r", "rscript")) {
        qdeps <- renv_dependencies_list(path, "rmarkdown")
        break
      }
    }
  }

  # paste them all together
  deps <- bind(list(cdeps, ideps, qdeps))
  if (is.null(deps))
    return(deps)

  deps$Source <- path
  deps

}

renv_dependencies_discover_chunks_inline <- function(path, contents) {

  pasted <- paste(contents, collapse = "\n")
  matches <- gregexpr("`r ([^`]+)`", pasted, perl = TRUE)
  if (identical(c(matches[[1L]]), -1L))
    return(list())

  text <- unlist(regmatches(pasted, matches), use.names = FALSE, recursive = FALSE)
  code <- substring(text, 4L, nchar(text) - 1L)
  deps <- renv_dependencies_discover_r(path = path, text = code)
  if (inherits(deps, "error"))
    return(renv_dependencies_error(path, error = deps))

  deps

}

renv_dependencies_discover_chunks_ranges <- function(path, contents, patterns) {

  output <- list()

  chunk <- FALSE
  start <- 1; end <- 1
  for (i in seq_along(contents)) {

    line <- contents[[i]]

    if (chunk == FALSE && grepl(patterns$chunk.begin, line)) {
      chunk <- TRUE
      start <- i
      next
    }

    if (chunk == TRUE && grepl(patterns$chunk.begin, line)) {
      end <- i
      output[[length(output) + 1]] <- list(lhs = start, rhs = end)
      start <- i
      next
    }

    if (chunk == TRUE && grepl(patterns$chunk.end, line)) {
      chunk <- FALSE
      end <- i
      output[[length(output) + 1]] <- list(lhs = start, rhs = end)
      next
    }

  }

  if (chunk) {
    message <- sprintf("chunk starting on line %i is not closed", start)
    error <- simpleError(message)
    renv_dependencies_error(path, error = error)
  }

  bind(output)

}

renv_dependencies_discover_rproj <- function(path) {

  props <- renv_properties_read(path)

  deps <- stack()
  if (identical(props$PackageUseDevtools, "Yes")) {
    deps$push("devtools")
    deps$push("roxygen2")
  }

  renv_dependencies_list(path, deps$data(), dev = TRUE)

}

renv_dependencies_discover_r <- function(path = NULL,
                                         text = NULL,
                                         expr = NULL,
                                         envir = NULL)
{
  expr <- case(
    is.function(expr)  ~ body(expr),
    is.language(expr)  ~ expr,
    is.character(expr) ~ catch(renv_parse_text(expr)),
    is.character(text) ~ catch(renv_parse_text(text)),
    is.character(path) ~ catch(renv_parse_file(path)),
    ~ stop("internal error")
  )

  if (inherits(expr, "error"))
    return(renv_dependencies_error(path, error = expr))

  # update current path
  state <- renv_dependencies_state()
  if (!is.null(state))
    renv_scope_var("path", path, envir = state)

  methods <- c(
    renv_dependencies_discover_r_methods,
    renv_dependencies_discover_r_xfun,
    renv_dependencies_discover_r_library_require,
    renv_dependencies_discover_r_require_namespace,
    renv_dependencies_discover_r_colon,
    renv_dependencies_discover_r_pacman,
    renv_dependencies_discover_r_modules,
    renv_dependencies_discover_r_import,
    renv_dependencies_discover_r_box,
    renv_dependencies_discover_r_targets,
    renv_dependencies_discover_r_glue,
    renv_dependencies_discover_r_parsnip,
    renv_dependencies_discover_r_database
  )

  envir <- envir %||% new.env(parent = emptyenv())
  recurse(expr, function(node, stack) {

    # normalize calls (handle magrittr pipes)
    node <- renv_call_normalize(node, stack)

    # invoke methods on call objects
    if (is.call(node))
      for (method in methods)
        method(node, stack, envir)

    # return node
    node

  })

  packages <- ls(envir = envir, all.names = TRUE)
  renv_dependencies_list(path, packages)
}

renv_dependencies_discover_r_methods <- function(node, stack, envir) {

  node <- renv_call_expect(node, "methods", c("setClass", "setGeneric"))
  if (is.null(node))
    return(FALSE)

  envir[["methods"]] <- TRUE
  TRUE

}

renv_dependencies_discover_r_xfun <- function(node, stack, envir) {

  node <- renv_call_expect(node, "xfun", c("pkg_attach", "pkg_attach2"))
  if (is.null(node))
    return(FALSE)

  # attempt to match the call
  prototype <- function(..., install = FALSE, message = TRUE) {}
  matched <- catch(match.call(prototype, node, expand.dots = FALSE))
  if (inherits(matched, "error"))
    return(FALSE)

  # extract character vectors from `...`
  strings <- stack()
  recurse(matched[["..."]], function(node, stack) {
    if (is.character(node))
      strings$push(node)
  })

  # mark packages as known
  packages <- strings$data()
  if (empty(packages))
    return(FALSE)

  for (package in packages)
    envir[[package]] <- TRUE

  TRUE
}

renv_dependencies_discover_r_library_require <- function(node, stack, envir) {

  node <- renv_call_expect(node, "base", c("library", "require"))
  if (is.null(node))
    return(FALSE)

  # attempt to match the call
  matched <- catch(match.call(base::library, node))
  if (inherits(matched, "error"))
    return(FALSE)

  # if the 'package' argument is a character vector of length one, we're done
  if (is.character(matched$package) &&
      length(matched$package) == 1)
  {
    envir[[matched$package]] <- TRUE
    return(TRUE)
  }

  # if it's a symbol, double check character.only argument
  if (is.symbol(matched$package) &&
      identical(matched$character.only %||% FALSE, FALSE))
  {
    envir[[as.character(matched$package)]] <- TRUE
    return(TRUE)
  }

  FALSE

}

renv_dependencies_discover_r_require_namespace <- function(node, stack, envir) {

  node <- renv_call_expect(node, "base", c("requireNamespace", "loadNamespace"))
  if (is.null(node))
    return(FALSE)

  f <- get(as.character(node[[1]]), envir = .BaseNamespaceEnv, inherits = FALSE)
  matched <- catch(match.call(f, node))
  if (inherits(matched, "error"))
    return(FALSE)

  package <- matched$package
  if (is.character(package) && length(package == 1)) {
    envir[[package]] <- TRUE
    return(TRUE)
  }

  FALSE


}

renv_dependencies_discover_r_colon <- function(node, stack, envir) {

  ok <-
    is.call(node) &&
    length(node) == 3 &&
    is.name(node[[1]]) &&
    as.character(node[[1]]) %in% c("::", ":::")

  if (!ok)
    return(FALSE)

  package <- node[[2L]]
  if (is.symbol(package))
    package <- as.character(package)

  if (!is.character(package) || length(package) != 1)
    return(FALSE)

  envir[[package]] <- TRUE
  TRUE

}

renv_dependencies_discover_r_pacman <- function(node, stack, envir) {

  node <- renv_call_expect(node, "pacman", "p_load")
  if (is.null(node) || length(node) < 2)
    return(FALSE)

  # check for character.only
  chonly <- node[["character.only"]] %||% FALSE

  # consider all unnamed arguments
  parts <- as.list(node[-1L])

  # consider packages passed to 'char' parameter
  char <- node[["char"]]

  # detect vector of packages passed as vector
  if (is.call(char) && identical(char[[1L]], as.name("c")))
    parts <- c(parts, as.list(char[-1L]))

  # detect plain old package name
  if (is.character(char))
    parts <- c(parts, as.list(char))

  # ensure names
  names(parts) <- names(parts) %||% rep.int("", length(parts))
  unnamed <- parts[!nzchar(names(parts))]

  # extract symbols / characters
  for (arg in unnamed) {

    # skip symbols if necessary
    if (chonly && is.symbol(arg))
      next

    # check for character or symbol
    ok <-
      length(arg) == 1 &&
      is.character(arg) ||
      is.symbol(arg)

    if (!ok)
      next

    # add it
    envir[[as.character(arg)]] <- TRUE

  }

  TRUE

}

renv_dependencies_discover_r_modules <- function(node, stack, envir) {

  # check for call of the form 'pkg::foo(a, b, c)'
  colon <-
    is.call(node[[1L]]) &&
    is.name(node[[1L]][[1L]]) &&
    as.character(node[[1L]][[1L]]) %in% c("::", ":::")

  node <- renv_call_expect(node, "modules", c("import"))
  if (is.null(node))
    return(FALSE)

  ok <- FALSE
  if (colon) {
    # include if fully qualified call to modules::import
    ok <- TRUE
  } else {
    # otherwise only consider calls within a 'module' block
    # (to reduce confusion with reticulate::import)
    for (parent in stack) {
      parent <- renv_call_expect(parent, "modules", c("amodule", "module"))
      if (!is.null(parent)) {
        ok <- TRUE
        break
      }
    }
  }

  if (!ok)
    return(FALSE)

  # attempt to match the call
  prototype <- function(from, ..., attach = TRUE, where = parent.frame()) {}
  matched <- catch(match.call(prototype, node, expand.dots = FALSE))
  if (inherits(matched, "error"))
    return(FALSE)

  # extract character vector or symbol from `from`
  package <- matched[["from"]]
  if (empty(package))
    return(FALSE)

  # package could be symbols or character so call as.character
  # to be safe then mark packages as known
  envir[[as.character(package)]] <- TRUE

  TRUE
}

renv_dependencies_discover_r_import <- function(node, stack, envir) {

  node <- renv_call_expect(node, "import", c("from", "here", "into"))
  if (is.null(node))
    return(FALSE)

  # attempt to match the call
  name <- as.character(node[[1L]])
  matched <- if (name == "from") {
    catch(match.call(function(.from, ...) {}, node, expand.dots = FALSE))
  } else {
    catch(match.call(function(..., .from) {}, node, expand.dots = FALSE))
  }

  if (inherits(matched, "error"))
    return(FALSE)

  # the '.from' argument is the package name, either a character vector of length one or a symbol
  from <- matched$.from
  if (is.symbol(from))
    from <- as.character(from)

  ok <-
    is.character(from) &&
    length(from) == 1

  if (!ok)
    return(FALSE)

  envir[[from]] <- TRUE
  TRUE

}

renv_dependencies_discover_r_box <- function(node, stack, envir) {

  node <- renv_call_expect(node, "box", "use")
  if (is.null(node))
    return(FALSE)

  for (i in seq.int(2L, length.out = length(node) - 1L))
    renv_dependencies_discover_r_box_impl(node[[i]], stack, envir)

  TRUE

}

renv_dependencies_discover_r_box_impl <- function(node, stack, envir) {

  # if the node is just a symbol, then it's the name of a package
  # otherwise, if it's a call to `[`, the first argument is the package name
  name <- if (is.symbol(node) && !identical(node, quote(expr = ))) {
    as.character(node)
  } else if (
    is.call(node) &&
      length(node) > 1L &&
      identical(node[[1L]], as.name("[")) &&
      is.symbol(node[[2L]])) {
    as.character(node[[2L]])
  }

  # the names `.` and `..` are special place holders and don't refer to packages
  if (is.null(name) || name == "." || name == "..")
    return(FALSE)

  envir[[name]] <- TRUE
  TRUE

}

renv_dependencies_discover_r_targets <- function(node, stack, envir) {

  node <- renv_call_expect(node, "targets", "tar_option_set")
  if (is.null(node))
    return(FALSE)

  envir[["targets"]] <- TRUE

  packages <- tryCatch(
    renv_dependencies_eval(node$packages),
    error = identity
  )

  # TODO: evaluation can fail for a multitude of reasons;
  # are any of these worth signalling to the user?
  if (inherits(packages, "error"))
    return(TRUE)

  if (is.character(packages))
    for (package in packages)
      envir[[package]] <- TRUE

  TRUE

}

renv_dependencies_discover_r_glue <- function(node, stack, envir) {

  node <- renv_call_expect(node, "glue", "glue")
  if (is.null(node))
    return(FALSE)

  # analyze all unnamed strings in the call
  args <- as.list(node)[-1L]
  nm <- names(args) %||% rep.int("", length(args))
  strings <- args[!nzchar(nm) & map_lgl(args, is.character)]

  # start iterating through the strings, looking for code chunks
  for (string in strings)
    renv_dependencies_discover_r_glue_impl(string, node, envir)

  TRUE

}

renv_dependencies_discover_r_glue_impl <- function(string, node, envir) {

  # get open, close delimiters
  ropen    <- charToRaw(node$.open    %||% "{")
  rclose   <- charToRaw(node$.close   %||% "}")
  rcomment <- charToRaw(node$.comment %||% "#")

  # constants
  rcomment   <- charToRaw("#")
  rbackslash <- charToRaw("\\")
  rquotes <- c(
    charToRaw("'"),
    charToRaw("\""),
    charToRaw("`")
  )

  # iterate through characters in string
  raw <- c(charToRaw(string), as.raw(0L))
  i <- 0L
  n <- length(raw)
  quote <- raw()

  # index for open delimiter match
  index <- 0L
  count <- 0L

  while (i < n) {

    # ensure we always advance index
    i <- i + 1L

    # handle quoted states
    if (length(quote)) {

      # skip escaped characters
      if (raw[[i]] == rbackslash) {
        i <- i + 1L
        next
      }

      # check for escape from quote
      if (raw[[i]] == quote) {
        quote <- raw()
        next
      }

    }

    # skip comments
    if (raw[[i]] == rcomment) {
      i <- grepRaw("(?:$|\n)", raw, i)
      next
    }

    # skip escaped characters
    if (raw[[i]] == rbackslash) {
      i <- i + 1L
      next
    }

    # check for quotes
    idx <- match(raw[[i]], rquotes, nomatch = 0L)
    if (idx > 0) {
      quote <- rquotes[[idx]]
      next
    }

    # check for open delimiter
    if (i %in% grepRaw(ropen, raw, i, fixed = TRUE)) {

      # check for duplicate (escape)
      j <- i + length(ropen)
      if (j %in% grepRaw(ropen, raw, j, fixed = TRUE)) {
        i <- j + length(ropen) - 1L
        next
      }

      # save index if we're starting a match
      if (count == 0L) {
        index <- i
      }

      # increment match count
      count <- count + 1L
      next

    }

    # check for close delimiter
    if (i %in% grepRaw(rclose, raw, i, fixed = TRUE)) {

      # check for duplicate (escape)
      j <- i + length(rclose)
      if (j %in% grepRaw(rclose, raw, j, fixed = TRUE)) {
        i <- j + length(rclose) - 1L
        next
      }

      if (count > 0L) {

        # decrement count if we have a match
        count <- count - 1L

        # check for match and parse dependencies within
        if (count == 0L) {

          # extract inner code
          lhs <- index + length(ropen)
          rhs <- i - 1L
          code <- rawToChar(raw[lhs:rhs])

          # parse dependencies
          renv_dependencies_discover_r(text = code, envir = envir)

        }

      }

    }

  }

}

renv_dependencies_discover_r_parsnip <- function(node, stack, envir) {

  node <- renv_call_expect(node, "parsnip", "set_engine")
  if (is.null(node))
    return(FALSE)

  matched <- catch(match.call(function(object, engine, ...) {}, node))
  if (inherits(matched, "error"))
    return(FALSE)

  engine <- matched$engine
  if (!is.character(engine) || length(engine) != 1L)
    return(FALSE)

  map <- getOption("renv.parsnip.engines", default = list(
    glm    = "stats",
    glmnet = "glmnet",
    keras  = "keras",
    kknn   = "kknn",
    nnet   = "nnet",
    rpart  = "rpart",
    spark  = "sparklyr",
    stan   = "rstanarm"
  ))

  packages <- if (is.function(map))
    tryCatch(map(engine), error = function(e) NULL)
  else
    map[[engine]]

  if (is.null(packages))
    return(FALSE)

  for (package in packages)
    envir[[package]] <- TRUE

  # TODO: a number of model routines appear to depend on dials;
  # should we just assume it's required by default? or should
  # users normally be using tidymodels instead of parsnip directly?
  TRUE

}

renv_dependencies_discover_r_database <- function(node, stack, envir) {

  found <- FALSE

  db <- renv_dependencies_database()
  enumerate(db, function(package, dependencies) {
    enumerate(dependencies, function(method, requirements) {

      expect <- renv_call_expect(node, package, method)
      if (is.null(expect))
        return(FALSE)

      for (requirement in requirements)
        envir[[requirement]] <- TRUE

      found <<- TRUE
      TRUE

    })
  })

  found

}

renv_dependencies_database <- function() {
  # TODO: make this user-accessible?
  renv_global(
    "dependencies.database",
    renv_dependencies_database_impl()
  )
}

renv_dependencies_database_impl <- function() {

  db <- list()

  db$ggplot2 <- list(
    geom_hex = "hexbin"
  )

  db

}

renv_dependencies_list <- function(source,
                                   packages,
                                   require = "",
                                   version = "",
                                   dev = FALSE)
{
  if (empty(packages))
    return(renv_dependencies_list_empty())

  source <- source %||% rep.int(NA_character_, length(packages))

  data.frame(
    Source  = as.character(source),
    Package = as.character(packages),
    Require = require,
    Version = version,
    Dev     = dev,
    stringsAsFactors = FALSE
  )

}

renv_dependencies_list_empty <- function() {

  data.frame(
    Source  = character(),
    Package = character(),
    Require = character(),
    Version = character(),
    Dev     = logical(),
    stringsAsFactors = FALSE
  )

}

renv_dependencies_require <- function(package, type) {

  if (requireNamespace(package, quietly = TRUE))
    return(TRUE)

  if (once()) {

    fmt <- lines(
      "The '%1$s' package is required to parse dependencies within %2$s files.",
      "Consider installing it with `install.packages(\"%1$s\")`."
    )

    msg <- sprintf(fmt, package, type)
      warning(msg, call. = FALSE)

  }

  return(FALSE)

}

renv_dependencies_state <- function(key = NULL) {
  state <- renv_global_get("dependencies.state")
  if (is.null(key)) state else state[[key]]
}

renv_dependencies_begin <- function(root = NULL) {
  state <- env(root = root, scanned = env(), problems = stack())
  renv_global_set("dependencies.state", state)
}

renv_dependencies_end <- function() {
  renv_global_clear("dependencies.state")
}

renv_dependencies_error <- function(path, error = NULL, packages = NULL) {

  # if no error, return early
  if (is.null(error))
    return(renv_dependencies_list(path, packages))

  # check for missing state (e.g. if internal method called directly)
  state <- renv_dependencies_state()
  if (!is.null(state)) {
    path <- path %||% state$path
    problem <- list(file = path, error = error)
    state$problems$push(problem)
  }

  # return dependency list
  renv_dependencies_list(path, packages)

}

renv_dependencies_report <- function(errors) {

  if (identical(errors, "ignored"))
    return(FALSE)

  state <- renv_dependencies_state()
  if (is.null(state))
    return(FALSE)

  problems <- state$problems$data()
  if (empty(problems))
    return(TRUE)

  ewritef("WARNING: One or more problems were discovered while enumerating dependencies.\n")

  # bind into list
  bound <- bapply(problems, function(problem) {
    fields <- c(aliased_path(problem$file), problem$line, problem$column)
    header <- paste(fields, collapse = ":")
    message <- conditionMessage(problem$error)
    c(file = problem$file, header = header, message = message)
  })

  # split based on header (group errors from same file)
  splat <- split(bound, bound$file)

  # emit messages
  enumerate(splat, function(file, problem) {
    lines <- paste(rep.int("-", nchar(file)), collapse = "")
    prefix <- format(paste("ERROR", seq_along(problem$message)))
    messages <- paste(prefix, problem$message, sep = ": ", collapse = "\n\n")
    text <- c(file, lines, "", messages, "")
    ewritef(text)
  })

  ewritef("Please see `?renv::dependencies` for more information.")

  if (identical(errors, "fatal")) {
    fmt <- "one or more errors occurred while enumerating dependencies"
    stopf(fmt)
  }

  renv_condition_signal("renv.dependencies.error", problems)
  TRUE

}

renv_dependencies_scope <- function(path, action, .envir = NULL) {

  path <- renv_path_normalize(path, winslash = "/", mustWork = TRUE)
  if (exists(path, envir = `_renv_dependencies`))
    return(get(path, envir = `_renv_dependencies`))

  errors <- config$dependency.errors()
  message <- paste(action, "aborted")

  deps <- withCallingHandlers(
    dependencies(path, progress = FALSE, errors = errors, dev = TRUE),
    renv.dependencies.error = renv_dependencies_error_handler(message, errors)
  )

  assign(path, deps, envir = `_renv_dependencies`)

  envir <- .envir %||% parent.frame()
  defer(rm(list = path, envir = `_renv_dependencies`), envir = envir)

  invisible(deps)

}

renv_dependencies_error_handler <- function(message, errors) {

  force(message)
  force(errors)

  function(condition) {

    if (identical(errors, "fatal") || interactive() && !proceed()) {

      condition <- structure(
        list(message = message, call = NULL, traceback = FALSE),
        class = c("renv.dependencies.error", "error", "condition")
      )

      stop(condition)

    }

    renv_condition_data(condition)

  }
}

renv_dependencies_eval <- function(expr) {

  # create environment with small subset of symbols
  syms <- c("list", "c")
  vals <- mget(syms, envir = baseenv())
  envir <- list2env(vals, parent = emptyenv())

  # evaluate in that environment
  eval(expr, envir = envir)

}

renv_description_read <- function(path = NULL, package = NULL, subdir = NULL, ...) {

  # if given a package name, construct path to that package
  path <- path %||% find.package(package)
  if (!file.exists(path)) {
    fmt <- "%s does not exist"
    stopf(fmt, renv_path_pretty(path))
  }

  # normalize non-absolute paths
  if (!renv_path_absolute(path))
    path <- renv_path_normalize(path)

  # if 'path' refers to a directory, try to resolve the DESCRIPTION file
  info <- renv_file_info(path)
  if (identical(info$isdir, TRUE)) {
    components <- c(path, if (nzchar(subdir %||% "")) subdir, "DESCRIPTION")
    path <- paste(components, collapse = "/")
  }

  # read value with filebacked cache
  filebacked(
    scope    = "DESCRIPTION",
    path     = path,
    callback = renv_description_read_impl,
    subdir   = subdir,
    ...
  )

}

renv_description_read_impl <- function(path = NULL, subdir = NULL, ...) {

  # if we have an archive, attempt to unpack the DESCRIPTION
  type <- renv_archive_type(path)
  if (type != "unknown") {

    # list files within the archive
    files <- renv_archive_list(path)

    # find the DESCRIPTION file. note that for some source tarballs (e.g.
    # those from GitHub) the first entry may not be the package name, so
    # just consume everything up to the first slash
    subdir <- subdir %||% ""
    parts <- c("^[^/]+", if (nzchar(subdir)) subdir, "DESCRIPTION$")
    pattern <- paste(parts, collapse = "/")

    descs <- grep(pattern, files, value = TRUE)
    if (empty(descs)) {
      fmt <- "archive '%s' does not appear to contain a DESCRIPTION file"
      stopf(fmt, aliased_path(path))
    }

    # choose the shortest DESCRPITION file matching
    # unpack into tempdir location
    file <- descs[[1]]
    exdir <- renv_scope_tempfile("renv-description-")
    renv_archive_decompress(path, files = file, exdir = exdir)

    # update path to extracted DESCRIPTION
    path <- file.path(exdir, file)

  }

  # read DESCRIPTION as dcf
  dcf <- renv_dcf_read(path, ...)
  if (empty(dcf))
    stopf("DESCRIPTION file at '%s' is empty", path)

  dcf

}

renv_description_path <- function(path) {
  childpath <- file.path(path, "DESCRIPTION")
  indirect <- file.exists(childpath)
  path[indirect] <- childpath[indirect]
  path
}

renv_description_type <- function(path = NULL, desc = NULL) {

  # read DESCRIPTION file when 'desc' not explicitly supplied
  if (is.null(desc)) {

    # read DESCRIPTION file
    desc <- catch(renv_description_read(path))
    if (inherits(desc, "error")) {
      warning(desc)
      return("unknown")
    }

  }

  # check for explicitly recorded type
  type <- desc$Type
  if (!is.null(type))
    return(tolower(type))

  # infer otherwise from 'Package' field otherwise
  package <- desc$Package
  if (!is.null(package))
    return("package")

  # default to unknown
  "unknown"

}

# parse the dependency requirements normally presented in
# Depends, Imports, Suggests, and so on
renv_description_parse_field <- function(field) {

  # check for invalid / unexpected inputs
  if (is.na(field) || !nzchar(field))
    return(data.frame())

  pattern <- paste0(
    "([a-zA-Z0-9._]+)",                      # package name
    "(?:\\s*\\(([><=]+)\\s*([0-9.-]+)\\))?"  # optional version specification
  )

  # split on commas
  parts <- strsplit(field, "\\s*,\\s*")[[1]]

  # drop any empty fields
  x <- parts[nzchar(parts)]

  # match to split on package name, version
  m <- regexec(pattern, x)
  matches <- regmatches(x, m)
  if (empty(matches))
    return(data.frame())

  data.frame(
    Package = extract_chr(matches, 2L),
    Require = extract_chr(matches, 3L),
    Version = extract_chr(matches, 4L),
    stringsAsFactors = FALSE
  )

}

renv_description_remotes <- function(descpath) {

  # read Remotes field from DESCRIPTION
  desc <- renv_description_read(path = descpath)
  remotes <- desc[["Remotes"]]
  if (is.null(remotes))
    return(NULL)

  # parse each remote entry
  entries <- strsplit(remotes, "\\s*,\\s*", perl = TRUE)[[1L]]
  parsed <- map(entries, renv_description_remotes_parse)

  # ensure named
  names(parsed) <- map_chr(parsed, `[[`, "Package")

  # and return
  parsed

}

renv_description_remotes_parse <- function(entry) {

  status <- catch(renv_remotes_resolve(entry))

  if (inherits(status, "error")) {
    fmt <- "failed to resolve remote '%s' from project DESCRIPTION file; skipping"
    warningf(fmt, entry)
    return(NULL)
  }

  status

}

renv_description_resolve <- function(path) {

  case(
    is.list(path)      ~ path,
    is.character(path) ~ renv_description_read(path = path)
  )

}

renv_description_built_version <- function(desc = NULL) {

  desc <- renv_description_resolve(desc)

  built <- desc[["Built"]]
  if (is.null(built))
    return(NA)

  substring(built, 3L, regexpr(";", built, fixed = TRUE) - 1L)
}

#' Print a Diagnostics Report
#'
#' Print a diagnostics report, summarizing the state of a project using `renv`.
#' This report can occasionally be useful when diagnosing issues with `renv`.
#'
#' @inheritParams renv-params
#'
#' @return This function is normally called for its side effects.
#'
#' @export
diagnostics <- function(project = NULL) {

  renv_scope_error_handler()

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  if (renv_file_type(project, symlinks = FALSE) != "directory") {
    fmt <- "project %s is not a directory"
    stopf(fmt, renv_path_pretty(project))
  }

  renv_scope_options(renv.verbose = TRUE)

  reporters <- list(
    renv_diagnostics_session,
    renv_diagnostics_project,
    renv_diagnostics_status,
    renv_diagnostics_packages,
    renv_diagnostics_abi,
    renv_diagnostics_profile,
    renv_diagnostics_settings,
    renv_diagnostics_options,
    renv_diagnostics_envvars,
    renv_diagnostics_path,
    renv_diagnostics_cache
  )

  fmt <- "Diagnostics Report [renv %s]"
  title <- sprintf(fmt, renv_package_version("renv"))
  lines <- paste(rep.int("=", nchar(title)), collapse = "")
  vwritef(c(title, lines, ""))

  for (reporter in reporters) {
    tryCatch(reporter(project), error = renv_error_handler)
    vwritef()
  }

}

renv_diagnostics_session <- function(project) {
  vwritef(header("Session Info"))
  renv_scope_options(width = 80)
  print(sessionInfo())
}

renv_diagnostics_project <- function(project) {
  vwritef(header("Project"))
  vwritef("Project path: %s", renv_path_pretty(project))
}

renv_diagnostics_status <- function(project) {
  vwritef(header("Status"))
  status(project = project)
}

renv_diagnostics_packages <- function(project) {

  vwritef(header("Packages"))

  # collect state of lockfile, library, dependencies
  lockfile <- renv_diagnostics_packages_lockfile(project)
  libstate <- renv_diagnostics_packages_library(project)
  used <- unique(renv_diagnostics_packages_dependencies(project)$Package)

  # collect recursive package dependencies
  recdeps <- renv_package_dependencies(
    packages = used,
    project  = project
  )

  # bundle together
  all <- c(
    names(lockfile$Packages),
    names(libstate$Packages),
    names(recdeps),
    used
  )

  # sort
  renv_scope_locale(category = "LC_COLLATE", locale = "C")
  all <- sort(unique(all))

  # check which packages are direct, indirect requirements
  deps <- rep.int(NA_character_, length(all))
  names(deps) <- all
  deps[names(recdeps)] <- "indirect"
  deps[used] <- "direct"

  # build libpaths for installed packages
  libpaths <- dirname(map_chr(all, renv_package_find))

  # use short form
  flibpaths <- factor(libpaths, levels = .libPaths())

  # construct integer codes (to be reported in data output)
  libcodes <- as.integer(flibpaths)
  libcodes[!is.na(libcodes)] <- sprintf("[%i]", libcodes[!is.na(libcodes)])

  # add in packages in library
  data <- data.frame(

    Library    = renv_diagnostics_packages_version(libstate, all),
    Source     = renv_diagnostics_packages_sources(libstate, all),
    Lockfile   = renv_diagnostics_packages_version(lockfile, all),
    Source     = renv_diagnostics_packages_sources(lockfile, all),
    Path       = libcodes,
    Dependency = deps,

    stringsAsFactors = FALSE,
    check.names      = FALSE

  )

  # print it out
  renv_scope_options(width = 9000)
  print(data)

  # print library codes
  fmt <- "[%s]: %s"
  vwritef()
  vwritef(fmt, format(seq_along(levels(flibpaths))), format(levels(flibpaths)))

}

renv_diagnostics_packages_version <- function(lockfile, all) {

  data <- rep.int(NA_character_, length(all))
  names(data) <- all

  formatted <- map_chr(lockfile$Packages, `[[`, "Version")
  data[names(formatted)] <- formatted

  data

}

renv_diagnostics_packages_sources <- function(lockfile, all) {

  data <- rep.int(NA_character_, length(all))
  names(data) <- all

  sources <- map_chr(lockfile$Packages, function(record) {
    record$Repository %||% record$Source %||% "<unknown>"
  })

  data[names(sources)] <- sources
  data

}

renv_diagnostics_packages_lockfile <- function(project) {

  lockpath <- renv_lockfile_path(project = project)
  if (!file.exists(lockpath)) {
    vwritef("This project has not yet been snapshotted: 'renv.lock' does not exist.")
    return(list())
  }

  renv_lockfile_read(lockpath)

}

renv_diagnostics_packages_library <- function(project) {

  library <- renv_paths_library(project = project)
  if (!file.exists(library)) {
    fmt <- "The project library %s does not exist."
    vwritef(fmt, renv_path_pretty(library))
  }

  snapshot(project = project, lockfile = NULL, type = "all")

}

renv_diagnostics_packages_dependencies <- function(project) {

  dependencies(project,
               progress = FALSE,
               errors = "reported",
               dev = TRUE)

}

renv_diagnostics_abi <- function(project) {

  vwritef(header("ABI"))
  tryCatch(
    renv_abi_check(),
    error = function(e) {
      vwritef(conditionMessage(e))
    }
  )

}

renv_diagnostics_profile <- function(project) {

  vwritef(header("User Profile"))

  userprofile <- "~/.Rprofile"
  if (!file.exists(userprofile))
    return(vwritef("[no user profile detected]"))

  deps <- dependencies(userprofile,
                       progress = FALSE,
                       errors = "reported",
                       dev = TRUE)

  if (empty(deps))
    return(vwritef("[no R packages referenced in user profile"))

  renv_scope_options(width = 200)
  print(deps)

}

renv_diagnostics_settings <- function(project) {
  vwritef(header("Settings"))
  str(renv_settings_get(project))
}

renv_diagnostics_options <- function(project) {

  vwritef(header("Options"))

  keys <- c(
    "defaultPackages",
    "download.file.method",
    "download.file.extra",
    "install.packages.compile.from.source",
    "pkgType",
    "repos",
    grep("^renv[.]", names(.Options), value = TRUE)
  )

  vals <- .Options[keys]
  names(vals) <- keys

  str(vals)

}

renv_diagnostics_envvars <- function(project) {

  vwritef(header("Environment Variables"))

  envvars <- convert(as.list(Sys.getenv()), "character")

  useful <- c(
    "R_LIBS_USER", "R_LIBS_SITE", "R_LIBS",
    "HOME", "LANG", "MAKE",
    grep("^RENV_", names(envvars), value = TRUE)
  )

  matches <- envvars[useful]
  if (empty(matches))
    return(vwritef("[no renv environment variables available]"))

  names(matches) <- useful
  matches[is.na(matches)] <- "<NA>"
  matches <- matches[order(names(matches))]

  keys <- names(matches)
  vals <- matches
  formatted <- paste(format(keys), vals, sep = " = ")
  vwritef(formatted)

}

renv_diagnostics_path <- function(project) {
  vwritef(header("PATH"))
  path <- strsplit(Sys.getenv("PATH"), .Platform$path.sep, fixed = TRUE)[[1]]
  vwritef(paste("-", path))
}

renv_diagnostics_cache <- function(project) {

  vwritef(header("Cache"))

  fmt <- "There are a total of %i package(s) installed in the renv cache."
  cachelist <- renv_cache_list()
  vwritef(fmt, length(cachelist))
  vwritef("Cache path: %s", renv_path_pretty(renv_paths_cache()))

}

renv_difftime_format <- function(time, digits = 2L) {

  units <- attr(time, "units") %||% ""
  if (units == "secs" && time < 0.1) {
    time  <- time * 1000
    units <- "milliseconds"
  }

  units <- switch(
    units,
    secs  = "seconds",
    mins  = "minutes",
    hours = "hours",
    days  = "days",
    weeks = "weeks",
    units
  )

  elapsed <- format(unclass(signif(time, digits = digits)))
  paste(elapsed, units)

}

renv_difftime_format_short <- function(time, digits = 2L) {

  elapsed <- signif(time, digits = digits)
  if (nchar(elapsed) == 1L)
    elapsed <- paste(elapsed, ".0", sep = "")

  units <- switch(
    attr(time, "units"),
    secs  = "s",
    mins  = "m",
    hours = "h",
    days  = "d",
    weeks = "w"
  )

  paste(elapsed, units, sep = "")

}

renv_dots_check <- function(...) {

  dots <- list(...)

  # allow 'confirm' as an alias for 'prompt'
  confirm <- dots[["confirm"]]
  if (!is.null(confirm) && exists("prompt", envir = parent.frame())) {
    assign("prompt", confirm, envir = parent.frame())
    dots[["confirm"]] <- NULL
  }

  if (length(dots) == 0)
    return(TRUE)

  call <- sys.call(sys.parent())
  func <- sys.function(sys.parent())
  matched <- match.call(func, call, expand.dots = FALSE)

  dotcall <- format(matched["..."])
  start <- regexpr("(", dotcall, fixed = TRUE)
  end <- nchar(dotcall) - 2L
  args <- substring(dotcall, start, end)

  message <- paste(
    "unused",
    plural("argument", length(matched[["..."]])),
    args
  )

  err <- simpleError(message = message, call = call)
  stop(err)

}

# download a file from 'url' to file 'destfile'. the 'type'
# argument tells us the remote type, which is used to motivate
# what form of authentication is appropriate; the 'quiet'
# argument is used to display / suppress output. use 'headers'
# (as a named character vector) to supply additional headers
download <- function(url, destfile, type = NULL, quiet = FALSE, headers = NULL) {

  # allow for user-defined overrides
  override <- getOption("renv.download.override")
  if (is.function(override)) {

    result <- catch(
      override(
        url      = url,
        destfile = destfile,
        quiet    = quiet,
        mode     = "wb",
        headers  = headers
      )
    )

    if (inherits(result, "error"))
      renv_download_error(result, "%s", conditionMessage(result))

    if (!file.exists(destfile))
      renv_download_error(url, "%s does not exist", renv_path_pretty(destfile))

    return(destfile)

  }

  if (quiet)
    renv_scope_options(renv.verbose = FALSE)

  # normalize separators (file URIs should normally use forward
  # slashes, even on Windows where the native separator is backslash)
  url      <- chartr("\\", "/", url)
  destfile <- chartr("\\", "/", destfile)

  # notify user we're about to try downloading
  vwritef("Retrieving '%s' ...", url)

  # add custom headers as appropriate for the URL
  headers <- c(headers, renv_download_custom_headers(url))

  # handle local files by just copying the file
  if (renv_download_local(url, destfile, headers))
    return(destfile)

  # on Windows, try using our local curl binary if available
  renv_scope_downloader()

  # if the file already exists, compare its size with
  # the server's reported size for that file
  info <- renv_file_info(destfile)
  if (identical(info$isdir, FALSE)) {
    size <- renv_download_size(url, type, headers)
    if (info$size == size) {
      vwritef("\tOK [file is up to date]")
      return(destfile)
    }
  }

  # back up a pre-existing file if necessary
  callback <- renv_file_backup(destfile)
  on.exit(callback(), add = TRUE)

  # form path to temporary file
  tempfile <- renv_scope_tempfile(tmpdir = dirname(destfile))

  # request the download
  before <- Sys.time()

  status <- renv_download_impl(
    url      = url,
    destfile = tempfile,
    type     = type,
    request  = "GET",
    headers  = headers
  )

  after <- Sys.time()

  # check for failure
  if (inherits(status, "error"))
    renv_download_error(url, "%s", conditionMessage(status))

  if (status != 0L)
    renv_download_error(url, "error code %i", status)

  if (!file.exists(tempfile))
    renv_download_error(url, "%s", "unknown reason")

  # double-check archives are readable
  status <- renv_download_check_archive(tempfile)
  if (inherits(status, "error"))
    renv_download_error(url, "%s", "archive cannot be read")

  # everything looks ok: report success
  renv_download_report(after - before, tempfile)

  # move the file to the requested location
  renv_file_move(tempfile, destfile)

  # one final sanity check
  if (!file.exists(destfile)) {
    fmt <- "could not move %s to %s"
    msg <- sprintf(fmt, renv_path_pretty(tempfile), renv_path_pretty(destfile))
    renv_download_error(url, msg)
  }

  # and return path to successfully retrieved file
  destfile

}

# NOTE: only 'GET' and 'HEAD' are supported
#
# each downloader should return 0 on success
renv_download_impl <- function(url, destfile, type = NULL, request = "GET", headers = NULL) {

  # normalize separators (file URIs should normally use forward
  # slashes, even on Windows where the native separator is backslash)
  url      <- chartr("\\", "/", url)
  destfile <- chartr("\\", "/", destfile)

  # check that the destination file is writable
  if (!renv_file_writable(destfile)) {
    fmt <- "destination path '%s' is not writable; cannot proceed"
    stopf(fmt, renv_path_pretty(destfile))
  }

  # select the appropriate downloader
  downloader <- switch(
    renv_download_method(),
    curl = renv_download_curl,
    wget = renv_download_wget,
    renv_download_default
  )

  # run downloader, catching errors
  catch(downloader(url, destfile, type, request, headers))

}

renv_download_default_mode <- function(url, method) {

  mode <- "wb"

  fixup <-
    renv_platform_windows() &&
    identical(method, "wininet") &&
    substring(url, 1L, 5L) == "file:"

  if (fixup)
    mode <- "w+b"

  mode

}

renv_download_default <- function(url, destfile, type, request, headers) {

  # custom request types are not supported with the default downloader
  if (request != "GET")
    stopf("the default downloader does not support %s requests", request)

  # try and ensure headers are set for older versions of R
  headers <- c(headers, renv_download_auth(url, type))
  renv_download_default_agent_scope(headers)

  # on Windows, prefer 'wininet' as most users will have already configured
  # authentication etc. to work with this protocol
  methods <- c(
    Sys.getenv("RENV_DOWNLOAD_METHOD", unset = NA),
    Sys.getenv("RENV_DOWNLOAD_FILE_METHOD", unset = NA),
    if (renv_platform_windows()) "wininet" else "auto"
  )

  method <- Find(Negate(is.na), methods)

  # headers _must_ be NULL rather than zero-length character
  if (length(headers) == 0)
    headers <- NULL

  mode <- renv_download_default_mode(url, method)

  # handle absence of 'headers' argument in older versions of R
  args <- list(url      = url,
               destfile = destfile,
               method   = method,
               headers  = headers,
               mode     = mode,
               quiet    = TRUE)

  fmls <- formals(download.file)
  args <- keep(args, names(fmls))

  renv_download_trace_begin(url, method)
  if (renv_download_trace())
    str(args)

  do.call(download.file, args)

}

renv_download_default_agent_scope <- function(headers) {

  if (empty(headers))
    return(FALSE)

  if (getRversion() >= "3.6.0")
    return(FALSE)

  envir <- parent.frame()
  renv_download_default_agent_scope_impl(headers, envir)

}

renv_download_default_agent_scope_impl <- function(headers, envir = NULL) {

  envir <- envir %||% parent.frame()

  utils <- asNamespace("utils")
  makeUserAgent <- utils$makeUserAgent

  ok <-
    is.function(makeUserAgent) &&
    identical(formals(makeUserAgent), pairlist(format = TRUE))

  if (!ok)
    return(FALSE)

  do.call("unlockBinding", list("makeUserAgent", utils))
  defer(do.call("lockBinding", list("makeUserAgent", utils)), envir = envir)

  agent <- makeUserAgent(FALSE)
  all <- c("User-Agent" = agent, headers)
  headertext <- paste0(names(all), ": ", all, "\r\n", collapse = "")

  assign("makeUserAgent", envir = utils, function(format = TRUE) {
    if (format) headertext else agent
  })

  return(TRUE)

}

renv_download_curl <- function(url, destfile, type, request, headers) {

  renv_download_trace_begin(url, "curl")

  configfile <- renv_scope_tempfile("renv-download-config-")

  fields <- c(
    "user-agent" = renv_http_useragent(),
    "url"        = url,
    "output"     = destfile
  )

  # set connect timeout
  timeout <- config$connect.timeout()
  if (is.numeric(timeout))
    fields[["connect-timeout"]] <- timeout

  # set number of retries
  retries <- config$connect.retry()
  if (is.numeric(retries))
    fields[["retry"]] <- retries

  # set up authentication headers
  auth <- renv_download_auth(url, type)
  if (length(auth)) {
    authtext <- paste(names(auth), auth, sep = ": ")
    names(authtext) <- "header"
    fields <- c(fields, authtext)
  }

  # add other custom headers
  if (length(headers)) {
    lines <- paste(names(headers), headers, sep = ": ")
    names(lines) <- "header"
    fields <- c(fields, lines)
  }

  # join together
  keys <- names(fields)
  vals <- renv_json_quote(fields)
  text <- paste(keys, vals, sep = " = ")

  # add in stand-along flags
  flags <- c("location", "fail", "silent", "show-error")
  if (request == "HEAD")
    flags <- c(flags, "head", "include")

  # put it all together
  text <- c(flags, text)

  writeLines(text, con = configfile)
  renv_download_trace_request(text)

  # generate the arguments to be passed to 'curl'
  args <- stack()

  # include anything provided explicitly in 'download.file.extra' here
  if (identical(getOption("download.file.method"), "curl")) {
    extra <- getOption("download.file.extra")
    if (length(extra))
      args$push(extra)
  }

  # add in any user configuration files
  userconfig <- getOption(
    "renv.curl.config",
    renv_download_curl_config()
  )

  for (entry in userconfig)
    if (file.exists(entry))
      args$push("--config", renv_shell_path(entry))

  # add in our own config file (the actual request)
  args$push("--config", renv_shell_path(configfile))

  # perform the download
  output <- suppressWarnings(
    system2("curl", args$data(), stdout = TRUE, stderr = TRUE)
  )

  renv_download_trace_result(output)

  # report non-zero status as warning
  status <- attr(output, "status", exact = TRUE) %||% 0L
  if (status != 0L)
    warning(output, call. = FALSE)

  status

}

renv_download_curl_config <- function() {

  rc <- if (renv_platform_windows()) "_curlrc" else ".curlrc"

  homes <- c(
    Sys.getenv("CURL_HOME"),
    Sys.getenv("HOME"),
    Sys.getenv("R_USER"),
    path.expand("~/")
  )

  # nocov start
  if (renv_platform_windows()) {
    extra <- c(
      Sys.getenv("APPDATA"),
      file.path(Sys.getenv("USERPROFILE"), "Application Data"),
      dirname(Sys.which("curl"))
    )
    homes <- c(homes, extra)
  }
  # nocov end

  homes <- Filter(nzchar, homes)

  for (home in homes) {
    path <- file.path(home, rc)
    if (file.exists(path))
      return(path)
  }

  NULL

}

# nocov start

renv_download_wget <- function(url, destfile, type, request, headers) {

  renv_download_trace_begin(url, "wget")

  configfile <- renv_scope_tempfile("renv-download-config-")

  fields <- c(
    "user-agent" = renv_http_useragent(),
    "quiet"      = "on"
  )

  auth <- renv_download_auth(url, type)
  if (length(auth)) {
    authtext <- paste(names(auth), auth, sep = ": ")
    names(authtext) <- "header"
    fields <- c(fields, authtext)
  }

  if (length(headers)) {
    lines <- paste(names(headers), headers, sep = ": ")
    names(lines) <- "header"
    fields <- c(fields, lines)
  }

  keys <- names(fields)
  vals <- unlist(fields)
  text <- paste(keys, vals, sep = " = ")

  writeLines(text, con = configfile)
  renv_download_trace_request(text)

  args <- stack()

  if (identical(getOption("download.file.method"), "wget")) {
    extra <- getOption("download.file.extra")
    if (length(extra))
      args$push(extra)
  }

  args$push("--config", renv_shell_path(configfile))

  # NOTE: '-O' does not write headers to file; we need to manually redirect
  # in that case
  status <- if (request == "HEAD") {
    args$push("--server-response", "--spider")
    args$push(">", renv_shell_path(destfile), "2>&1")
    cmdline <- paste("wget", paste(args$data(), collapse = " "))
    return(suppressWarnings(system(cmdline)))
  }

  args$push("-O", renv_shell_path(destfile))
  args$push(renv_shell_quote(url))

  output <- suppressWarnings(
    system2("wget", args$data(), stdout = TRUE, stderr = TRUE)
  )

  renv_download_trace_result(output)

  status <- attr(output, "status", exact = TRUE) %||% 0L
  if (status != 0L)
    warning(output, call. = FALSE)

  status

}

# nocov end

renv_download_auth_type <- function(url) {

  github_hosts <- c(
    "https://api.github.com/",
    "https://raw.githubusercontent.com/"
  )

  for (host in github_hosts)
    if (startswith(url, host))
      return("github")

  gitlab_hosts <- c(
    "https://gitlab.com/"
  )

  for (host in gitlab_hosts)
    if (startswith(url, host))
      return("gitlab")

  bitbucket_hosts <- c(
    "https://api.bitbucket.org/",
    "https://bitbucket.org/"
  )

  for (host in bitbucket_hosts)
    if (startswith(url, host))
      return("bitbucket")

  "unknown"

}

renv_download_auth <- function(url, type) {

  type <- tolower(type %||% renv_download_auth_type(url))
  switch(
    type,
    bitbucket = renv_download_auth_bitbucket(),
    github = renv_download_auth_github(),
    gitlab = renv_download_auth_gitlab(),
    character()
  )

}

renv_download_auth_bitbucket <- function() {

  user <-
    Sys.getenv("BITBUCKET_USER", unset = NA) %NA%
    Sys.getenv("BITBUCKET_USERNAME", unset = NA)

  pass <-
    Sys.getenv("BITBUCKET_PASS", unset = NA) %NA%
    Sys.getenv("BITBUCKET_PASSWORD", unset = NA)

  if (is.na(user) || is.na(pass))
    return(character())

  userpass <- paste(user, pass, sep = ":")
  c("Authorization" = paste("Basic", renv_base64_encode(userpass)))

}

renv_download_auth_github <- function() {

  pat <- Sys.getenv("GITHUB_PAT", unset = NA)
  if (is.na(pat))
    return(character())

  c("Authorization" = paste("token", pat))

}

renv_download_auth_gitlab <- function() {

  pat <- Sys.getenv("GITLAB_PAT", unset = NA)
  if (is.na(pat))
    return(character())

  c("Private-Token" = pat)

}

renv_download_headers <- function(url, type, headers) {

  # check for compatible download method
  method <- renv_download_method()
  if (!method %in% c("libcurl", "curl", "wget"))
    return(list())

  # perform the download
  file <- renv_scope_tempfile("renv-headers-")

  status <- renv_download_impl(
    url      = url,
    destfile = file,
    type     = type,
    request  = "HEAD",
    headers  = headers
  )

  # check for failure
  failed <-
    inherits(status, "error") ||
    !identical(status, 0L) ||
    !file.exists(file)

  if (failed) {
    unlink(file)
    return(list())
  }

  # read the downloaded headers
  contents <- read(file)

  # if redirects were required, each set of headers will
  # be reported separately, so just report the final set
  # of headers (ie: ignore redirects)
  splat <- strsplit(contents, "\n\n", fixed = TRUE)[[1]]
  text <- strsplit(splat[[length(splat)]], "\n", fixed = TRUE)[[1]]

  # keep only header lines
  lines <- grep(":", text, fixed = TRUE, value = TRUE)
  headers <- catch(renv_properties_read(text = lines))
  names(headers) <- tolower(names(headers))
  if (inherits(headers, "error"))
    return(list())

  headers

}

renv_download_size <- function(url, type = NULL, headers = NULL) {

  headers <- catch(renv_download_headers(url, type, headers))
  if (inherits(headers, "error"))
    return(-1L)

  size <- headers[["x-gitlab-size"]]
  if (!is.null(size))
    return(as.numeric(size))

  size <- headers[["content-length"]]
  if (!is.null(size))
    return(as.numeric(size))

  return(-1L)

}

# select an appropriate download file method. we prefer curl
# when available as it's the most user-customizable of all the
# download methods; when not available, we fall back to libcurl
# and wget (in that order). note that we don't want to use the
# internal or wininet downloaders as we cannot set custom headers
# with those methods. users can force a method with the
# RENV_DOWNLOAD_FILE_METHOD environment variable but we generally
# want to override a user-specified 'download.file.method'
renv_download_method <- function() {

  method <- Sys.getenv("RENV_DOWNLOAD_METHOD", unset = NA)
  if (!is.na(method))
    return(method)

  method <- Sys.getenv("RENV_DOWNLOAD_FILE_METHOD", unset = NA)
  if (!is.na(method))
    return(method)

  # prefer curl if available
  if (nzchar(Sys.which("curl")))
    return("curl")

  # if curl is not available, use libcurl if available
  libcurl <- capabilities("libcurl")
  if (length(libcurl) && libcurl)
    return("libcurl")

  # on windows, just use wininet here
  if (renv_platform_windows())
    return("wininet")

  # if neither curl nor libcurl is available, prefer wget
  if (nzchar(Sys.which("wget")))
    return("wget")

  # all else fails, use the internal downloader
  "internal"

}

renv_download_report <- function(elapsed, file) {

  if (!renv_verbose())
    return()

  time <- round(elapsed, 1)

  info <- renv_file_info(file)
  size <- structure(info$size, class = "object_size")

  fmt <- "\tOK [downloaded %s in %s]"
  vwritef(fmt, format(size, units = "auto"), format(time, units = "auto"))

}

renv_download_check_archive <- function(destfile) {

  # validate the file exists
  if (!file.exists(destfile))
    return(FALSE)

  # validate archive type
  type <- renv_archive_type(destfile)
  if (type == "unknown")
    return(FALSE)

  # try listing files in the archive
  tryCatch({renv_archive_list(destfile); TRUE}, error = identity)

}

renv_download_local <- function(url, destfile, headers) {

  # only ever used for downloads from file URIs and server URIs
  ok <-
    grepl("^file:", url) ||
    !grepl("^[a-zA-Z]+://", url)

  if (!ok)
    return(FALSE)

  methods <- list(
    renv_download_local_copy,
    renv_download_local_default
  )

  for (method in methods) {

    # perform the copy
    before <- Sys.time()
    status <- catch(method(url, destfile, headers))
    after  <- Sys.time()

    # check for success
    if (!identical(status, TRUE))
      next

    # report download summary
    renv_download_report(after - before, destfile)

    return(TRUE)

  }

  FALSE

}

renv_download_local_copy <- function(url, destfile, headers) {

  # remove file prefix (to get path to local / server file)
  url <- case(
    startswith(url, "file:///") ~ substring(url, 8L),
    startswith(url, "file://")  ~ substring(url, 6L),
    startswith(url, "file:")    ~ substring(url, 6L),
    TRUE                        ~ url
  )

  # fix up file URIs to local paths on Windows
  if (renv_platform_windows()) {
    badpath <- grepl("^/[a-zA-Z]:", url)
    if (badpath)
      url <- substring(url, 2L)
  }

  # attempt to copy
  ensure_parent_directory(destfile)
  status <- catchall(renv_file_copy(url, destfile, overwrite = TRUE))
  if (!identical(status, TRUE))
    return(FALSE)

  TRUE

}

renv_download_local_default <- function(url, destfile, headers) {

  status <- renv_download_impl(
    url      = url,
    destfile = destfile,
    headers  = headers
  )

  identical(status, 0L)

}

renv_download_custom_headers <- function(url) {

  headers <- getOption("renv.download.headers")
  if (is.null(headers))
    return(character())

  if (!is.function(headers))
    stopf("'renv.download.headers' is not a function")

  headers <- invoke(headers, url)
  if (empty(headers))
    return(character())

  if (is.list(headers))
    headers <- unlist(headers, recursive = FALSE, use.names = TRUE)

  if (!is.character(headers) || is.null(names(headers)))
    stop("invocation of 'renv.download.headers' did not return a named character vector")

  headers

}

renv_download_available <- function(url) {

  # normalize separators (file URIs should normally use forward
  # slashes, even on Windows where the native separator is backslash)
  url <- chartr("\\", "/", url)

  # on Windows, try using our local curl binary if available
  renv_scope_downloader()

  # if we're not using curl, then use fallback method
  method <- renv_download_method()
  if (!identical(method, "curl"))
    return(renv_download_available_fallback(url))

  # otherwise, try a couple candidate methods
  methods <- list(
    renv_download_available_headers,
    renv_download_available_range
  )

  for (method in methods) {
    result <- catch(method(url))
    if (identical(result, TRUE))
      return(TRUE)
  }

  FALSE

}

renv_download_available_headers <- function(url) {

  status <- catchall(
    renv_download_headers(
      url     = url,
      type    = NULL,
      headers = renv_download_custom_headers(url)
    )
  )

  if (inherits(status, "condition"))
    return(FALSE)

  is.list(status) && length(status)

}

renv_download_available_range <- function(url) {

  destfile <- renv_scope_tempfile("renv-download-")

  # instruct curl to request only first byte
  extra <- c(
    if (identical(getOption("download.file.method"), "curl"))
      getOption("download.file.extra"),
    "-r 0-0"
  )

  renv_scope_options(download.file.extra = paste(extra, collapse = " "))

  # perform the download
  status <- catchall(
    renv_download_curl(
      url      = url,
      destfile = destfile,
      type     = NULL,
      request  = "GET",
      headers  = renv_download_custom_headers(url)
    )
  )

  if (inherits(status, "condition"))
    return(FALSE)

  # check for success
  identical(status, 0L)

}

renv_download_available_fallback <- function(url) {

  destfile <- renv_scope_tempfile("renv-download-")

  # just try downloading the requested URL
  status <- catchall(
    renv_download_impl(
      url      = url,
      destfile = destfile,
      type     = NULL,
      request  = "GET",
      headers  = renv_download_custom_headers(url)
    )
  )

  if (inherits(status, "condition"))
    return(FALSE)

  identical(status, 0L)

}

renv_download_error <- function(url, fmt, ...) {
  msg <- sprintf(fmt, ...)
  stopf("failed to retrieve '%s' [%s]", url, msg, call. = FALSE)
}

renv_download_trace <- function() {
  getOption("renv.download.trace", default = FALSE)
}

renv_download_trace_begin <- function(url, type) {

  if (!renv_download_trace())
    return()

  fmt <- "Downloading '%s' [%s]"
  msg <- sprintf(fmt, url, type)

  title <- header(msg, n = 78L)
  writeLines(c(title, ""))

}

renv_download_trace_request <- function(text) {

  if (!renv_download_trace())
    return()

  title <- header("Request", n = 78L, prefix = "##")
  writeLines(c(title, text, ""))

}

renv_download_trace_result <- function(output) {

  if (!renv_download_trace())
    return()

  title <- header("Output", prefix = "##", n = 78L)
  text <- if (empty(output)) "[no output generated]" else output
  all <- c(title, text, "")
  writeLines(all)

  status <- attr(output, "status", exact = TRUE) %||% 0L
  title <- header("Status", prefix = "##", n = 78L)
  all <- c(title, status, "")
  writeLines(all)

}

#' Embed a Lockfile
#'
#' Use `embed()` to embed a compact representation of an `renv` lockfile
#' directly within a file, using [use()] to automatically provision an
#' \R library when that script is run.
#'
#' Using `embed()` is useful if you'd like to be able to share "reproducible"
#' R scripts -- when these scripts are sourced, the generated call to
#' `renv::use()` will ensure that an R library with the requested packages
#' is automatically provisioned.
#'
#' @inheritParams renv-params
#'
#' @param path
#'   The path to an \R or R Markdown script.
#'
#' @param lockfile
#'   The path to an `renv` lockfile. When `NULL` (the default), the project
#'   lockfile will be read (if any); otherwise, a new lockfile will be generated
#'   from the current library paths.
#'
#' @export
embed <- function(path = NULL,
                  ...,
                  lockfile = NULL,
                  project = NULL)
{
  path <- path %||% renv_embed_path()

  ext <- tolower(fileext(path))
  method <- case(
    ext == ".r"   ~ renv_embed_r,
    ext == ".rmd" ~ renv_embed_rmd
  )

  if (is.null(method)) {
    fmt <- "don't know how to embed lockfile into file %s"
    stopf(fmt, renv_path_pretty(path))
  }

  method(
    path     = path,
    lockfile = lockfile,
    project  = project,
    ...
  )

}

renv_embed_path <- function() {

  tryCatch(
    renv_embed_path_impl(),
    error = function(e) NULL
  )

}

renv_embed_path_impl <- function() {
  rstudio <- as.environment("tools:rstudio")
  rstudio$.rs.api.documentPath()
}

renv_embed_create <- function(path = NULL,
                              lockfile = NULL,
                              project = NULL)
{
  # generate lockfile
  project <- renv_project_resolve(project)
  lockfile <- renv_embed_lockfile_resolve(lockfile, project)

  # figure out recursive package dependencies
  deps <- dependencies(path, progress = FALSE)
  packages <- sort(unique(deps$Package))
  all <- renv_package_dependencies(packages)

  # keep only matched records
  lockfile$Packages <-
    keep(lockfile$Packages, c("renv", names(all)))

  # write compact use statement
  renv_lockfile_compact(lockfile)
}

renv_embed_r <- function(path, ..., lockfile = NULL, project = NULL) {

  # resolve project
  project <- renv_project_resolve(project)

  # read file contents
  contents <- readLines(path, warn = FALSE, encoding = "UTF-8")

  # generate embed
  embed <- renv_embed_create(
    path     = path,
    lockfile = lockfile,
    project  = project
  )

  # check for existing 'renv::use' statement
  pattern <- "^\\s*(?:renv:{2,3})?use\\(\\s*$"
  index <- grep(pattern, contents, perl = TRUE)

  # if we don't have an index, just insert at start
  if (empty(index)) {
    contents <- c(embed, "", contents)
    writeLines(contents, con = path)
    return(TRUE)
  }

  # otherwise, try to replace an existing embedded lockfile
  start <- index

  # find the end of the block
  n <- length(contents)
  lines <- grep("^\\s*\\)\\s*$", contents, perl = TRUE)
  end <- min(lines[lines > start], n + 1L)

  # inject new lockfile
  contents <- c(
    head(contents, n = start - 1L),
    embed,
    tail(contents, n = n - end)
  )

  writeLines(contents, con = path)
  return(TRUE)

}

renv_embed_create_rmd <- function(path = NULL,
                                  lockfile = NULL,
                                  project = NULL)
{
  # create lockfile
  project  <- renv_project_resolve(project)
  lockfile <- renv_embed_lockfile_resolve(lockfile, project)

  # create embed
  embed <- renv_embed_create(
    path     = path,
    lockfile = lockfile,
    project  = project
  )

  # return embed
  c("```{r lockfile, include=FALSE}", embed, "```")

}


renv_embed_rmd <- function(path,
                           ...,
                           lockfile = NULL,
                           project = NULL)
{
  # resolve project
  project <- renv_project_resolve(project)

  # read file contents
  contents <- readLines(path, warn = FALSE, encoding = "UTF-8")

  # generate embed
  embed <- renv_embed_create_rmd(
    path     = path,
    lockfile = lockfile,
    project  = project
  )

  # check for existing renv.lock in file
  # if it exists, we'll want to replace at this location;
  # otherwise, insert at end of document
  header <- "^\\s*```{r lockfile"
  footer <- "```"
  start <- grep(header, contents, perl = TRUE)

  # if we don't have an index, insert after YAML header (if any)
  if (empty(start)) {
    bounds <- which(trimws(contents) == "---")

    all <- if (length(bounds) >= 2) {
      index <- bounds[[2L]]
      c(
        head(contents, n = index),
        "",
        embed,
        "",
        tail(contents, n = length(contents) - index)
      )
    } else {
      c(embed, "", contents)
    }

    writeLines(all, con = path)
    return(TRUE)
  }

  # otherwise, try to replace an existing embedded lockfile
  ends <- which(contents == footer)
  end <- min(ends[ends > start])

  # inject new lockfile
  contents <- c(
    head(contents, n = start - 1L),
    embed,
    tail(contents, n = length(contents) - end)
  )

  writeLines(contents, con = path)
  return(TRUE)

}

renv_embed_lockfile_resolve <- function(lockfile, project) {

  # if lockfile is character, assume it's the path to a lockfile
  if (is.character(lockfile))
    return(renv_lockfile_read(lockfile))

  # if lockfile is not NULL, assume lockfile object
  if (!is.null(lockfile))
    return(lockfile)

  # check for lockfile in project
  path <- renv_lockfile_path(project)
  if (file.exists(path))
    return(renv_lockfile_read(path))

  # no lockfile available; just snapshot
  snapshot(project = project, lockfile = NULL)

}

renv_encoding_mark <- function(x, encoding = "UTF-8") {
  Encoding(x) <- "UTF-8"
  x
}

ensure_existing_path <- function(path) {
  if (!file.exists(path))
    stopf("no file at path '%s'", path)
  invisible(path)
}

ensure_existing_file <- function(path) {
  info <- renv_file_info(path)
  if (is.na(info$isdir))
    stopf("no file at path '%s'", path)
  else if (identical(info$isdir, TRUE))
    stopf("file '%s' exists but is a directory")
  invisible(path)
}

ensure_directory <- function(paths) {

  # handle zero-path case
  if (empty(paths))
    return(invisible(paths))

  # collect file info as list
  fileinfo <- renv_file_info(paths)
  infos <- lapply(1:nrow(fileinfo), function(i) fileinfo[i, ])

  # check for existing files that aren't directories
  for (info in infos)
    if (identical(info$isdir, FALSE))
      stopf("path '%s' exists but is not a directory", rownames(info))

  # create missing directories
  for (info in infos)
    if (is.na(info$isdir))
      if (!dir.create(rownames(info), recursive = TRUE))
        stopf("failed to create directory at path '%s'", rownames(info))

  # return the paths
  invisible(paths)

}

ensure_parent_directory <- function(path) {
  ensure_directory(unique(dirname(path)))
}


renv_envir_self <- function() {
  parent.env(environment())
}

renv_envir_unwrap <- function(envir) {
  eapply(envir, function(node) {
    if (is.environment(node))
      renv_envir_unwrap(node)
    else
      node
  })
}


renv_envvar_get <- function(key, unset = NA) {
  Sys.getenv(key, unset = unset)
}

renv_envvar_set <- function(key, value) {

  # handle NULL / NA values
  if (is.null(value) || is.na(value))
    return(Sys.unsetenv(key))

  # otherwise, delegate
  args <- structure(list(value), names = key)
  do.call(Sys.setenv, args)

}

renv_envvar_clear <- function(key) {
  Sys.unsetenv(key)
}

renv_envvar_modify <- function(envvar, value, prepend) {

  old <- Sys.getenv(envvar, unset = NA)

  parts <- if (prepend)
    c(value, if (!is.na(old)) old)
  else
    c(if (!is.na(old)) old, value)

  new <- paste(parts, collapse = .Platform$path.sep)

  names(new) <- envvar
  do.call(Sys.setenv, as.list(new))

  new

}

renv_envvar_prepend <- function(envvar, value) {
  renv_envvar_modify(envvar, value, TRUE)
}

renv_envvar_append <- function(envvar, value) {
  renv_envvar_modify(envvar, value, FALSE)
}

renv_envvars_list <- function() {
  c(
    "R_PROFILE", "R_PROFILE_USER",
    "R_ENVIRON", "R_ENVIRON_USER",
    "R_LIBS_USER", "R_LIBS_SITE", "R_LIBS"
  )
}

renv_envvars_save <- function() {

  # save the common set of environment variables
  keys <- renv_envvars_list()
  vals <- Sys.getenv(keys, unset = "<NA>")

  # check for defaults that have already been set
  defkeys <- paste("RENV_DEFAULT", keys, sep = "_")
  defvals <- Sys.getenv(defkeys, unset = NA)
  if (any(!is.na(defvals)))
    return(FALSE)

  # prepare defaults
  env <- vals
  names(env) <- defkeys
  do.call(Sys.setenv, as.list(env))

  TRUE

}

renv_envvars_restore <- function() {

  # read defaults
  keys <- renv_envvars_list()
  defkeys <- paste("RENV_DEFAULT", renv_envvars_list(), sep = "_")
  defvals <- Sys.getenv(defkeys, unset = "<NA>")

  # remove previously-unset environment variables
  missing <- defvals == "<NA>"
  Sys.unsetenv(keys[missing])

  # restore old values for envvars
  existing <- as.list(defvals[!missing])
  if (length(existing)) {
    names(existing) <- sub("^RENV_DEFAULT_", "", names(existing))
    do.call(Sys.setenv, existing)
  }

  # remove saved RENV_DEFAULT values
  Sys.unsetenv(defkeys)
  TRUE

}

renv_envvars_init <- function() {

  renv_envvars_normalize()

  if (renv_platform_macos()) {

    # set SDKROOT so older R installations can find command line tools
    sdk <- "/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk"
    sdkroot <- Sys.getenv("SDKROOT", unset = NA)
    if (is.na(sdkroot) && file.exists(sdk))
      Sys.setenv(SDKROOT = sdk)

  }

}

renv_envvars_normalize <- function() {

  Sys.setenv(R_LIBS_SITE = .expand_R_libs_env_var(Sys.getenv("R_LIBS_SITE")))
  Sys.setenv(R_LIBS_USER = .expand_R_libs_env_var(Sys.getenv("R_LIBS_USER")))

  keys <- c(
    "RENV_PATHS_ROOT",
    "RENV_PATHS_LIBRARY",
    "RENV_PATHS_LIBRARY_ROOT",
    "RENV_PATHS_LIBRARY_STAGING",
    "RENV_PATHS_LOCAL",
    "RENV_PATHS_CELLAR",
    "RENV_PATHS_SOURCE",
    "RENV_PATHS_BINARY",
    "RENV_PATHS_CACHE",
    "RENV_PATHS_RTOOLS",
    "RENV_PATHS_EXTSOFT",
    "RENV_PATHS_MRAN"
  )

  envvars <- as.list(keep(Sys.getenv(), keys))
  if (empty(envvars))
    return()

  args <- lapply(envvars, renv_path_normalize)
  do.call(Sys.setenv, args)

}

renv_equip_macos_specs <- function() {

  list(

    "4.0" = list(
      url = "https://cran.r-project.org/bin/macosx/tools/clang-8.0.0.pkg",
      dst = "/usr/local/clang8"
    ),

    "3.7" = list(
      url = "https://cran.r-project.org/bin/macosx/tools/clang-8.0.0.pkg",
      dst = "/usr/local/clang8"
    ),

    "3.6" = list(
      url = "https://cran.r-project.org/bin/macosx/tools/clang-7.0.0.pkg",
      dst = "/usr/local/clang7"
    ),

    "3.5" = list(
      url = "https://cran.r-project.org/bin/macosx/tools/clang-6.0.0.pkg",
      dst = "/usr/local/clang6"
    )

  )

}

renv_equip_macos_spec <- function(version = getRversion()) {
  specs <- renv_equip_macos_specs()
  majmin <- numeric_version(version)[1, 1:2]
  specs[[format(majmin)]]
}

renv_equip_macos <- function() {

  renv_equip_macos_sdk()
  renv_equip_macos_toolchain()

}

renv_equip_macos_sdk <- function() {

  sdk <- "/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk"
  if (file.exists(sdk) || file.exists("/usr/include"))
    return(TRUE)

  system("/usr/bin/xcode-select --install")

  # give the user some time to respond to the dialog)
  Sys.sleep(5)

}

renv_equip_macos_toolchain <- function() {

  if (getRversion() >= "4.1.0")
    return()

  spec <- renv_equip_macos_spec()
  if (is.null(spec)) {
    fmt <- "no known toolchain recorded in renv for R %s"
    warningf(fmt, getRversion())
    return(FALSE)
  }

  url <- spec$url
  dst <- spec$dst

  clang <- file.path(dst, "bin/clang")
  if (file.exists(clang)) {
    fmt <- "* LLVM toolchain for R %s is already installed at %s."
    vwritef(fmt, getRversion(), shQuote(dst))
    return(TRUE)
  }

  destfile <- file.path(tempdir(), basename(url))
  download(url, destfile = destfile)

  if (renv_equip_macos_rstudio(spec, destfile))
    return(TRUE)

  command <- paste("sudo /usr/sbin/installer -pkg", shQuote(destfile), "-target /")
  renv_pretty_print(
    command,
    "The R LLVM toolchain has been successfully downloaded. Please execute:",
    "in a separate terminal to complete installation.",
    wrap = FALSE
  )

  TRUE

}

renv_equip_macos_rstudio <- function(spec, destfile) {

  rstudio <-
    renv_rstudio_available() &&
    requireNamespace("rstudioapi", quietly = TRUE)

  if (!rstudio)
    return(FALSE)

  command <- paste("sudo -kS /usr/sbin/installer -pkg", shQuote(destfile), "-target /")
  prompt <- paste(
    "Installation of the R LLVM toolchain requires sudo.",
    "Please enter your account password.",
    sep = "\n"
  )

  installed <- local({

    password <- rstudioapi::askForPassword(prompt)
    if (is.null(password))
      return(FALSE)

    status <- system(command, input = password)
    if (status != 0L)
      return(FALSE)

    TRUE

  })

  if (!installed)
    return(FALSE)

  renv_pretty_print(
    spec$dst,
    "The R LLVM toolchain has been downloaded and installed to:",
    "This toolchain will be used by renv when installing packages from source.",
    wrap = FALSE
  )

  return(TRUE)

}

#' Install Required System Libraries
#'
#' Equip your system with libraries commonly-used during compilation of
#' \R packages. Currently only supported on Windows.
#'
#' @return This function is normally called for its side effects.
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # download useful build tools
#' renv::equip()
#'
#' }
equip <- function() {

  renv_scope_error_handler()

  case(
    renv_platform_windows() ~ renv_equip_windows(),
    renv_platform_macos()   ~ renv_equip_macos(),
    renv_platform_linux()   ~ renv_equip_linux()
  )

  invisible(NULL)

}

renv_equip_windows <- function() {
  invisible(renv_extsoft_install() && renv_extsoft_use())
}

renv_equip_linux <- function() {
  stopf("renv::equip() not yet implemented for Linux")
}

renv_error_format_srcref <- function(call, srcref) {

  srcfile <- attr(srcref, "srcfile", exact = TRUE)

  if (inherits(srcfile, c("srcfilecopy", "srcfilealias"))) {
    start <- srcref[7L]
    end   <- srcref[8L]
  } else {
    start <- srcref[1L]
    end   <- srcref[3L]
  }

  srclines <- getSrcLines(srcfile, start, end)
  index <- regexpr("[^[:space:]]", srclines)
  indent <- min(index)
  code <- substring(srclines, indent)

  if (length(code) >= 8L) {
    simplified <- renv_error_simplify(call)
    if (!identical(simplified, call))
      code <- format(simplified)
  }

  n <- length(code)
  postfix <- sprintf("at %s#%i", basename(srcfile$filename), srcref[1L])
  code[n] <- paste(code[n], postfix)

  code

}

renv_error_simplify <- function(object) {

  case(
    is.function(object)  ~ renv_error_simplify_function(object),
    is.recursive(object) ~ renv_error_simplify_recursive(object),
    TRUE                 ~ object
  )

}

renv_error_simplify_function <- function(object) {
  f <- function() {}
  formals(f) <- formals(object)
  body(f) <- quote({ ... })
  f
}

renv_error_simplify_recursive <- function(object) {

  longcall <-
    is.call(object) &&
    is.symbol(object[[1]]) &&
    object[[1]] == as.name("{") &&
    length(object) >= 8

  if (longcall)
    return(quote(...))

  for (i in seq_along(object))
    if (!is.null(object[[i]]))
      object[[i]] <- renv_error_simplify(object[[i]])

  object

}

renv_error_format <- function(calls, frames) {

  # first, format calls
  formatted <- lapply(calls, function(call) {

    srcref <- attr(call, "srcref", exact = TRUE)
    if (!is.null(srcref)) {
      formatted <- catch(renv_error_format_srcref(call, srcref))
      if (!inherits(formatted, "error"))
        return(formatted)
    }

    if (is.function(call[[1]]))
      return("<condition-handler>(...)")

    format(renv_error_simplify(call))

  })

  # compute prefixes
  numbers <- format(seq_along(formatted))
  prefixes <- sprintf("%s: ", rev(numbers))

  # generate indent
  indent <- paste(rep.int(" ", min(nchar(prefixes))), collapse = "")

  # attach prefixes + indent
  annotated <- uapply(seq_along(formatted), function(i) {
    code <- formatted[[i]]
    prefix <- c(prefixes[[i]], rep.int(indent, length(code) - 1L))
    paste(prefix, code, sep = "")
  })

  header <- "Traceback (most recent calls last):"
  c(header, annotated)

}

renv_error_find <- function(calls, frames) {

  for (i in rev(seq_along(frames))) {

    fn <- sys.function(which = i)
    if (!identical(fn, stop))
      next

    frame <- frames[[i]]
    args <- frame[["args"]]
    if (is.null(args) || empty(args))
      next

    first <- args[[1L]]
    if (!inherits(first, "condition"))
      next

    return(first)

  }

}

renv_error_handler <- function(...) {

  calls <- head(sys.calls(), n = -1L)
  frames <- head(sys.frames(), n = -1L)

  error <- renv_error_find(calls, frames)
  if (identical(error$traceback, FALSE))
    return(character())

  formatted <- renv_error_format(calls, frames)
  writeLines(formatted, con = stderr())

  formatted

}

renv_error_capture <- function(e) {
  calls <- head(sys.calls(), n = -2L)
  frames <- head(sys.frames(), n = -2L)
  traceback <- renv_error_format(calls, frames)
  renv_global_set("traceback", traceback)
}

renv_error_tag <- function(e) {
  e$traceback <- renv_global_get("traceback")
  e
}

renv_error_handler_call <- function() {
  as.call(list(renv_error_handler))
}

renv_error_report <- function(error = NULL) {
  if (renv_tests_running() && inherits(error, "error"))
    stop(error)
}

`_renv_exit_handlers` <- new.env(parent = emptyenv())

renv_exit_handlers_get <- function(envir) {
  key <- format(envir)
  `_renv_exit_handlers`[[key]]
}

renv_exit_handlers_set <- function(envir, handlers) {

  oldhandlers <- renv_exit_handlers_get(envir)
  if (is.null(oldhandlers)) {
    call <- as.call(list(renv_exit_handlers_execute, envir))
    do.call(base::on.exit, list(substitute(call), TRUE), envir = envir)
  }

  key <- format(envir)
  `_renv_exit_handlers`[[key]] <- handlers

}

renv_exit_handlers_remove <- function(envir) {
  key <- format(envir)
  `_renv_exit_handlers`[[key]] <- NULL
}

renv_exit_handlers_execute <- function(envir) {
  handlers <- renv_exit_handlers_get(envir)
  for (handler in handlers)
    tryCatch(eval(handler$expr, handler$envir), error = identity)
  renv_exit_handlers_remove(envir)
}

renv_exit_handlers_add <- function(envir, handler) {
  handlers <- c(list(handler), renv_exit_handlers_get(envir))
  renv_exit_handlers_set(envir, handlers)
  handler
}


renv_exports_attach <- function() {

  # only done if we're renv
  if (!identical(.packageName, "renv"))
    return()

  # guard against intermediate case where config hasn't been generated
  renv <- asNamespace("renv")
  if (!exists("config", envir = renv))
    return()

  # ignored when running tests and in load_all
  # we don't iterate over `calls` directly to avoid
  # https://github.com/rstudio/renv/issues/930
  calls <- sys.calls()
  for (i in seq_along(calls)) {
    call <- calls[[i]]
    if (identical(call[[1L]], quote(devtools::test)) ||
        identical(call[[1L]], quote(devtools::document)) ||
        identical(call[[1L]], quote(devtools::load_all)))
      return()
  }

  # read exports
  exports <- renv$config$exported.functions()
  if (identical(exports, "*"))
    return()

  # remove anything that wasn't explicitly exported
  envir <- as.environment("package:renv")
  all <- ls(envir = envir, all.names = TRUE)
  removed <- setdiff(all, exports)
  rm(list = removed, envir = envir, inherits = FALSE)

}

renv_extsoft_curl_version <- function() {
  Sys.getenv("RENV_EXTSOFT_CURL_VERSION", unset = "7.77.0")
}

renv_extsoft_install <- function(quiet = FALSE) {

  extsoft <- renv_paths_extsoft()

  ensure_directory(extsoft)
  ensure_directory(file.path(extsoft, "lib/i386"))
  ensure_directory(file.path(extsoft, "lib/x64"))

  root <- "https://s3.amazonaws.com/rstudio-buildtools/extsoft"

  files <- c(
    sprintf("curl-%s-win32-mingw.zip", renv_extsoft_curl_version()),
    "glpk32.zip",
    "glpk64.zip",
    "local323.zip",
    "nlopt-2.4.2.zip",
    "spatial324.zip"
  )

  # check for missing installs
  files <- Filter(renv_extsoft_install_required, files)
  if (empty(files)) {
    if (!quiet) vwritef("* External software is up to date.")
    return(TRUE)
  }

  if (interactive()) {

    renv_pretty_print(
      files,
      "The following external software tools will be installed:",
      sprintf("Tools will be installed into '%s'.", aliased_path(extsoft)),
      wrap = FALSE
    )

    if (!proceed()) {
      renv_report_user_cancel()
      return(FALSE)
    }

  }

  for (file in files) {

    # download the file
    url <- file.path(root, file)
    destfile <- renv_scope_tempfile("renv-archive-", fileext = ".zip")
    download(url, destfile = destfile, quiet = quiet)

    # write manifest
    manifest <- renv_extsoft_manifest_path(file)
    ensure_parent_directory(manifest)

    before <- list.files(extsoft, recursive = TRUE)

    # unpack archive
    if (file == "glpk32.zip") {

      unzip(destfile, files = "include/glpk.h", exdir = extsoft)
      unzip(destfile, exdir = file.path(extsoft, "lib/i386"), junkpaths = TRUE)

    } else if (file == "glpk64.zip") {

      unzip(destfile, files = "include/glpk.h", exdir = extsoft)
      unzip(destfile, exdir = file.path(extsoft, "lib/x64"), junkpaths = TRUE)

    } else if (file == "nlopt-2.4.2.zip") {

      unzip(destfile, exdir = extsoft)

      file.copy(file.path(extsoft, "nlopt-2.4.2/include"), extsoft, recursive = TRUE)
      file.copy(file.path(extsoft, "nlopt-2.4.2/lib"), extsoft, recursive = TRUE)
      unlink(file.path(extsoft, "nlopt-2.4.2"), recursive = TRUE)


    } else {

      unzip(destfile, exdir = extsoft)

    }

    after <- list.files(extsoft, recursive = TRUE)
    writeLines(setdiff(after, before), con = manifest)

  }

  vwritef("* External software successfully updated.")
  TRUE

}

renv_extsoft_install_required <- function(file) {

  manifest <- renv_extsoft_manifest_path(file)
  if (!file.exists(manifest))
    return(TRUE)

  files <- catch(readLines(manifest, warn = FALSE))
  if (inherits(files, "error"))
    return(FALSE)

  paths <- renv_paths_extsoft(files)
  !all(file.exists(paths))

}

renv_extsoft_use <- function(quiet = FALSE) {

  extsoft <- renv_paths_extsoft()
  path <- "~/.R/Makevars"

  ensure_parent_directory(path)
  original <- if (file.exists(path))
    readLines(path, warn = FALSE)
  else
    character()

  contents <- original

  localsoft <- paste("LOCAL_SOFT", extsoft, sep = " = ")
  contents <- inject(contents, "^#?LOCAL_SOFT", localsoft)

  localcpp <- "LOCAL_CPPFLAGS = -I\"$(LOCAL_SOFT)/include\""
  contents <- inject(contents, "^#?LOCAL_CPPFLAGS", localcpp)

  locallibs <- "LOCAL_LIBS = -L\"$(LOCAL_SOFT)/lib$(R_ARCH)\" -L\"$(LOCAL_SOFT)/lib\""
  contents <- inject(contents, "^#?LOCAL_LIBS", locallibs)

  libxml <- paste("LIB_XML", extsoft, sep = " = ")
  contents <- inject(contents, "^#?LIB_XML", libxml)

  if (identical(original, contents))
    return(TRUE)

  if (interactive()) {

    renv_pretty_print(
      c(localsoft, libxml, localcpp, locallibs),
      "The following entries will be added to ~/.R/Makevars:",
      "These tools will be used when compiling R packages from source.",
      wrap = FALSE
    )

    if (!proceed()) {
      renv_report_user_cancel()
      return(FALSE)
    }

  }

  if (!quiet) vwritef("* '%s' has been updated.", path)
  writeLines(contents, path)
  TRUE

}

renv_extsoft_manifest_path <- function(file) {
  name <- paste(file, "manifest", sep = ".")
  renv_paths_extsoft("manifests", name)
}

# tools for caching values read from a file, and invalidating those values if
# the file mtime changes. use `renv_filebacked_set()` to associate some value
# with a file at a particular point in time; `renv_filebacked_get()` will return
# that value, or NULL of the file mtime has changed
`_renv_filebacked` <- new.env(parent = emptyenv())

renv_filebacked_init <- function() {

  scopes <- c(
    "DESCRIPTION",
    "dependencies",
    "hash",
    "mran",
    "python.versions",
    "settings",
    "test"
  )

  for (scope in scopes) {
    envir <- new.env(parent = emptyenv())
    assign(scope, envir, envir = `_renv_filebacked`)
  }

}

renv_filebacked_clear <- function(scope, path = NULL) {

  # get cache associated with this scope
  envir <- renv_filebacked_envir(scope)

  # list all available cached results
  existing <- ls(envir = envir, all.names = TRUE)

  # if path is set, use it; otherwise remove everything
  path <- path %||% existing

  # validate the requested paths exist in the environment
  removable <- renv_vector_intersect(path, existing)

  # remove them
  rm(list = removable, envir = envir)
}

renv_filebacked_set <- function(scope, path, value) {

  # validate the path
  stopifnot(renv_path_absolute(path))

  # create our cache entry
  info <- renv_file_info(path)
  entry <- list(value = value, info = info)

  # store it
  envir <- renv_filebacked_envir(scope)
  assign(path, entry, envir = envir)
  invisible(value)

}

renv_filebacked_get <- function(scope, path) {

  # validate the path
  if (!renv_path_absolute(path))
    stopf("internal error: '%s' is not an absolute path", path)

  # get scoped sub-environment
  envir <- renv_filebacked_envir(scope)

  # check for entry in the cache
  entry <- envir[[path]]
  if (is.null(entry))
    return(NULL)

  # extract pieces of interest
  value   <- entry$value
  oldinfo <- entry$info
  newinfo <- renv_file_info(path)

  # if the file didn't exist when we set the entry,
  # check and see if it's still not there
  if (is.na(oldinfo$isdir) && is.na(newinfo$isdir))
    return(value)

  # compare on fields of interest
  fields <- c("size", "isdir", "mtime")
  if (!identical(oldinfo[fields], newinfo[fields]))
    return(NULL)

  # looks good
  value

}

renv_filebacked_envir <- function(scope) {
  get(scope, envir = `_renv_filebacked`)
}

filebacked <- function(scope, path, callback, ...) {

  # don't use filebacked cache when disabled
  config <- config$filebacked.cache()
  if (identical(config, FALSE))
    return(callback(path, ...))

  # check for cache entry -- if available, use it
  cache <- renv_filebacked_get(scope, path)
  if (!is.null(cache))
    return(cache)

  # otherwise, generate our value and cache it
  result <- callback(path, ...)
  renv_filebacked_set(scope, path, result)

  result

}

# NOTE: all methods here should either return TRUE if they were able to
# operate successfully, or throw an error if not
#
# TODO: some of these operations are a bit racy
renv_file_preface <- function(source, target, overwrite) {

  callback <- function() {}
  if (!renv_file_exists(source))
    stopf("source file '%s' does not exist", source)

  if (overwrite)
    callback <- renv_file_backup(target)

  if (renv_file_exists(target))
    stopf("target file '%s' already exists", target)

  callback

}

renv_file_copy <- function(source, target, overwrite = FALSE) {

  if (renv_file_same(source, target))
    return(TRUE)

  callback <- renv_file_preface(source, target, overwrite)
  on.exit(callback(), add = TRUE)

  # check to see if we're copying a plain file -- if so, things are simpler
  if (dir.exists(source))
    renv_file_copy_dir(source, target)
  else
    renv_file_copy_file(source, target)

}

renv_file_copy_file <- function(source, target) {

  # copy to temporary path
  tmpfile <- renv_scope_tempfile(".renv-copy-", tmpdir = dirname(target))
  status <- catchall(file.copy(source, tmpfile))
  if (inherits(status, "condition"))
    stop(status)

  # move from temporary path to final target
  status <- catchall(renv_file_move(tmpfile, target))
  if (inherits(status, "condition"))
    stop(status)

  # validate that the target file exists
  if (renv_file_exists(target))
    return(TRUE)

  fmt <- "attempt to copy file %s to %s failed (unknown reason)"
  stopf(fmt, renv_path_pretty(source), renv_path_pretty(target))

}

renv_file_copy_dir_robocopy <- function(source, target) {
  renv_robocopy_copy(source, target)
}

# TODO: the version of rsync distributed with macOS
# does not reliably copy file modified times, etc.
renv_file_copy_dir_rsync <- function(source, target) {
  source <- sub("/*$", "/", source)
  flags <- if (renv_platform_macos()) "-aAX" else "-a"
  args <- c(flags, renv_shell_path(source), renv_shell_path(target))
  renv_system_exec("rsync", args, action = "copying directory")
}

renv_file_copy_dir_cp <- function(source, target) {

  # ensure 'source' ends with a single trailing slash
  source <- sub("/*$", "/", source)

  # ensure tildes are path-expanded
  source <- path.expand(source)
  target <- path.expand(target)

  # build 'cp' arguments
  args <- c("-pPR", renv_shell_path(source), renv_shell_path(target))

  # execute command
  renv_system_exec("cp", args, action = "copying directory")

}

renv_file_copy_dir_r <- function(source, target) {

  # create sub-directory to host copy attempt
  tempdir <- renv_scope_tempfile(".renv-copy-", tmpdir = dirname(target))
  ensure_directory(tempdir)

  # attempt to copy to generated folder
  status <- catchall(
    file.copy(
      source,
      tempdir,
      recursive = TRUE,
      copy.mode = TRUE,
      copy.date = TRUE
    )
  )

  if (inherits(status, "error"))
    stop(status)

  # R will copy the directory to a sub-directory in the
  # requested folder with the same filename as the source
  # folder, so peek into that folder to grab it and rename
  tempfile <- file.path(tempdir, basename(source))
  status <- catchall(renv_file_move(tempfile, target))
  if (inherits(status, "condition"))
    stop(status)

}

renv_file_copy_dir_impl <- function(source, target) {

  methods <- list(
    cp       = renv_file_copy_dir_cp,
    r        = renv_file_copy_dir_r,
    robocopy = renv_file_copy_dir_robocopy,
    rsync    = renv_file_copy_dir_rsync
  )

  copy <- config$copy.method()
  if (is.function(copy))
    return(copy(source, target))

  method <- methods[[tolower(copy)]]
  if (!is.null(method))
    return(method(source, target))

  if (renv_platform_windows())
    renv_file_copy_dir_robocopy(source, target)
  else if (renv_platform_unix())
    renv_file_copy_dir_cp(source, target)
  else
    renv_file_copy_dir_r(source, target)

  file.exists(target)

}

renv_file_copy_dir <- function(source, target) {

  # create temporary sub-directory
  tmpdir <- dirname(target)
  ensure_directory(tmpdir)
  tempdir <- renv_scope_tempfile(".renv-copy-", tmpdir = tmpdir)

  # copy to that directory
  status <- catchall(renv_file_copy_dir_impl(source, tempdir))
  if (inherits(status, "condition"))
    stop(status)

  # move directory to final location
  status <- catchall(renv_file_move(tempdir, target))
  if (inherits(status, "condition"))
    stop(status)

  # validate that the target file exists
  if (renv_file_exists(target))
    return(TRUE)

  fmt <- "attempt to copy directory %s to %s failed (unknown reason)"
  stopf(fmt, renv_path_pretty(source), renv_path_pretty(target))

}

renv_file_move <- function(source, target, overwrite = FALSE) {

  if (renv_file_same(source, target))
    return(TRUE)

  callback <- renv_file_preface(source, target, overwrite)
  on.exit(callback(), add = TRUE)

  # first, attempt to do a plain rename
  # use catchall since this might fail for e.g. cross-device links
  # (note that junction points on Windows will be copies as-is)
  move <- catchall(file.rename(source, target))
  if (renv_file_exists(target))
    return(TRUE)

  # expand tildes
  source <- path.expand(source)
  target <- path.expand(target)

  # on unix, try using 'mv' command directly
  # (can handle cross-device copies / moves a bit more efficiently)
  if (renv_platform_unix()) {
    args <- c(renv_shell_path(source), renv_shell_path(target))
    status <- catchall(system2("mv", args, stdout = FALSE, stderr = FALSE))
    if (renv_file_exists(target))
      return(TRUE)
  }

  # on Windows, similarly try 'robocopy' command
  # (should be faster than 'move' for large directories)
  if (renv_platform_windows()) {
    status <- catchall(renv_robocopy_move(source, target))
    if (renv_file_exists(target))
      return(TRUE)
  }

  # nocov start
  # rename failed; fall back to copying
  # (and be sure to remove the source file / directory on success)
  copy <- catchall(renv_file_copy(source, target, overwrite = overwrite))
  if (identical(copy, TRUE) && file.exists(target)) {
    unlink(source, recursive = TRUE)
    return(TRUE)
  }

  # rename and copy both failed: inform the user
  fmt <- stack()
  fmt$push("could not copy / move file '%s' to '%s'")
  if (inherits(move, "condition"))
    fmt$push(paste("move:", conditionMessage(move)))
  if (inherits(copy, "condition"))
    fmt$push(paste("copy:", conditionMessage(copy)))

  text <- paste(fmt$data(), collapse = "\n")
  stopf(text, source, target)
  # nocov end

}

renv_file_link <- function(source, target, overwrite = FALSE) {

  if (renv_file_same(source, target))
    return(TRUE)

  callback <- renv_file_preface(source, target, overwrite)
  on.exit(callback(), add = TRUE)

  if (renv_platform_windows()) {

    # use junction points on Windows by default as symlinks
    # are unreliable / un-deletable in some circumstances
    status <- catchall(Sys.junction(source, target))
    if (identical(status, TRUE))
      return(TRUE)

    # if Sys.junction() fails, it may leave behind an empty
    # directory. this may occur if the source and target files
    # reside on different volumes. either way, remove an empty
    # left-behind directory on failure
    unlink(target, recursive = TRUE, force = TRUE)

  } else {

    # on non-Windows, we can try to create a symlink
    status <- catchall(file.symlink(source, target))
    if (identical(status, TRUE))
      return(TRUE)

  }

  # all else fails, just perform a copy
  renv_file_copy(source, target, overwrite = overwrite)

}

renv_file_junction <- function(source, target) {

  if (!renv_platform_windows())
    stopf("'renv_file_junction()' is only available on Windows")

  if (renv_file_exists(target))
    stopf("file '%s' already exists")

  status <- catchall(Sys.junction(source, target))
  if (inherits(status, "condition")) {
    unlink(target, recursive = TRUE, force = TRUE)
    stop(status)
  }

  TRUE

}

renv_file_same <- function(source, target) {

  # if the paths are the same, we can return early
  if (identical(source, target))
    return(TRUE)

  # check to see if they're equal after normalization
  # (e.g. for symlinks pointing to same file)
  source <- renv_path_normalize(source, mustWork = FALSE)
  target <- renv_path_normalize(target, mustWork = FALSE)
  if (identical(source, target))
    return(TRUE)

  # if either file is missing, return false
  if (!renv_file_exists(source) || !renv_file_exists(target))
    return(FALSE)

  # for hard links + junction points, it's difficult to detect
  # whether the two files point to the same object; use some
  # heuristics to guess (note that these aren't perfect)
  sinfo <- renv_file_info(source)
  tinfo <- renv_file_info(target)
  if (!identical(c(sinfo), c(tinfo)))
    return(FALSE)

  TRUE

}

# NOTE: returns a callback which should be used in e.g. an on.exit handler
# to restore the file if the attempt to update the file failed
renv_file_backup <- function(path) {

  force(path)

  # if no file exists then nothing to backup
  if (!renv_file_exists(path))
    return(function() {})

  # normalize the path (since the working directory could change
  # by the time the callback is invoked). note that the file may
  # be a broken symlink so construct the path by normalizing the
  # parent directory and building path relative to that
  parent <- renv_path_normalize(dirname(path), winslash = "/", mustWork = TRUE)
  path <- file.path(parent, basename(path))

  # attempt to rename the file
  pattern <- sprintf(".renv-backup-%s", basename(path))
  tempfile <- tempfile(pattern, tmpdir = dirname(path))
  if (!renv_file_move(path, tempfile))
    return(function() {})

  # return callback that will restore if needed
  function() {

    if (!renv_file_exists(path))
      renv_file_move(tempfile, path)
    else
      unlink(tempfile, recursive = TRUE)

  }

}

renv_file_normalize <- function(path, winslash = "\\", mustWork = NA) {
  parent <- renv_path_normalize(dirname(path), winslash = winslash, mustWork = mustWork)
  file.path(parent, basename(path))
}

renv_file_info <- function(paths, extra_cols = FALSE) {
  suppressWarnings(file.info(paths, extra_cols = extra_cols))
}

# NOTE: returns true for files that are broken symlinks
renv_file_exists <- function(path) {

  if (renv_platform_windows())
    return(file.exists(path))

  !is.na(Sys.readlink(path)) | file.exists(path)

}

renv_file_list <- function(path, full.names = TRUE) {

  # list files
  files <- renv_file_list_impl(path)

  # NOTE: paths may be marked with UTF-8 encoding;
  # if that's the case we need to use paste rather
  # than file.path to preserve the encoding
  if (full.names)
    files <- paste(path, files, sep = "/")

  files

}

renv_file_list_impl <- function(path) {
  if (renv_platform_windows())
    renv_file_list_impl_win32(path)
  else
    renv_file_list_impl_unix(path)
}

renv_file_list_impl_unix <- function(path) {
  list.files(path, all.files = TRUE, no.. = TRUE)
}

# nocov start
renv_file_list_impl_win32 <- function(path) {

  # first, try a plain list.files to see if we can get away with that
  files <- list.files(path, all.files = TRUE, no.. = TRUE)
  if (!any(grepl("?", files, fixed = TRUE)))
    return(files)

  # otherwise, try some madness ...
  #
  # change working directory (done just to avoid encoding issues
  # when submitting path to cmd shell)
  owd <- setwd(path)
  on.exit(setwd(owd), add = TRUE)

  # NOTE: a sub-shell is required here in some contexts; e.g. when running
  # tests non-interactively or building in the RStudio pane
  command <- paste(comspec(), "/U /C dir /B")
  conn <- pipe(command, open = "rb", encoding = "native.enc")
  on.exit(close(conn), add = TRUE)

  # read binary output from connection
  output <- stack()

  while (TRUE) {

    data <- readBin(conn, what = "raw", n = 1024L)
    if (empty(data))
      break

    output$push(data)

  }

  # join into single raw vector
  encoded <- unlist(output$data(), recursive = FALSE, use.names = FALSE)

  # convert raw data (encoded as UTF-16LE) to UTF-8
  converted <- iconv(list(encoded), from = "UTF-16LE", to = "UTF-8")

  # split on (Windows) newlines
  paths <- strsplit(converted, "\r\n", fixed = TRUE)[[1]]

  # just in case?
  paths[nzchar(paths)]

}
# nocov end

renv_file_type <- function(paths, symlinks = TRUE) {

  info <- renv_file_info(paths)

  types <- character(length(paths))
  types[info$isdir %in% FALSE] <- "file"
  types[info$isdir %in% TRUE ] <- "directory"

  if (symlinks && !renv_platform_windows()) {
    links <- Sys.readlink(paths)
    types[!is.na(links) & nzchar(links)] <- "symlink"
  }

  types

}

# nocov start
renv_file_edit <- function(path) {

  # https://github.com/rstudio/renv/issues/44
  dlls <- getLoadedDLLs()
  if (is.null(dlls[["(embedding)"]]))
    return(utils::file.edit(path))

  routines <- getDLLRegisteredRoutines("(embedding)")
  routine <- routines[[".Call"]][["rs_editFile"]]
  if (is.null(routine))
    return(utils::file.edit(path))

  do.call(.Call, list(routine, path, PACKAGE = "(embedding)"))

}
# nocov end

renv_file_find <- function(path, predicate) {

  # canonicalize path
  # (note: don't normalize as we don't want to follow symlinks)
  path <- renv_path_canonicalize(path)
  parent <- dirname(path)

  # compute number of slashes (avoid searching beyond home directory)
  slashes <- gregexpr("/", path, fixed = TRUE)[[1L]]
  n <- length(slashes) - 2L

  for (i in 1:n) {

    if (file.exists(path)) {
      status <- predicate(path)
      if (!is.null(status))
        return(status)
    }

    path <- parent
    parent <- dirname(path)

  }

  predicate(path)

}

renv_file_read <- function(path) {
  contents <- readLines(path, warn = FALSE, encoding = "UTF-8")
  paste(contents, collapse = "\n")
}

renv_file_shebang <- function(path) {

  # NOTE: we use 'condition' as a cheap way to capture both errors and warnings
  # since 'file()' may just report a warning rather than an error if it fails
  # to open a file due to inadequate permissions
  tryCatch(
    renv_file_shebang_impl(path),
    condition = function(e) ""
  )

}

renv_file_shebang_impl <- function(path) {

  # open connection to file
  con <- file(path, open = "rb", encoding = "native.enc")
  on.exit(close(con), add = TRUE)

  # validate file starts with '#!' -- read using 'raw' vector to avoid
  # issues which files that might start with null bytes
  bytes <- readBin(con, what = "raw", n = 2L)
  expected <- as.raw(c(0x23L, 0x21L))
  if (!identical(bytes, expected))
    return("")

  # read a single line from the connection
  readLines(con, n = 1L, warn = FALSE)

}

# here, 'broken' implies a file which is a link pointing to a file that
# doesn't exist, so only returns true if the file is "link"-y and the
# file it points to doesn't exist
renv_file_broken <- function(paths) {
  if (renv_platform_unix())
    renv_file_broken_unix(paths)
  else
    renv_file_broken_win32(paths)
}

renv_file_broken_unix <- function(paths) {
  # a symlink is broken if:
  # - the file is a symlink (tested via Sys.readlink)
  # - the file it points to does not exist (tested via file.exists)
  !is.na(Sys.readlink(paths)) & !file.exists(paths)
}

renv_file_broken_win32 <- function(paths) {
  # TODO: the behavior of file.exists() for a broken junction point
  # appears to have changed in the development version of R;
  # we have to be extra careful here...
  if (getRversion() < "4.2.0") {
    info <- renv_file_info(paths)
    (info$isdir %in% TRUE) & is.na(info$mtime)
  } else {
    file.access(paths, mode = 0L) == 0L & !file.exists(paths)
  }
}

renv_file_size <- function(path) {
  file.info(path, extra_cols = FALSE)$size
}

renv_file_remove <- function(paths) {
  if (renv_platform_windows())
    renv_file_remove_win32(paths)
  else
    renv_file_remove_unix(paths)
}

renv_file_remove_win32 <- function(paths) {
  for (path in paths) {
    command <- paste("rmdir /S /Q", renv_shell_path(path))
    shell(command)
  }
}

renv_file_remove_unix <- function(paths) {
  unlink(paths, recursive = TRUE, force = TRUE)
}

renv_file_writable <- function(path) {

  # allow users to opt-out just in case
  override <- getOption("renv.download.check_writable", default = TRUE)
  if (!identical(override, TRUE))
    return(TRUE)

  # if we're given the path to a file, use the parent directory instead
  info <- renv_file_info(path)
  if (!identical(info$isdir, TRUE))
    path <- dirname(path)

  # if we still don't have a directory, bail
  info <- renv_file_info(path)
  if (!identical(info$isdir, TRUE))
    return(FALSE)

  # try creating and removing a temporary file in this directory
  tfile <- tempfile(".renv-write-test-", tmpdir = path)
  ok <- dir.create(tfile, showWarnings = FALSE)
  on.exit(unlink(tfile, recursive = TRUE), add = TRUE)

  # return ok if we succeeded
  ok

}

renv_git_preflight <- function() {
  if (!nzchar(Sys.which("git")))
    stopf("'git' is not available on the PATH")
}

renv_git_root <- function(project) {

  project <- normalizePath(project, winslash = "/", mustWork = FALSE)
  renv_file_find(project, function(parent) {
    gitroot <- file.path(parent, ".git")
    if (file.exists(gitroot))
      return(gitroot)
  })

}

`_renv_globals` <- new.env(parent = emptyenv())

renv_global <- function(name, value) {
  (`_renv_globals`[[name]]) %||% (`_renv_globals`[[name]] <- value)
}

renv_global_get <- function(name) {
  `_renv_globals`[[name]]
}

renv_global_set <- function(name, value) {
  `_renv_globals`[[name]] <- value
}

renv_global_clear <- function(name) {
  if (exists(name, envir = `_renv_globals`, inherits = FALSE))
    rm(list = name, envir = `_renv_globals`, inherits = FALSE)
}


#' Generate a Package Dependency Graph
#'
#' Generate a package dependency graph.
#'
#' @inheritParams renv-params
#'
#' @param root The top-most package dependencies of interest in the dependency graph.
#'
#' @param leaf The bottom-most package dependencies of interest in the dependency graph.
#'
#' @param suggests Should suggested packages be included within
#'   the dependency graph?
#'
#' @param enhances Should enhanced packages be included within
#'   the dependency graph?
#'
#' @param resolver An \R function accepting a package name, and returning the
#'   contents of its `DESCRIPTION` file (as an \R `data.frame` or `list`).
#'   When `NULL` (the default), an internal resolver is used.
#'
#' @param renderer Which package should be used to render the resulting graph?
#'
#' @param attributes An \R list of graphViz attributes, mapping node names to
#'   attribute key-value pairs. For example, to ask graphViz to prefer orienting
#'   the graph from left to right, you can use
#'   `list(graph = c(rankdir = "LR"))`. See <https://graphviz.org/doc/info/attrs.html>
#'   for a full list of the attributes supported by `graphViz`.
#'
#' @examples
#'
#' \dontrun{
#' # graph the relationship between devtools and rlang
#' graph(root = "devtools", leaf = "rlang")
#'
#' # figure out why a project depends on 'askpass'
#' graph(leaf = "askpass")
#' }
#'
#' @keywords internal
graph <- function(root = NULL,
                  leaf = NULL,
                  ...,
                  suggests   = FALSE,
                  enhances   = FALSE,
                  resolver   = NULL,
                  renderer   = c("DiagrammeR", "visNetwork"),
                  attributes = list(),
                  project    = NULL)
{
  renv_scope_error_handler()
  project <- renv_project_resolve(project)

  # figure out packages to try and read
  root <- root %||% renv_graph_roots(project)

  # resolve fields
  fields <- c(
    "Depends", "Imports", "LinkingTo",
    if (suggests) "Suggests",
    if (enhances) "Enhances"
  )

  # resolve renderer
  renderer <- renv_graph_renderer(renderer)

  # find dependencies
  envir <- new.env(parent = emptyenv())
  revdeps <- new.env(parent = emptyenv())
  for (package in root)
    renv_graph_build(package, fields, resolver, envir, revdeps)

  # prune the tree
  tree <- renv_graph_prune(root, leaf, envir, revdeps)

  # compute the graph
  graph <- enumerate(tree, function(package, dependencies) {

    enumerate(dependencies, function(field, packages) {
      attrs <- renv_graphviz_attrs(field, renderer)
      renv_graphviz_edge(package, packages, attrs)
    })

  })

  # figure out which packages remain part of the graph after pruning
  ok <- map_lgl(graph, function(items) {
    any(map_int(items, length) > 0)
  })

  remaining <- intersect(root, names(graph)[ok])
  if (empty(remaining)) {
    fmt <- "* Could not find any relationship between the requested packages."
    vwritef(fmt)
    return(invisible(NULL))
  }

  defaults <- renv_graphviz_defaults(renderer)
  attributes <- modifyList(defaults, attributes)

  # render attributes
  attrtext <- renv_graphviz_render(attributes, TRUE)

  # fill package names which are top-level dependencies
  topattrs <- renv_graphviz_render(
    map(named(remaining), function(name) {
      list(
        style     = "filled",
        fillcolor = "#b3cde3"
      )
    }),
    asis = FALSE
  )

  botattrs <- renv_graphviz_render(
    map(named(leaf), function(name) {
      list(
        style     = "filled",
        fillcolor = "#ccebc5"
      )
    }),
    asis = FALSE
  )

  # collapse into text
  parts <- c(
    'digraph {', '',
    attrtext, '',
    topattrs, '',
    botattrs, '',
    unlist(graph), '',
    '}'
  )

  diagram <- paste(parts, collapse = "\n")

  renderer <- case(

    identical(renderer, "DiagrammeR") ~ function(dot) {
      DiagrammeR <- renv_namespace_load("DiagrammeR")
      DiagrammeR$grViz(diagram = dot)
    },

    identical(renderer, "visNetwork") ~ function(dot) {

      visNetwork <- renv_namespace_load("visNetwork")
      graph <- visNetwork$visNetwork(dot = dot)

      graph$x$options$edges$font$background <- "white"

      # TODO: allow hierarchical layout via option?
      # graph$x$options$layout = list(
      #   hierarchical = list(
      #     blockShifting   = TRUE,
      #     levelSeparation = 50,
      #     nodeSpacing     = 1,
      #     shakeTowards    = "roots",
      #     sortMethod      = "directed"
      #   )
      # )

      graph

    },

    is.function(renderer) ~ renderer,

    ~ stop("unrecognized renderer")

  )

  renderer(diagram)
}

renv_graph_build <- function(package, fields, resolver, envir, revdeps) {

  # check if we've already scanned this package
  if (exists(package, envir = envir))
    return()

  # read package dependencies
  deps <- renv_graph_dependencies(package, fields, resolver)

  # add dependencies to graph
  assign(package, deps, envir = envir)

  # recurse
  children <- sort(unique(unlist(deps)))
  for (child in children) {
    assign(child, c(package, revdeps[[child]]), envir = revdeps)
    renv_graph_build(child, fields, resolver, envir, revdeps)
  }

}

renv_graph_revdeps <- function(packages, revdeps) {

  envir <- new.env(parent = emptyenv())
  for (package in packages)
    renv_graph_revdeps_impl(package, envir, revdeps)

  ls(envir = envir)

}

renv_graph_revdeps_impl <- function(package, envir, revdeps) {

  if (visited(package, envir))
    return()

  for (child in revdeps[[package]])
    renv_graph_revdeps_impl(child, envir, revdeps)

}

renv_graph_roots <- function(project) {

  deps <- dependencies(project, quiet = TRUE)
  sort(unique(deps$Package))

}

renv_graph_dependencies <- function(package, fields, resolver) {

  base <- renv_installed_packages_base()

  desc <- local({

    # try using the resolver if supplied
    if (!is.null(resolver)) {
      desc <- catch(resolver(package))
      if (inherits(desc, "error"))
        warning(desc)
      else if (!is.null(desc))
        return(desc)
    }

    # check for (and prefer) a locally-installed package
    path <- renv_package_find(package)
    if (nzchar(path))
      return(renv_description_read(path))

    # otherwise, try and see if this is a known CRAN package
    as.list(renv_available_packages_entry(package))

  })

  # parse the fields
  values <- map(fields, function(field) {

    item <- desc[[field]]
    if (is.null(item))
      return(NULL)

    parsed <- renv_description_parse_field(item)
    packages <- parsed$Package

    setdiff(packages, c("R", base$Package))

  })

  names(values) <- fields
  values

}

renv_graph_prune <- function(root, leaf, envir, revdeps) {

  # grab all computed dependencies
  all <- as.list(envir)

  # if we don't have any leaves, then just return everything
  if (empty(leaf))
    return(all)

  # otherwise, find recursive dependencies of the requested packages
  rrd <- renv_graph_revdeps(leaf, revdeps)
  map(all, function(children) {
    map(children, intersect, rrd)
  })

}

renv_graphviz_node <- function(nodes, asis, attrs) {

  keys <- names(attrs)
  vals <- renv_json_quote(attrs)
  attrtext <- paste(keys, vals, sep = "=", collapse = ", ")

  fmt <- if (asis) '%s [%s]' else '"%s" [%s]'
  sprintf(fmt, nodes, attrtext)

}

renv_graphviz_edge <- function(lhs, rhs, attrs) {

  if (empty(lhs) || empty(rhs))
    return(character())

  keys <- names(attrs)
  vals <- renv_json_quote(attrs)
  attrtext <- paste(keys, vals, sep = "=", collapse = ", ")

  fmt <- '"%s" -> "%s" [%s]'
  sprintf(fmt, lhs, rhs, attrtext)

}

renv_graphviz_attrs <- function(field, renderer) {

  dil <- "#c0c0c0"

  defaults <- list(

    Depends = list(
      color = dil,
      style = "solid"
    ),

    Imports = list(
      color = dil,
      style = "solid"
    ),

    LinkingTo = list(
      color = dil,
      style = "dashed"
    ),

    Suggests = list(
      color = "darkgreen",
      style = "dashed"
    ),

    Enhances = list(
      color = "darkblue",
      style = "dashed"
    )

  )

  attrs <- defaults[[field]]
  if (identical(renderer, "visNetwork")) {

    extra <- c(
      font.align = "middle"
    )

    attrs <- c(attrs, extra)

  }

  attrs

}

renv_graphviz_defaults <- function(renderer) {

  case(
    identical(renderer, "visNetwork") ~ renv_graphviz_defaults_visnetwork(),
    identical(renderer, "DiagrammeR") ~ renv_graphviz_defaults_diagrammer(),
  )

}

renv_graphviz_defaults_visnetwork <- function() {

  list(

    node = list(
      style     = "filled",
      shape     = "ellipse",
      color     = "black",
      fillcolor = "#e5d8bd",
      fontname  = "Helvetica"
    )

  )

}

renv_graphviz_defaults_diagrammer <- function() {

  list(

    graph = list(
      nodesep = 0.10
    ),

    node = list(
      style     = "filled",
      shape     = "ellipse",
      fillcolor = "#e5d8bd",
      fontname  = "Helvetica"
    )

  )

}

renv_graphviz_render <- function(attributes, asis) {

  rendered <- enumerate(attributes, function(key, value) {

    if (is.null(names(value))) {
      lhs <- if (asis) key else renv_json_quote(key)
      rhs <- renv_graphviz_render_value(value)
      if (length(lhs) && length(rhs))
        paste(lhs, rhs, sep = " = ")
    } else {
      keys <- names(value)
      vals <- renv_graphviz_render_value(value)
      fmt <- if (asis) '%s [%s]' else '"%s" [%s]'
      sprintf(fmt, key, paste(keys, vals, sep = "=", collapse = ", "))
    }

  })

  unlist(rendered, recursive = TRUE, use.names = FALSE)

}

renv_graphviz_render_value <- function(value) {
  if (is.numeric(value))
    format(value)
  else if (is.logical(value))
    tolower(as.character(value))
  else
    renv_json_quote(value)
}

renv_graph_renderer <- function(renderer) {

  # allow functions as-is
  if (is.function(renderer))
    return(renderer)

  # otherwise, match
  renderer <- match.arg(renderer, choices = c("DiagrammeR", "visNetwork"))
  if (!renv_package_installed(renderer)) {
    fmt <- "package '%s' is required to render graphs but is not installed"
    stopf(fmt, renderer)
  }

  renderer

}


renv_hash_text <- function(text) {
  renv_bootstrap_hash_text(text)
}

renv_hash_description <- function(path) {
  filebacked("hash", path, renv_hash_description_impl)
}

renv_hash_description_impl <- function(path) {

  dcf <- case(
    is.character(path) ~ renv_description_read(path),
    is.list(path)      ~ path,
    ~ stop("unexpected path '%s'", path)
  )

  # include default fields
  fields <- c(
    "Package", "Version", "Title", "Author", "Maintainer", "Description",
    "Depends", "Imports", "Suggests", "LinkingTo"
  )

  # add remotes fields
  remotes <- renv_hash_description_remotes(dcf)

  # retrieve these fields
  subsetted <- dcf[renv_vector_intersect(c(fields, remotes), names(dcf))]

  # sort names (use C locale to ensure consistent ordering)
  ordered <- local({
    renv_scope_locale("LC_COLLATE", "C")
    subsetted[sort(names(subsetted))]
  })

  # write to tempfile (use binary connection to ensure unix-style
  # newlines for cross-platform hash stability)
  tempfile <- tempfile("renv-description-hash-")
  contents <- paste(names(ordered), ordered, sep = ": ", collapse = "\n")

  # remove whitespace -- it's possible that tools (e.g. Packrat) that
  # mutate a package's DESCRIPTION file may also inadvertently change
  # the structure of whitespace within some fields; that whitespace is
  # normally not semantically meaningful so we remove that so such
  # DESCRIPTIONS can obtain the same hash value. (this ultimately
  # arises as 'write.dcf()' allows both 'indent' and 'width' to be
  # configured based on the 'width' option)
  contents <- gsub("[[:space:]]", "", contents)

  # create the file connection (use binary so that unix newlines are used
  # across platforms, for more stable hashing)
  con <- file(tempfile, open = "wb")

  # write to the file
  writeLines(enc2utf8(contents), con = con, useBytes = TRUE)

  # flush to ensure we've written to file
  flush(con)

  # close the connection and remove the file
  close(con)

  # ready for hasing
  hash <- unname(tools::md5sum(tempfile))

  # remove the old file
  unlink(tempfile)

  # return hash
  invisible(hash)

}

renv_hash_description_remotes <- function(dcf) {

  type <- dcf[["RemoteType"]]
  if (is.null(type))
    return(character())

  if (type == "standard")
    return(character())

  grep("^Remote", names(dcf), value = TRUE)

}

#' View Lockfile History
#'
#' Use your version control system to find prior versions of the `renv.lock`
#' file that have been used in your project.
#'
#' The `history()` function is currently only implemented for projects using
#' `git` for version control.
#'
#' @inherit renv-params
#'
#' @export
#'
#' @return An \R `data.frame`, summarizing the commits in which `renv.lock`
#'   has been mutated.
#'
#' @example examples/examples-history.R
history <- function(project = NULL) {

  renv_scope_error_handler()

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  lockpath <- renv_lockfile_path(project)
  if (!file.exists(lockpath))
    return(data.frame())

  renv_git_preflight()

  owd <- setwd(project)
  on.exit(setwd(owd), add = TRUE)

  args <- c("log", "--pretty=format:%H\031%at\031%ct\031%s", renv_shell_path(lockpath))
  data <- renv_system_exec("git", args, action = "retrieving git log")

  parts <- strsplit(data, "\031", fixed = TRUE)
  tbl <- bind(parts, names = c("commit", "author_date", "committer_date", "subject"))
  tbl$author_date <- as.POSIXct(as.numeric(tbl$author_date), origin = "1970-01-01")
  tbl$committer_date <- as.POSIXct(as.numeric(tbl$committer_date), origin = "1970-01-01")

  tbl

}

#' Revert Lockfile
#'
#' Revert the lockfile to its contents at a prior commit.
#'
#' The `revert()` function is currently only implemented for projects using
#' `git` for version control.
#'
#' @inherit renv-params
#'
#' @param commit The commit associated with a prior version of the lockfile.
#' @param ... Optional arguments; currently unused.
#'
#' @return The commit used when reverting `renv.lock`. Note that this function
#'   is normally called for its side effects.
#'
#' @export
#'
#' @example examples/examples-history.R
revert <- function(commit = "HEAD", ..., project = NULL) {

  renv_scope_error_handler()
  renv_dots_check(...)

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  renv_git_preflight()

  owd <- setwd(project)
  on.exit(setwd(owd), add = TRUE)

  lockpath <- renv_lockfile_path(project = project)
  system2("git", c("checkout", commit, "--", renv_shell_path(lockpath)))
  system2("git", c("reset", "HEAD", renv_shell_path(lockpath)), stdout = FALSE, stderr = FALSE)
  system2("git", c("diff", "--", renv_shell_path(lockpath)))

  vwritef("* renv.lock from commit %s has been checked out.", commit)
  invisible(commit)

}

renv_homebrew_root <- function() {

  # allow override
  root <- Sys.getenv("RENV_HOMEBREW_ROOT", unset = NA)
  if (!is.na(root))
    return(root)

  # indirection for arm64 macOS
  if (renv_platform_macos() && renv_platform_machine() != "x86_64")
    return("/opt/homebrew")

  # default to /usr/local
  "/usr/local"

}

renv_http_useragent <- function() {
  agent <- getOption("renv.http.useragent", default = getOption("HTTPUserAgent"))
  agent %||% renv_http_useragent_default()
}

renv_http_useragent_default <- function() {
  version <- getRversion()
  platform <- with(R.version, paste(version, platform, arch, os))
  sprintf("R/%s R (%s)", version, platform)
}

#' Hydrate a Project
#'
#' Discover the \R packages used within a project, and then install those
#' packages into the active library. This effectively allows you to fork the
#' state of your default \R libraries for use within a project library.
#'
#' It may occasionally be useful to use `renv::hydrate()` to update the packages
#' used within a project that has already been initialized. However, be warned
#' that it's possible that the packages pulled in may not actually be compatible
#' with the packages installed in the project library, so you should exercise
#' caution when doing so.
#'
#' @section Sources:
#'
#' `hydrate()` attempts to re-use packages already installed on your system,
#' to avoid unnecessary attempts to download and install packages from remote
#' sources. When `NULL` (the default), `hydrate()` will attempt to discover \R
#' packages from the following sources (in order):
#'
#' - The user library,
#' - The site library,
#' - The system library,
#' - The `renv` cache.
#'
#' If package is discovered in one of these locations, `renv` will attempt to
#' copy or link that package into the requested library as appropriate.
#'
#' @section Missing Packages:
#'
#' If `renv` discovers that your project depends on \R packages not currently
#' installed in your user library, then it will attempt to install those
#' packages from the active R repositories.
#'
#' @inherit renv-params
#'
#' @param packages The set of \R packages to install. When `NULL`, the
#'   set of packages as reported by [dependencies()] is used.
#'
#' @param library The \R library to be hydrated. When `NULL`, the active
#'   library as reported by `.libPaths()` is used.
#'
#' @param update Boolean; should `hydrate()` attempt to update already-installed
#'   packages if the requested package is already installed in the project
#'   library? Set this to `"all"` if you'd like _all_ packages to be refreshed
#'   from the source library if possible.
#'
#' @param sources A set of library paths from which `renv` should attempt to
#'   draw packages. See **Sources** for more details.
#'
#' @return A named \R list, giving the packages that were used for hydration
#'   as well as the set of packages which were not found.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # hydrate the active library
#' renv::hydrate()
#'
#' }
hydrate <- function(packages = NULL,
                    ...,
                    library = NULL,
                    update  = FALSE,
                    sources = NULL,
                    project = NULL)
{
  renv_scope_error_handler()
  renv_dots_check(...)

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  library <- renv_path_normalize(library %||% renv_libpaths_default())
  packages <- packages %||% renv_hydrate_packages(project, sources)

  # find packages used in this project, and the dependencies of those packages
  deps <- renv_hydrate_dependencies(project, packages, sources)

  # remove 'renv' since it's managed separately
  deps$renv <- NULL

  # remove base + missing packages
  base <- renv_packages_base()
  na <- deps[is.na(deps)]
  packages <- deps[renv_vector_diff(names(deps), c(names(na), base))]

  # get and construct path to library
  ensure_directory(library)

  # only hydrate with packages that are either not currently installed,
  # or (if update = TRUE) the version in the library is newer
  packages <- renv_hydrate_filter(packages, library, update)

  # copy packages from user library to cache
  linkable <- renv_cache_linkable(project = project, library = library)
  if (linkable)
    renv_hydrate_link_packages(packages, library)
  else
    renv_hydrate_copy_packages(packages, library)

  # attempt to install missing packages (if any)
  missing <- renv_hydrate_resolve_missing(project, na)

  # we're done!
  result <- list(packages = packages, missing = missing)
  invisible(result)
}

renv_hydrate_filter <- function(packages, library, update) {

  # run filter
  keep <- enumerate(
    packages,
    renv_hydrate_filter_impl,
    library = library,
    update = update,
    FUN.VALUE = logical(1)
  )

  # filter based on kept packages
  packages[keep]

}

renv_hydrate_filter_impl <- function(package, path, library, update) {

  # if user has requested hydration of all packages, respect that
  if (identical(update, "all"))
    return(TRUE)

  # is the package already installed in the requested library?
  # if not, then we'll want to hydrate this package
  # if so, we'll want to compare the version first and
  # hydrate only if the requested version is newer than the current
  descpath <- file.path(library, package, "DESCRIPTION")
  desc <- catch(renv_description_read(path = descpath))
  if (inherits(desc, "error"))
    return(TRUE)

  # get the current package version
  current <- catch(numeric_version(desc[["Version"]]))
  if (inherits(current, "error"))
    return(TRUE)

  # if the package is already installed and we're not updating, stop here
  if (identical(update, FALSE))
    return(FALSE)

  # check to-be-copied package version
  requested <- catch({
    desc <- renv_description_read(path = path)
    numeric_version(desc[["Version"]])
  })

  # only hydrate with a newer version
  requested > current

}

renv_hydrate_packages_rprofile <- function() {

  enabled <-
    identical(config$user.profile(), TRUE) &&
    !renv_tests_running()

  if (!enabled)
    return()

  rprofile <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile")
  if (!file.exists(rprofile))
    return()

  dependencies(rprofile, quiet = TRUE, dev = TRUE)

}

renv_hydrate_packages <- function(project, libpaths = NULL) {

  deps <- dependencies(project, quiet = TRUE, dev = TRUE)

  profdeps <- renv_hydrate_packages_rprofile()
  if (length(deps) && length(profdeps))
    deps <- bind(list(deps, profdeps))

  unique(deps$Package)

}

renv_hydrate_dependencies <- function(project,
                                      packages = NULL,
                                      libpaths = NULL)
{
  vprintf("* Discovering package dependencies ... ")
  ignored <- renv_project_ignored_packages(project = project)
  packages <- renv_vector_diff(packages, ignored)
  libpaths <- libpaths %||% renv_hydrate_libpaths()
  all <- renv_package_dependencies(packages, project = project, libpaths = libpaths)
  vwritef("Done!")

  all
}

# NOTE: we don't want to look in user / site libraries when testing
# on CRAN, as we may accidentally find versions of packages available
# on CRAN but not that we want to use during tests
renv_hydrate_libpaths <- function() {

  conf <- config$hydrate.libpaths()
  if (is.character(conf) && length(conf))
    conf <- unlist(strsplit(conf, ":", fixed = TRUE))

  libpaths <- if (renv_tests_running())
    renv_libpaths_all()
  else if (length(conf))
    conf
  else
    c(renv_libpaths_user(), renv_libpaths_site(), renv_libpaths_system())

  libpaths <- .expand_R_libs_env_var(libpaths)
  normalizePath(libpaths, winslash = "/", mustWork = FALSE)

}

# takes a package called 'package' installed at location 'location',
# copies that package into the cache, and then links from the cache
# to the (private) library 'library'
renv_hydrate_link_package <- function(package, location, library) {

  # construct path to cache
  record <- renv_snapshot_description(location)
  cache <- renv_cache_find(record)
  if (!nzchar(cache))
    return(FALSE)

  # copy package into the cache
  if (!file.exists(cache)) {
    ensure_parent_directory(cache)
    renv_file_copy(location, cache)
  }

  # link package back from cache to library
  target <- file.path(library, package)
  ensure_parent_directory(target)
  renv_file_link(cache, target, overwrite = TRUE)

}

renv_hydrate_link_packages <- function(packages, library) {
  vprintf("* Copying packages into the cache ... ")
  callback <- renv_progress_callback(renv_hydrate_link_package, length(packages))
  cached <- enumerate(packages, callback, library = library)
  vwritef("Done!")
  cached
}

# takes a package called 'package' installed at location 'location',
# and copies it to the library 'library'
renv_hydrate_copy_package <- function(package, location, library) {
  target <- file.path(library, package)
  renv_file_copy(location, target, overwrite = TRUE)
}

renv_hydrate_copy_packages <- function(packages, library) {
  vprintf("* Copying packages into the library ... ")
  callback <- renv_progress_callback(renv_hydrate_copy_package, length(packages))
  copied <- enumerate(packages, callback, library = library)
  vwritef("Done!")
  copied
}

renv_hydrate_resolve_missing <- function(project, na) {

  # resolve library paths
  library <- renv_paths_library(project = project)
  libpaths <- renv_libpaths_resolve(library)
  renv_scope_libpaths(libpaths)

  # figure out which packages are missing (if any)
  packages <- names(na)
  installed <- renv_installed_packages(lib.loc = libpaths)
  if (all(packages %in% installed$Package))
    return()

  vwritef("* Resolving missing dependencies  ... ")

  # define a custom error handler for packages which
  # we failed to retrieve
  errors <- stack()
  handler <- function(package, action) {
    error <- catch(action)
    if (inherits(error, "error"))
      errors$push(list(package = package, error = error))
  }

  # perform the restore
  renv_scope_restore(
    project  = project,
    library  = library,
    packages = packages,
    handler  = handler
  )

  records <- retrieve(packages)
  renv_install_impl(records)

  # if we failed to restore anything, warn the user
  data <- errors$data()
  if (empty(data))
    return()

  if (renv_verbose()) {

    text <- map_chr(data, function(item) {
      package <- item$package
      message <- conditionMessage(item$error)
      short <- trunc(paste(message, collapse = ";"), 60L)
      sprintf("[%s]: %s", package, short)
    })

    renv_pretty_print(
      text,
      "The following package(s) were not installed successfully:",
      "You may need to manually download and install these packages.",
      wrap = FALSE
    )

  }

  invisible(data)

}

renv_id_path <- function(project) {
  file.path(project, "renv/project-id")
}

renv_id_generate <- function() {

  methods <- list(
    renv_id_generate_r,
    renv_id_generate_kernel,
    renv_id_generate_uuidgen,
    renv_id_generate_cscript,
    renv_id_generate_powershell,
    renv_id_generate_csc
  )

  for (method in methods) {
    id <- catch(method())
    if (is.character(id) && length(id) == 1 && nzchar(id)) {
      id <- toupper(id)
      return(id)
    }
  }

  stop("could not generate project id for this system")

}

renv_id_generate_kernel <- function() {

  uuidpath <- "/proc/sys/kernel/random/uuid"
  if (!file.exists(uuidpath)) {
    fmt <- "%s does not exist on this operating system"
    stopf(fmt, renv_path_pretty(uuidpath))
  }

  readLines(uuidpath, n = 1L, warn = FALSE)

}

renv_id_generate_uuidgen <- function() {

  if (!nzchar(Sys.which("uuidgen"))) {
    fmt <- "program %s does not exist on this system"
    stopf(fmt, shQuote("uuidgen"))
  }

  system("uuidgen", intern = TRUE)

}

renv_id_generate_cscript <- function() {

  if (!renv_platform_windows()) {
    fmt <- "this method is only available on Windows"
    stopf(fmt)
  }

  if (!nzchar(Sys.which("cscript.exe"))) {
    fmt <- "could not find cscript.exe"
    stopf(fmt)
  }

  # create temporary directory
  dir <- tempfile("renv-id-")
  dir.create(dir)
  on.exit(unlink(dir, recursive = TRUE), add = TRUE)

  # move to it
  owd <- setwd(dir)
  on.exit(setwd(owd), add = TRUE)

  # write helper script
  script <- c(
    "set object = CreateObject(\"Scriptlet.TypeLib\")",
    "WScript.StdOut.WriteLine object.GUID"
  )

  # invoke it
  writeLines(script, con = "uuid.vbs")
  args <- c("//NoLogo", "uuid.vbs")
  id <- renv_system_exec("cscript.exe", args, "generating UUID")

  # remove braces
  gsub("(?:^\\{|\\}$)", "", id)

}

renv_id_generate_powershell <- function() {

  if (!renv_platform_windows()) {
    fmt <- "this method is only available on Windows"
    stopf(fmt)
  }

  if (!nzchar(Sys.which("powershell.exe"))) {
    fmt <- "could not find powershell.exe"
    stopf(fmt)
  }

  command <- "[guid]::NewGuid().ToString()"
  args <- c("-Command", shQuote(command))
  renv_system_exec("powershell.exe", args, "generating UUID")

}

renv_id_generate_r <- function() {

  if ("uuid" %in% loadedNamespaces())
    return(uuid::UUIDgenerate())

  libpaths <- c(
    .libPaths(),
    renv_libpaths_user(),
    renv_libpaths_site(),
    renv_libpaths_system()
  )

  if (!requireNamespace("uuid", lib.loc = libpaths, quietly = TRUE))
    stop("could not load package 'uuid'")

  id <- uuid::UUIDgenerate()
  catchall(unloadNamespace("uuid"))
  id

}

renv_id_generate_csc <- function() {

  csc <- local({

    csc <- Sys.which("csc.exe")
    if (nzchar(csc))
      return(csc)

    frameworks <- file.path(
      Sys.getenv("SYSTEMDRIVE", unset = "C:"),
      "Windows/Microsoft.NET",
      c("Framework", "Framework64")
    )

    versions <- list.files(frameworks, full.names = TRUE)
    candidates <- file.path(versions, "csc.exe")
    candidates[file.exists(candidates)]

  })

  if (empty(csc) || !file.exists(csc))
    stop("could not find csc.exe")


  code <- "
class GenerateUUID {
  static void Main(string[] args) {
    System.Console.WriteLine(System.Guid.NewGuid().ToString());
  }
}
"

  renv_scope_tempdir("renv-uuid-")
  writeLines(code, con = "program.cs")

  renv_system_exec(
    csc[[1]],
    c("/nologo", "/out:program.exe", "program.cs"),
    "compiling uuid helper"
  )

  renv_system_exec("program.exe", character(), "generating uuid")

}

#' Imbue an renv Installation
#'
#' Imbue an `renv` installation into a project, thereby making the requested
#' version of `renv` available within.
#'
#' Normally, this function does not need to be called directly by the user; it
#' will be invoked as required by [init()] and [activate()].
#'
#' @inherit renv-params
#'
#' @param version The version of `renv` to install. If `NULL`, the version
#'   of `renv` currently installed will be used. The requested version of
#'   `renv` will be retrieved from the `renv` public GitHub repository,
#'   at <https://github.com/rstudio/renv>.
#'
#' @param quiet Boolean; avoid printing output during install of `renv`?
#'
imbue <- function(project = NULL,
                  version = NULL,
                  quiet   = FALSE)
{
  renv_scope_error_handler()
  project <- renv_project_resolve(project)

  renv_scope_options(renv.verbose = !quiet)

  vtext <- version %||% renv_package_version("renv")
  vwritef("Installing renv [%s] ...", vtext)
  status <- renv_imbue_impl(project, version)
  vwritef("* Done! renv has been successfully installed.")

  invisible(status)

}

renv_imbue_impl <- function(project, version = NULL, force = FALSE) {

  # don't imbue during tests unless explicitly requested
  if (renv_tests_running() && !force)
    return(NULL)

  # NULL version means imbue this version of renv
  if (is.null(version))
    return(renv_imbue_self(project))

  # otherwise, try to download and install the requested version
  # of renv from GitHub
  remote <- paste("rstudio/renv", version %||% "main", sep = "@")
  record <- renv_remotes_resolve(remote)
  records <- list(renv = record)

  renv_scope_restore(
    project = project,
    library = renv_libpaths_default(),
    records = records,
    packages = "renv",
    recursive = FALSE
  )

  # retrieve renv
  records <- retrieve("renv")
  record <- records[[1]]

  # ensure renv is installed into project library
  library <- renv_paths_library(project = project)
  ensure_directory(library)
  renv_scope_libpaths(library)

  vwritef("Installing renv [%s] ...", version)
  with(record, r_cmd_install(Package, Path, library))
  vwritef("\tOK [built source]")

  invisible(record)

}

renv_imbue_self <- function(project) {

  # construct source, target paths
  source <- renv_namespace_path("renv")
  if (!file.exists(source))
    source <- renv_package_find("renv")

  if (!file.exists(source))
    stop("internal error: could not find where 'renv' is installed")

  target <- renv_paths_library("renv", project = project)
  if (renv_file_same(source, target))
    return(TRUE)

  type <- renv_package_type(source, quiet = TRUE)
  switch(type,
         source = renv_imbue_self_source(source, target),
         binary = renv_imbue_self_binary(source, target))

  renv_snapshot_description(target)

}

renv_imbue_self_source <- function(source, target) {

  # if the package already exists, just skip
  if (file.exists(target))
    return(TRUE)

  # otherwise, install it
  library <- dirname(target)
  ensure_directory(library)
  r_cmd_install("renv", source, library)

}

renv_imbue_self_binary <- function(source, target) {
  ensure_parent_directory(target)
  renv_file_copy(source, target, overwrite = TRUE)
}

#' @importFrom utils
#'   adist available.packages browseURL citation contrib.url download.file
#'   download.packages file.edit getCRANmirrors head help install.packages
#'   installed.packages modifyList old.packages packageDescription
#'   packageVersion read.table remove.packages sessionInfo str tail tar
#'   toBibtex untar update.packages unzip URLencode zip
NULL

# tools for writing / removing renv-related infrastructure
renv_infrastructure_write <- function(project = NULL,
                                      profile = NULL,
                                      version = NULL)
{
  project <- renv_project_resolve(project)

  renv_infrastructure_write_profile(project, profile = profile)
  renv_infrastructure_write_rprofile(project)
  renv_infrastructure_write_rbuildignore(project)
  renv_infrastructure_write_gitignore(project)
  renv_infrastructure_write_activate(project, version = version)
}

renv_infrastructure_write_profile <- function(project, profile = NULL) {

  path <- renv_paths_renv("profile", profile = FALSE, project = project)
  profile <- renv_profile_normalize(profile)
  if (is.null(profile))
    return(unlink(path))

  ensure_parent_directory(path)
  writeLines(profile, con = path)

}

renv_infrastructure_write_rprofile <- function(project) {

  if (!config$autoloader.enabled())
    return()

  # NOTE: intentionally leave project NULL to compute relative path
  path <- renv_paths_activate(project = NULL)
  add <- sprintf("source(%s)", renv_json_quote(path))

  renv_infrastructure_write_entry_impl(
    add    = add,
    remove = character(),
    file   = file.path(project, ".Rprofile"),
    create = TRUE
  )

}

renv_infrastructure_write_rbuildignore <- function(project) {

  lines <- c("^renv$", "^renv\\.lock$")
  if (file.exists(file.path(project, "requirements.txt")))
    lines <- c(lines, "^requirements\\.txt$")
  if (file.exists(file.path(project, "environment.yml")))
    lines <- c(lines, "^environment\\.yml$")

  renv_infrastructure_write_entry_impl(
    add    = lines,
    remove = character(),
    file   = file.path(project, ".Rbuildignore"),
    create = renv_project_type(project) == "package"
  )

}

renv_infrastructure_write_gitignore <- function(project) {

  add    <- stack(mode = "character")
  remove <- stack(mode = "character")

  stk <- if (settings$vcs.ignore.library()) add else remove
  stk$push("library/")

  stk <- if (settings$vcs.ignore.local()) add else remove
  stk$push("local/")

  stk <- if (settings$vcs.ignore.cellar()) add else remove
  stk$push("cellar/")

  add$push("lock/", "python/", "staging/")

  renv_infrastructure_write_entry_impl(
    add    = as.character(add$data()),
    remove = as.character(remove$data()),
    file   = renv_paths_renv(".gitignore", project = project),
    create = TRUE
  )

}

renv_infrastructure_write_activate <- function(project = NULL,
                                               version = NULL,
                                               create  = TRUE)
{
  project <- renv_project_resolve(project)
  version <- version %||% renv_activate_version(project)

  source <- system.file("resources/activate.R", package = "renv")
  target <- renv_paths_activate(project = project)

  if (!create && !file.exists(target))
    return(FALSE)

  template <- renv_file_read(source)
  new <- renv_template_replace(template, list(VERSION = version))

  if (file.exists(target)) {
    old <- renv_file_read(target)
    if (old == new)
      return(TRUE)
  }

  ensure_parent_directory(target)
  writeLines(new, con = target)
}


renv_infrastructure_write_entry_impl <- function(add, remove, file, create) {

  # check to see if file doesn't exist
  if (!file.exists(file)) {

    # if we're not forcing file creation, just bail
    if (!create)
      return(TRUE)

    # otherwise, write the file
    ensure_parent_directory(file)
    writeLines(add, file)
    return(TRUE)

  }

  # if the file already has the requested line, nothing to do
  before <- readLines(file, warn = FALSE)
  after <- before

  # add requested entries
  for (item in rev(add)) {

    # check to see if the requested line exists (either commented
    # or uncommented). if it exists, we'll attempt to uncomment
    # any commented lines
    cpattern <- sprintf("^\\s*#?\\s*\\Q%s\\E\\s*(?:#|\\s*$)", item)
    matches <- grepl(cpattern, after, perl = TRUE)
    if (any(matches))
      after[matches] <- gsub("^(\\s*)#\\s*", "\\1", after[matches])
    else
      after <- c(item, after)

  }

  # remove requested entries
  for (item in rev(remove)) {
    pattern <- sprintf("^\\s*\\Q%s\\E\\s*(?:#|\\s*$)", item)
    matches <- grepl(pattern, after, perl = TRUE)
    if (any(matches)) {
      replacement <- gsub("^(\\s*)", "\\1# ", after[matches], perl = TRUE)
      after[matches] <- replacement
    }
  }

  # write to file if we have changes
  if (!identical(before, after))
    writeLines(after, file)

  TRUE

}



renv_infrastructure_remove <- function(project = NULL) {
  project <- renv_project_resolve(project)

  renv_infrastructure_remove_rprofile(project)
  renv_infrastructure_remove_rbuildignore(project)

  unlink(file.path(project, "renv"), recursive = TRUE)
}


renv_infrastructure_remove_rprofile <- function(project) {

  # NOTE: intentionally leave project NULL to compute relative path
  path <- renv_paths_activate(project = NULL)
  line <- sprintf("source(%s)", renv_json_quote(path))

  renv_infrastructure_remove_entry_impl(
    line      = line,
    file      = file.path(project, ".Rprofile"),
    removable = TRUE
  )

}

renv_infrastructure_remove_rbuildignore <- function(project) {

  renv_infrastructure_remove_entry_impl(
    line      = "^renv$",
    file      = file.path(project, ".Rbuildignore"),
    removable = FALSE
  )

}

renv_infrastructure_remove_entry_impl <- function(line, file, removable) {

  # if the file doesn't exist, nothing to do
  if (!file.exists(file))
    return(TRUE)

  # find and comment out the line
  contents <- readLines(file, warn = FALSE)
  pattern <- sprintf("^\\s*\\Q%s\\E\\s*(?:#|\\s*$)", line)
  matches <- grepl(pattern, contents, perl = TRUE)

  # if this file is removable, check to see if we matched all non-blank
  # lines; if so, remove the file
  if (removable) {
    rest <- contents[!matches]
    if (all(grepl("^\\s*$", rest)))
      return(unlink(file))
  }

  # otherwise, just mutate the file
  replacement <- gsub("^(\\s*)", "\\1# ", contents[matches], perl = TRUE)
  contents[matches] <- replacement
  writeLines(contents, file)

  TRUE

}



#' Initialize a Project
#'
#' Discover packages used within the current project, and then initialize a
#' project-local private \R library with those packages. The currently-installed
#' versions of any packages in use (as detected within the default R libraries)
#' are then installed to the project's private library.
#'
#' The primary steps taken when initializing a new project are:
#'
#' 1. \R package dependencies are discovered within the \R files used within
#'    the project with [dependencies()];
#'
#' 2. Discovered packages are copied into the `renv` global package cache, so
#'    these packages can be re-used across future projects as necessary;
#'
#' 3. Any missing \R package dependencies discovered are then installed into
#'    the project's private library;
#'
#' 4. A lockfile capturing the state of the project's library is created
#'    with [snapshot()];
#'
#' 5. The project is activated with [activate()].
#'
#' If `renv` sees that the associated project has already been initialized and
#' has a lockfile, then it will attempt to infer the appropriate action to take
#' based on the presence of a private library. If no library is available,
#' `renv` will restore the private library from the lockfile; if one is
#' available, `renv` will ask if you want to perform a 'standard' init,
#' restore from the lockfile, or activate the project without taking any
#' further action.
#'
#' @section Infrastructure:
#'
#' `renv` will write or amend the following files in the project:
#'
#' - `.Rprofile`: An auto-loader will be installed, so that new R sessions
#'   launched within the project are automatically loaded.
#'
#' - `renv/activate.R`: This script is run by the previously-mentioned
#'   `.Rprofile` to load the project.
#'
#' - `renv/.gitignore`: This is used to instruct Git to ignore the project's
#'   private library, as it should normally not be committed to a version
#'   control repository.
#'
#' - `.Rbuildignore`: to ensure that the `renv` directory is ignored during
#'   package development; e.g. when attempting to build or install a package
#'   using `renv`.
#'
#' @inherit renv-params
#'
#' @param project The project directory. The \R working directory will be
#'   changed to match the requested project directory.
#'
#' @param settings A list of [settings] to be used with the newly-initialized
#'   project.
#'
#' @param bare Boolean; initialize the project without attempting to discover
#'   and install R package dependencies?
#'
#' @param force Boolean; force initialization? By default, `renv` will refuse
#'   to initialize the home directory as a project, to defend against accidental
#'   mis-usages of `init()`.
#'
#' @param repos The \R repositories to be used in this project. By default,
#'   the active repositories (as determined by `getOption("repos")`) are used.
#'
#' @param bioconductor The version of Bioconductor to be used with this project.
#'   Setting this may be appropriate if `renv` is unable to determine that your
#'   project depends on a package normally available from Bioconductor. Set this
#'   to `TRUE` to use the default version of Bioconductor recommended by the
#'   `BiocManager` package.
#'
#' @param restart Boolean; attempt to restart the \R session after initializing
#'   the project? A session restart will be attempted if the `"restart"` \R
#'   option is set by the frontend embedding \R.
#'
#' @export
#'
#' @example examples/examples-init.R
init <- function(project = NULL,
                 ...,
                 profile      = NULL,
                 settings     = NULL,
                 bare         = FALSE,
                 force        = FALSE,
                 repos        = NULL,
                 bioconductor = NULL,
                 restart      = interactive())
{
  renv_consent_check()
  renv_scope_error_handler()
  renv_dots_check(...)

  project <- renv_path_normalize(project %||% getwd())
  renv_scope_lock(project = project)

  # initialize profile
  if (!is.null(profile))
    renv_profile_set(profile)

  # normalize repos
  repos <- renv_repos_normalize(repos %||% getOption("repos"))
  options(repos = repos)

  # initialize bioconductor pieces
  biocver <- renv_init_bioconductor(bioconductor, project)
  if (!is.null(biocver)) {
    vwritef("* Using Bioconductor version '%s'.", biocver)
    renv_scope_bioconductor(version = biocver)
    settings[["bioconductor.version"]] <- biocver
  }

  # prepare and move into project directory
  renv_init_validate_project(project, force)
  renv_init_settings(project, settings)
  setwd(project)

  # be quiet in RStudio projects (as we will normally restart automatically)
  quiet <- !is.null(getOption("restart"))

  # for bare inits, just activate the project
  if (bare)
    return(renv_init_fini(project, profile, version, restart, quiet))

  # collect dependencies
  renv_dependencies_scope(project, action = "init")

  # form path to lockfile, library
  library  <- renv_paths_library(project = project)
  lockfile <- renv_lockfile_path(project)

  # determine appropriate action
  action <- renv_init_action(project, library, lockfile, bioconductor)
  if (empty(action) || identical(action, "cancel")) {
    renv_report_user_cancel()
    return(invisible(FALSE))
  }

  # activate library paths for this project
  libpaths <- renv_libpaths_activate(project = project)

  # perform the action
  if (action == "init") {
    vwritef("* Initializing project ...")
    renv_imbue_impl(project)
    hydrate(project = project, library = library)
    snapshot(project = project, library = libpaths, repos = repos, prompt = FALSE)
  } else if (action == "restore") {
    vwritef("* Restoring project ... ")
    ensure_directory(library)
    restore(project = project, library = libpaths, prompt = FALSE)
  }

  # activate the newly-hydrated project
  renv_init_fini(project, profile, version, restart, quiet)

}

renv_init_fini <- function(project, profile, version, restart, quiet) {

  version <- renv_package_version("renv")

  renv_activate_impl(
    project = project,
    profile = profile,
    version = version,
    restart = restart,
    quiet   = quiet
  )

  invisible(project)

}

renv_init_action <- function(project, library, lockfile, bioconductor) {

  # if the user has asked for bioconductor, treat this as a re-initialization
  if (!is.null(bioconductor))
    return("init")

  # figure out appropriate action
  case(

    # if both the library and lockfile exist, ask user for intended action
    file.exists(lockfile)
      ~ renv_init_action_conflict_lockfile(project, library, lockfile),

    # if a private library exists but no lockfile, ask whether we should use it
    file.exists(library)
      ~ renv_init_action_conflict_library(project, library, lockfile),

    # otherwise, we just want to initialize the project
    ~ "init"

  )

}

renv_init_action_conflict_lockfile <- function(project, library, lockfile) {

  if (!interactive())
    return("nothing")

  title <- "This project already has a lockfile. What would you like to do?"
  choices <- c(
    restore = "Restore the project from the lockfile.",
    init    = "Discard the lockfile and re-initialize the project.",
    nothing = "Activate the project without snapshotting or installing any packages.",
    cancel  = "Abort project initialization."
  )

  selection <- tryCatch(
    utils::select.list(choices, title = title, graphics = FALSE),
    interrupt = identity
  )

  if (inherits(selection, "interrupt"))
    return(NULL)

  names(selection)

}

renv_init_action_conflict_library <- function(project, library, lockfile) {

  if (!interactive())
    return("nothing")

  title <- "This project already has a private library. What would you like to do?"
  choices <- c(
    nothing = "Activate the project and use the existing library.",
    init    = "Re-initialize the project with a new library.",
    cancel  = "Abort project initialization."
  )

  selection <- tryCatch(
    utils::select.list(choices, title = title, graphics = FALSE),
    interrupt = identity
  )

  if (inherits(selection, "interrupt"))
    return(NULL)

  names(selection)

}

renv_init_validate_project <- function(project, force) {

  # allow all project directories when force = TRUE
  if (force)
    return(TRUE)

  # disallow attempts to initialize renv in the home directory
  home <- path.expand("~/")
  msg <- if (renv_file_same(project, home))
    "refusing to initialize project in home directory"
  else if (renv_path_within(home, project))
    sprintf("refusing to initialize project in directory '%s'", project)

  if (!is.null(msg)) {
    msg <- paste(msg, "-- use renv::init(force = TRUE) to override")
    stopf(msg)
  }

}

renv_init_settings <- function(project, settings) {

  defaults <- renv_settings_get(project)
  merged <- renv_settings_merge(defaults, settings)
  renv_settings_persist(project, merged)
  invisible(merged)

}

renv_init_bioconductor <- function(bioconductor, project) {

  # if we're re-initializing a project that appears to depend
  # on Bioconductor, then use the latest Bioconductor release
  if (is.null(bioconductor)) {
    lockpath <- renv_paths_lockfile(project = project)
    if (file.exists(lockpath)) {
      lockfile <- renv_lockfile_read(lockpath)
      bioconductor <- !is.null(lockfile$Bioconductor)
    }
  }

  # resolve bioconductor argument
  case(
    is.character(bioconductor)     ~ bioconductor,
    identical(bioconductor, TRUE)  ~ renv_bioconductor_version(project, refresh = TRUE),
    identical(bioconductor, FALSE) ~ NULL
  )

}

#' Install Packages
#'
#' Install one or more \R packages, from a variety of remote sources.
#'
#' `install()` uses the same machinery as [restore()] when installing packages.
#' In particular, this means that the local cache of package installations is
#' used when possible. This helps to avoid re-downloading packages that have
#' already been downloaded before, and re-compiling packages from source when
#' a binary copy of that package is already available.
#'
#'
#' @section Project DESCRIPTION Files:
#'
#' If your project contains a `DESCRIPTION` file, then calling `install()`
#' without any arguments will instruct `renv` to install the latest versions of
#' all packages as declared within that `DESCRIPTION` file's `Depends`,
#' `Imports` and `LinkingTo` fields; similar to how an \R package might declare
#' its dependencies.
#'
#' If you have one or more packages that you'd like to install from a separate
#' remote source, this can be accomplished by adding a `Remotes:` field to the
#' `DESCRIPTION` file. See `vignette("dependencies", package = "devtools")`
#' for more details. Alternatively, view the vignette online at
#' <https://devtools.r-lib.org/articles/dependencies.html>.
#'
#' Note that `install()` does not use the project's `renv.lock` when determining
#' sources for packages to be installed. If you want to install packages using
#' the sources declared in the lockfile, consider using `restore()` instead.
#' Otherwise, you can declare the package sources in your `DESCRIPTION`'s
#' `Remotes:` field.
#'
#'
#' @section Remotes Syntax:
#'
#' `renv` supports a subset of the `remotes` syntax used for package installation,
#' as described in <https://remotes.r-lib.org/articles/dependencies.html>. See
#' the examples below for more details.
#'
#'
#' @section Bioconductor:
#'
#' Packages from Bioconductor can be installed by using the `bioc::` prefix.
#' For example,
#'
#' ```
#' renv::install("bioc::Biobase")
#' ```
#'
#' will install the latest-available version of `Biobase` from Bioconductor.
#'
#' `renv` depends on `BiocManager` (or, for older versions of \R, `BiocInstaller`)
#' for the installation of packages from Bioconductor. If these packages are
#' not available, `renv` will attempt to automatically install them before
#' fulfilling the installation request.
#'
#'
#' @section Package Configuration:
#'
#' Many \R packages have a `configure` script that needs to be run to prepare
#' the package for installation. Arguments and environment variables can be
#' passed through to those scripts in a manner similar to [install.packages].
#' In particular, the \R options `configure.args` and `configure.vars` can be
#' used to map package names to their appropriate configuration. For example:
#'
#' ```
#' # installation of RNetCDF may require us to set include paths for netcdf
#' configure.args = c(RNetCDF = "--with-netcdf-include=/usr/include/udunits2"))
#' options(configure.args = configure.args)
#' renv::install("RNetCDF")
#' ```
#'
#' This could also be specified as, for example,
#'
#' ```
#' options(
#'   configure.args.RNetCDF = "--with-netcdf-include=/usr/include/udunits2"
#' )
#' renv::install("RNetCDF")
#' ```
#'
#' Similarly, additional flags that should be passed to `R CMD INSTALL` can
#' be set via the `install.opts` \R option:
#'
#' ```
#' # installation of R packages using the Windows Subsystem for Linux
#' # may require the `--no-lock` flag to be set during install
#' options(install.opts = "--no-lock")
#' renv::install("xml2")
#' ```
#'
#' @inherit renv-params
#' @inheritParams install-params
#'
#' @return A named list of package records which were installed by `renv`.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # install the latest version of 'digest'
#' renv::install("digest")
#'
#' # install an old version of 'digest' (using archives)
#' renv::install("digest@@0.6.18")
#'
#' # install 'digest' from GitHub (latest dev. version)
#' renv::install("eddelbuettel/digest")
#'
#' # install a package from GitHub, using specific commit
#' renv::install("eddelbuettel/digest@@df55b00bff33e945246eff2586717452e635032f")
#'
#' # install a package from Bioconductor
#' # (note: requires the BiocManager package)
#' renv::install("bioc::Biobase")
#'
#' # install a package, specifying path explicitly
#' renv::install("~/path/to/package")
#'
#' # install packages as declared in the project DESCRIPTION file
#' renv::install()
#'
#' }
install <- function(packages = NULL,
                    ...,
                    library = NULL,
                    type    = NULL,
                    rebuild = FALSE,
                    repos   = NULL,
                    prompt  = interactive(),
                    project = NULL)
{
  renv_consent_check()
  renv_scope_error_handler()

  # allow user to provide additional package names as part of '...'
  dots <- list(...)
  names(dots) <- names(dots) %||% rep.int("", length(dots))
  packages <- c(packages, dots[!nzchar(names(dots))])

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  libpaths <- renv_libpaths_resolve(library)
  renv_scope_libpaths(libpaths)

  type <- type %||% getOption("pkgType")
  renv_scope_options(pkgType = type)

  # override repositories if requested
  repos <- repos %||% config$repos.override()
  if (length(repos))
    renv_scope_options(repos = repos)

  # get and resolve the packages / remotes to be installed
  remotes <- packages %||% renv_project_remotes(project)
  if (empty(remotes)) {
    vwritef("* There are no packages to install.")
    return(invisible(list()))
  }

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

    renv_pak_init(
      library = library,
      type    = type,
      rebuild = rebuild,
      project = project
    )

    packages <- if (is.list(remotes)) names(remotes) else remotes
    return(renv_pak_install(packages, libpaths))

  }

  # resolve remotes
  remotes <- lapply(remotes, renv_remotes_resolve)
  names(remotes) <- extract_chr(remotes, "Package")

  # update records with requested remotes
  records <- renv_snapshot_r_packages(libpaths = libpaths, project = project)
  records[names(remotes)] <- remotes

  # read remotes from the package DESCRIPTION file and use those to
  # update non-specific package requests
  records <- renv_install_remotes_update(records, project)

  if (!renv_install_preflight(project, libpaths, remotes, prompt)) {
    renv_report_user_cancel()
    return(invisible(list()))
  }

  # ensure package names are resolved if provided
  packages <- if (length(packages)) names(remotes)

  renv_scope_restore(
    project  = project,
    library  = renv_libpaths_default(),
    records  = records,
    packages = packages,
    rebuild  = rebuild
  )

  # retrieve packages
  records <- retrieve(names(remotes))
  if (empty(records)) {
    vwritef("* There are no packages to install.")
    return(invisible(list()))
  }

  # install retrieved records
  renv_install_impl(records)

  # a bit of extra test reporting
  if (renv_tests_running()) {
    fmt <- "Installed %i %s into library at path %s."
    vwritef(
      fmt,
      length(records),
      plural("package", length(records)),
      renv_path_pretty(renv_libpaths_default())
    )
  }

  # check loaded packages and inform user if out-of-sync
  renv_install_postamble(names(records))

  invisible(records)
}

renv_install_impl <- function(records) {

  staged <- renv_config_install_staged()

  if (staged)
    renv_install_staged(records)
  else
    renv_install_default(records)

  invisible(TRUE)

}

renv_install_staged <- function(records) {

  # get current libpaths
  libpaths <- renv_libpaths_all()

  # set up a dummy library path for installation
  templib <- renv_install_staged_library_path()
  on.exit(unlink(templib, recursive = TRUE), add = TRUE)
  renv_scope_libpaths(c(templib, libpaths))

  # perform the install
  renv_install_default(records)

  # migrate packages into true library
  library <- nth(libpaths, 1L)
  sources <- list.files(templib, full.names = TRUE)
  targets <- file.path(library, basename(sources))
  names(targets) <- sources
  enumerate(targets, renv_file_move, overwrite = TRUE)

  # clear filebacked cache entries
  descpaths <- file.path(targets, "DESCRIPTION")
  renv_filebacked_clear("DESCRIPTION", descpaths)
  renv_filebacked_clear("hash", descpaths)

  invisible(targets)

}

renv_install_staged_library_path_impl <- function() {

  # allow user configuration of staged library location

  # retrieve current project, library path
  staging <- Sys.getenv("RENV_PATHS_LIBRARY_STAGING", unset = NA)
  project <- Sys.getenv("RENV_PROJECT", unset = NA)
  libpath <- renv_libpaths_default()

  # determine root directory for staging
  root <- if (!is.na(staging))
    staging
  else if (!is.na(project))
    renv_paths_renv("staging", project = project)
  else
    file.path(libpath, ".renv")

  # attempt to create it
  ok <- catch(ensure_directory(root))
  if (inherits(ok, "error"))
    return(tempfile("renv-staging"))

  # resolve a unique staging directory in this path
  for (i in 1:100) {
    path <- file.path(root, i)
    if (dir.create(path, showWarnings = FALSE))
      return(path)
  }

  # all else fails, use tempfile
  tempfile("renv-staging")

}

# NOTE: on Windows, installing packages into very long paths
# can fail, as R's internal unzip utility does not handle
# long Windows paths well. in addition, an renv project's
# library path tends to be long, exasperating the issue.
# for that reason, we try to use a shorter staging directory
#
# part of the challenge here is that the R temporary directory
# and R library path might reside on different mounts, and so
# we may want to try and avoid installing on one mount and then
# copying to another mount (as that could be slow).
#
# note that using the renv folder might be counter-productive,
# since users will want to use renv in projects sync'ed via
# OneDrive and friends, and we don't want those to lock files
# in the staging directory
renv_install_staged_library_path <- function() {

  # compute path
  path <- renv_install_staged_library_path_impl()

  # create library directory
  ensure_directory(path)

  # try to make sure it has the same permissions as the library itself
  if (!renv_platform_windows()) {
    libpath <- renv_libpaths_default()
    umask <- Sys.umask("0")
    on.exit(Sys.umask(umask), add = TRUE)
    info <- renv_file_info(libpath)
    Sys.chmod(path, info$mode)
  }

  # return the created path
  return(path)

}

renv_install_default <- function(records) {
  state <- renv_restore_state()
  handler <- state$handler
  for (record in records) {
    package <- record$Package
    handler(package, renv_install_package(record))
  }
}

renv_install_package <- function(record) {

  # get active project (if any)
  state <- renv_restore_state()
  project <- state$project

  # figure out whether we can use the cache during install
  # use library path recorded in restore state as staged installs will have
  # mutated the library path, placing a staging library at the front
  library <- renv_restore_state("library")
  linkable <- renv_cache_linkable(project = project, library = library)
  linker <- if (linkable) renv_file_link else renv_file_copy

  cacheable <-
    renv_cache_config_enabled(project = project) &&
    renv_record_cacheable(record) &&
    !renv_restore_rebuild_required(record)

  if (cacheable) {

    # check for cache entry and install if there
    path <- renv_cache_find(record)
    if (renv_cache_package_validate(path))
      return(renv_install_package_cache(record, path, linker))

  }

  # install the package
  withCallingHandlers(
    renv_install_package_impl(record),
    error = function(e) {
      vwritef("\tFAILED")
      writef(e$output)
    }
  )

  path <- record$Path
  type <- renv_package_type(path, quiet = TRUE)

  feedback <- if (type == "binary") {
    if (renv_file_type(path, symlinks = FALSE) == "directory") {
      "copied local binary"
    } else {
      "installed binary"
    }
  } else {
    "built from source"
  }

  vwritef("\tOK [%s]", feedback)

  # link into cache
  if (renv_cache_config_enabled(project = project))
    renv_cache_synchronize(record, linkable = linkable)

}

renv_install_package_cache <- function(record, cache, linker) {

  if (renv_install_package_cache_skip(record, cache))
    return(TRUE)

  library <- renv_libpaths_default()
  target <- file.path(library, record$Package)

  # back up the previous installation if needed
  callback <- renv_file_backup(target)
  on.exit(callback(), add = TRUE)

  # report successful link to user
  fmt <- "Installing %s [%s] ..."
  with(record, vwritef(fmt, Package, Version))
  linker(cache, target)

  type <- case(
    identical(linker, renv_file_copy) ~ "copied",
    identical(linker, renv_file_link) ~ "linked"
  )

  vwritef("\tOK [%s cache]", type)

  return(TRUE)

}

renv_install_package_cache_skip <- function(record, cache) {

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

  # check for matching cache + target paths
  library <- renv_restore_state("library") %||% renv_libpaths_default()
  target <- file.path(library, record$Package)

  renv_file_same(cache, target)

}

renv_install_package_preamble <- function(record) {
  fmt <- "Installing %s [%s] ..."
  with(record, vwritef(fmt, Package, Version))
}

renv_install_package_impl_prebuild <- function(record, path, quiet) {

  # check whether user wants us to build before install
  if (!identical(config$install.build(), TRUE))
    return(path)

  # if this package already appears to be built, nothing to do
  if (renv_package_built(path))
    return(path)

  # if this is an archive, we'll need to unpack it first
  info <- renv_file_info(path)
  if (identical(info$isdir, FALSE)) {

    # find the package directory
    files <- renv_archive_list(path)
    descpath <- grep("(?:^|/)DESCRIPTION$", files, value = TRUE)
    pkgpath <- dirname(descpath)[nchar(descpath) == min(nchar(descpath))]

    # extract to temporary directory
    exdir <- tempfile("renv-build-")
    ensure_directory(exdir)
    renv_archive_decompress(path, exdir = exdir)

    # update path to package
    path <- file.path(exdir, pkgpath)

    # and ensure we build in this directory
    owd <- setwd(path)
    on.exit(setwd(owd), add = TRUE)

  }

  # if this package depends on a VignetteBuilder that is not installed,
  # then we can't proceed
  descpath <- file.path(path, "DESCRIPTION")
  desc <- renv_description_read(descpath)
  builder <- desc[["VignetteBuilder"]]
  if (!is.null(builder) && !renv_package_installed(builder)) {
    fmt <- "Skipping package build: vignette builder '%s' is not installed"
    vwritef(fmt, builder)
    return(path)
  }

  fmt <- "Building %s [%s] ..."
  with(record, vwritef(fmt, Package, Version))

  before <- Sys.time()
  package <- record$Package
  newpath <- r_cmd_build(package, path)
  after <- Sys.time()
  time <- difftime(after, before, units = "auto")

  fmt <- "\tOK [built package in %s]"
  vwritef(fmt, renv_difftime_format(time))

  newpath

}

renv_install_package_impl <- function(record, quiet = TRUE) {

  package <- record$Package

  # get path for package
  path <- record$Path

  # check if it's an archive (versus an unpacked directory)
  info <- renv_file_info(path)
  isarchive <- identical(info$isdir, FALSE)

  subdir <- record$RemoteSubdir %||% ""
  if (isarchive) {
    # re-pack archives if they appear to have their package
    # sources contained as part of a sub-directory
    path <- renv_package_unpack(package, path, subdir = subdir)
  } else if (nzchar(subdir)) {
    # for directories, we may need to use subdir to find the package path
    components <- c(path, subdir)
    path <- paste(components, collapse = "/")
  }

  # check whether we should build before install
  path <- renv_install_package_impl_prebuild(record, path, quiet)

  # report that we're about to start installation
  renv_install_package_preamble(record)

  # run user-defined hooks before, after install
  options <- renv_install_package_options(package)
  before <- options$before.install %||% identity
  after  <- options$after.install %||% identity

  before(package)
  on.exit(after(package), add = TRUE)

  # backup an existing installation of the package if it exists
  library <- renv_libpaths_default()
  destination <- file.path(library, package)
  callback <- renv_file_backup(destination)
  on.exit(callback(), add = TRUE)

  # normalize paths
  path <- renv_path_normalize(path, winslash = "/", mustWork = TRUE)

  # get library path
  library <- renv_libpaths_default()

  # if a package already exists at that path, back it up first
  # this avoids problems with older versions of R attempting to
  # overwrite a pre-existing symlink
  #
  # https://github.com/rstudio/renv/issues/611
  installpath <- file.path(library, package)
  callback <- renv_file_backup(installpath)
  on.exit(callback(), add = TRUE)

  # if this failed for some reason, just remove it
  if (renv_file_broken(installpath))
    renv_file_remove(installpath)

  # if this is the path to an unpacked binary archive,
  # we can just copy the folder over
  copyable <-
    renv_file_type(path, symlinks = FALSE) == "directory" &&
    renv_package_type(path, quiet = TRUE) == "binary"

  # shortcut via copying a binary directory if possible,
  # otherwise, install the package
  if (copyable)
    renv_file_copy(path, installpath, overwrite = TRUE)
  else
    r_cmd_install(package, path)

  # augment package metadata after install
  renv_package_augment(installpath, record)

  # return the path to the package
  invisible(installpath)

}

renv_install_package_options <- function(package) {
  options <- getOption("renv.install.package.options")
  options[[package]]
}

# nocov start
renv_install_preflight_requirements <- function(records) {

  deps <- bapply(records, function(record) {
    renv_dependencies_discover_description(record$Path)
  }, index = "ParentPackage")

  splat <- split(deps, deps$Package)
  bad <- enumerate(splat, function(package, requirements) {

    # skip NULL records (should be handled above)
    record <- records[[package]]
    if (is.null(record))
      return(NULL)

    version <- record$Version

    # drop packages without explicit version requirement
    requirements <- requirements[nzchar(requirements$Require), ]
    if (nrow(requirements) == 0)
      return(NULL)

    # add in requested version
    requirements$RequestedVersion <- version

    # generate expressions to evaluate
    fmt <- "package_version('%s') %s package_version('%s')"
    code <- with(requirements, sprintf(fmt, RequestedVersion, Require, Version))
    parsed <- parse(text = code)
    ok <- map_lgl(parsed, eval, envir = baseenv())

    # return requirements that weren't satisfied
    requirements[!ok, ]

  })

  bad <- bind(unname(bad))
  if (empty(bad))
    return(TRUE)

  package  <- bad$ParentPackage
  requires <- sprintf("%s (%s %s)", bad$Package, bad$Require, bad$Version)
  actual   <- sprintf("%s %s", bad$Package, bad$RequestedVersion)

  fmt <- "Package '%s' requires '%s', but '%s' will be installed"
  text <- sprintf(fmt, format(package), format(requires), format(actual))
  if (renv_verbose()) {
    renv_pretty_print(
      text,
      "The following issues were discovered while preparing for installation:",
      "Installation of these packages may not succeed.",
      wrap = FALSE
    )
  }

  if (interactive() && !proceed())
    return(FALSE)

  TRUE

}
# nocov end

renv_install_postamble <- function(packages) {

  # only diagnose packages currently loaded
  packages <- renv_vector_intersect(packages, loadedNamespaces())
  if (empty(packages))
    return(TRUE)

  # get version of package in library
  installed <- map_chr(packages, renv_package_version)

  # get version of package currently loaded
  loaded <- map_chr(packages, renv_namespace_version)

  # collect into data.frame
  data <- data.frame(
    Package   = packages,
    Installed = installed,
    Loaded    = loaded,
    stringsAsFactors = FALSE
  )

  # only keep mismatches
  mismatches <- data[data$Installed != data$Loaded, ]
  if (nrow(mismatches) == 0)
    return(TRUE)

  # format and print
  text <- with(mismatches, {
    fmt <- "%s [installed version %s != loaded version %s]"
    sprintf(fmt, format(Package), format(Installed), format(Loaded))
  })

  if (renv_tests_running()) {
    condition <- "renv.install.restart_required"
    renv_condition_signal(condition)
  }

  # nocov start
  if (renv_verbose()) {
    renv_pretty_print(
      text,
      "The following package(s) have been updated:",
      "Consider restarting the R session and loading the newly-installed packages.",
      wrap = FALSE
    )
  }
  # nocov end

  TRUE

}

renv_install_preflight_unknown_source <- function(records) {
  renv_check_unknown_source(records)
}

renv_install_preflight_permissions <- function(library) {

  # try creating and deleting a directory in the library folder
  file <- tempfile(".renv-write-test-", tmpdir = library)
  dir.create(file, recursive = TRUE, showWarnings = FALSE)
  on.exit(unlink(file, recursive = TRUE), add = TRUE)

  # check if we created the directory successfully
  info <- renv_file_info(file)
  if (identical(info$isdir, TRUE))
    return(TRUE)

  # nocov start
  if (renv_verbose()) {

    # construct header for message
    preamble <- "renv appears to be unable to access the requested library path:"

    # construct footer for message
    info <- as.list(Sys.info())
    fmt <- "Check that the '%s' user has read / write access to this directory."
    postamble <- sprintf(fmt, info$effective_user %||% info$user)

    # print it
    renv_pretty_print(
      values = library,
      preamble = preamble,
      postamble = postamble,
      wrap = FALSE
    )

  }
  # nocov end

  FALSE

}

renv_install_preflight <- function(project, libpaths, records, prompt) {

  # check for packages installed from an unknown source
  library <- nth(libpaths, 1L)

  ok <- all(
    renv_install_preflight_unknown_source(records),
    renv_install_preflight_permissions(library)
  )

  if (ok)
    return(TRUE)

  if (prompt && !proceed())
    return(FALSE)

  TRUE

}

renv_install_remotes_update <- function(records, project) {

  # check for DESCRIPTION file
  descpath <- file.path(project, "DESCRIPTION")
  if (!file.exists(descpath))
    return(records)

  # read Remotes field (if any)
  remotes <- renv_description_remotes(descpath)
  if (empty(remotes))
    return(records)

  # update records as appropriate
  enumerate(remotes, function(package, remote) {

    record <- records[[package]]

    update <-
      is.null(record) ||
      identical(record, list(Package = package, Source = "Repository"))

    if (update)
      records[[package]] <<- remote

  })

  # return updated set of records
  records

}

renv_installed_packages_base <- function() {

  # we can assume that the base set of installed packages won't change during
  # a session, so cache the result of installed.packages()
  renv_global("base.packages", {
    packages <- installed.packages(lib.loc = .Library, priority = "base")
    as.data.frame(packages, stringsAsFactors = FALSE)
  })

}

renv_installed_packages <- function(lib.loc = NULL, priority = NULL, ...) {
  packages <- installed.packages(lib.loc = lib.loc, priority = priority, ...)
  as.data.frame(packages, stringsAsFactors = FALSE)
}

#' Isolate a Project
#'
#' Copy packages from the `renv` cache directly into the project library, so
#' that the project can continue to function independently of the `renv` cache.
#'
#' After calling `isolate()`, `renv` will still be able to use the cache on
#' future [install()]s and [restore()]s. If you'd prefer that `renv` copy
#' packages from the cache, rather than use symlinks, you can set the `renv`
#' configuration option:
#'
#' ```
#' options(renv.config.cache.symlinks = FALSE)
#' ```
#'
#' to force `renv` to copy packages from the cache, as opposed to symlinking
#' them. If you'd like to disable the cache altogether for a project, you can
#' use:
#'
#' ```
#' settings$use.cache(FALSE)
#' ```
#'
#' to explicitly disable the cache for the project.
#'
#' @inherit renv-params
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # isolate a project
#' renv::isolate()
#'
#' }
isolate <- function(project = NULL) {

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  if (renv_platform_windows())
    renv_isolate_windows(project)
  else
    renv_isolate_unix(project)

  invisible(project)

}

renv_isolate_unix <- function(project) {

  library <- renv_paths_library(project = project)
  targets <- list.files(library, full.names = TRUE)

  sources <- Sys.readlink(targets)
  islink <- !is.na(sources) & nzchar(sources)

  sources <- sources[islink]
  targets <- targets[islink]
  names(targets) <- sources

  if (length(targets)) {
    vprintf("* Copying packages into the private library ... ")
    unlink(targets)
    copy <- renv_progress_callback(renv_file_copy, length(targets))
    enumerate(targets, copy, overwrite = TRUE)
    vwritef("Done!")
  }

  writef("* This project has been isolated from the cache.")
  invisible(project)

}

renv_isolate_windows <- function(project) {

  library <- renv_paths_library(project = project)
  targets <- list.files(library, full.names = TRUE)

  sources <- map_chr(targets, renv_cache_path)
  names(targets) <- sources

  if (length(targets)) {
    vprintf("* Copying packages into the private library ... ")
    targets <- targets[file.exists(sources)]
    unlink(targets)
    copy <- renv_progress_callback(renv_file_copy, length(targets))
    enumerate(targets, copy, overwrite = TRUE)
    vwritef("Done!")
  }

  writef("* This project has been isolated from the cache.")
  invisible(project)

}

renv_json_read <- function(file = NULL, text = NULL) {

  # if jsonlite is loaded, use that instead
  if ("jsonlite" %in% loadedNamespaces())
    renv_json_read_jsonlite(file, text)
  else
    renv_json_read_default(file, text)

}

renv_json_read_jsonlite <- function(file = NULL, text = NULL) {
  text <- paste(text %||% read(file), collapse = "\n")
  jsonlite::fromJSON(txt = text, simplifyVector = FALSE)
}

renv_json_read_default <- function(file = NULL, text = NULL) {

  # find strings in the JSON
  text <- paste(text %||% read(file), collapse = "\n")
  pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]'
  locs <- gregexpr(pattern, text, perl = TRUE)[[1]]

  # if any are found, replace them with placeholders
  replaced <- text
  strings <- character()
  replacements <- character()

  if (!identical(c(locs), -1L)) {

    # get the string values
    starts <- locs
    ends <- locs + attr(locs, "match.length") - 1L
    strings <- substring(text, starts, ends)

    # only keep those requiring escaping
    strings <- grep("[[\\]{}:]", strings, perl = TRUE, value = TRUE)

    # compute replacements
    replacements <- sprintf('"\032%i\032"', seq_along(strings))

    # replace the strings
    mapply(function(string, replacement) {
      replaced <<- sub(string, replacement, replaced, fixed = TRUE)
    }, strings, replacements)

  }

  # transform the JSON into something the R parser understands
  transformed <- replaced
  transformed <- gsub("{}", "`names<-`(list(), character())", transformed, fixed = TRUE)
  transformed <- gsub("[[{]", "list(", transformed, perl = TRUE)
  transformed <- gsub("[]}]", ")", transformed, perl = TRUE)
  transformed <- gsub(":", "=", transformed, fixed = TRUE)
  text <- paste(transformed, collapse = "\n")

  # parse it
  json <- parse(text = text, keep.source = FALSE, srcfile = NULL)[[1L]]

  # construct map between source strings, replaced strings
  map <- as.character(parse(text = strings))
  names(map) <- as.character(parse(text = replacements))

  # convert to list
  map <- as.list(map)

  # remap strings in object
  remapped <- renv_json_remap(json, map)

  # evaluate
  eval(remapped, envir = baseenv())

}

renv_json_remap <- function(json, map) {

  # fix names
  if (!is.null(names(json))) {
    lhs <- match(names(json), names(map), nomatch = 0L)
    rhs <- match(names(map), names(json), nomatch = 0L)
    names(json)[rhs] <- map[lhs]
  }

  # fix values
  if (is.character(json))
    return(map[[json]] %||% json)

  # handle true, false, null
  if (is.name(json)) {
    text <- as.character(json)
    if (text == "true")
      return(TRUE)
    else if (text == "false")
      return(FALSE)
    else if (text == "null")
      return(NULL)
  }

  # recurse
  if (is.recursive(json)) {
    for (i in seq_along(json)) {
      json[i] <- list(renv_json_remap(json[[i]], map))
    }
  }

  json

}

# @param box A vector of names, whose values should be boxed. By default,
#   scalar values are unboxed.
renv_json_config <- function(box = character()) {
  list(box = box)
}

renv_json_write <- function(object,
                            config = NULL,
                            file = stdout())
{
  config <- config %||% renv_json_config()
  json <- renv_json_convert_impl(NULL, object, config, 0L)
  if (is.null(file))
    return(json)

  writeLines(json, con = file)

}

renv_json_convert <- function(object, config = renv_json_config()) {
  renv_json_convert_impl(NULL, object, config, 0L)
}

renv_json_convert_impl <- function(key, value, config, depth) {

  if (is.list(value) || !is.null(names(value)))
    return(renv_json_convert_list(key, value, config, depth))

  json <- renv_json_convert_atom(key, value, config, depth)
  indent <- renv_json_convert_indent(depth)
  paste0(indent, json)

}

renv_json_convert_list <- function(key, value, config, depth) {
  indent <- renv_json_convert_indent(depth)
  if (empty(value)) {
    json <- if (is.null(names(value))) "[]" else "{}"
    paste0(indent, json)
  } else if (is.null(names(value))) {
    json <- enum_chr(value, renv_json_convert_impl, config = config, depth = depth + 1L)
    paste0(indent, "[", "\n", paste(json, collapse = ",\n"), "\n", indent, "]")
  } else {
    keys <- renv_json_quote(names(value))
    vals <- enum_chr(value, renv_json_convert_impl, config = config, depth = depth + 1L)
    idx  <- regexpr("[^[:space:]]", vals)
    json <- paste0(substring(vals, 1L, idx - 1L), keys, ": ", substring(vals, idx))
    paste0(indent, "{", "\n", paste(json, collapse = ",\n"), "\n", indent, "}")
  }
}

renv_json_convert_atom <- function(key, value, config, depth) {

  unbox <- is.null(key) || !key %in% config$box || inherits(value, "AsIs")
  if (is.null(value))
    return(if (unbox) "null" else "[]")

  n <- length(value)
  if (n == 0L)
    return("[]")

  if (is.character(value)) {
    value <- renv_json_quote(value)
    value[value == "\"NA\""] <- "null"
  }

  if (is.logical(value)) {
    value <- ifelse(value, "true", "false")
    value[is.na(value)] <- "null"
  }

  if (unbox && n == 1L)
    return(paste0(value))

  indent <- renv_json_convert_indent(depth)
  json <- paste0(renv_json_convert_indent(depth + 1L), value)
  paste0("[", "\n", paste(json, collapse = ",\n"), "\n", indent, "]")

}

renv_json_convert_indent <- function(level) {
  paste(rep("  ", level), collapse = "")
}

renv_json_quote <- function(text) {
  encodeString(text, quote = "\"", justify = "none")
}

renv_knitr_options_header <- function(text, type) {

  # extract the inner options from the header
  patterns <- renv_knitr_patterns()
  rest <- sub(patterns[[type]]$chunk.begin, "\\1", text)

  # if this is an R Markdown document, parse the initial engine chunk
  # (default to 'r' when not set)
  engine <- "r"
  if (type == "md") {
    idx <- regexpr("(?:[ ,]|$)", rest)
    engine <- substring(rest, 1, idx - 1)
    rest <- sub("^,*\\s*", "", substring(rest, idx + 1))
  }

  # parse the params
  params <- renv_knitr_options_header_impl(rest)

  # ensure an engine is set, if any
  params[["engine"]] <- params[["engine"]] %||% engine

  # return parsed params
  params

}

renv_knitr_options_header_impl <- function(rest) {

  # extract an unquoted label
  label <- ""
  pattern <- "(^\\s*[^=]+)(,|\\s*$)"
  matches <- regexec(pattern, rest)[[1]]
  if (!identical(c(matches), -1L)) {
    submatches <- regmatches(rest, list(matches))[[1]]
    label <- trimws(submatches[[2L]])
    rest <- substring(rest, matches[[3L]] + 1L)
  }

  # parse as alist
  params <- catch(parse(text = sprintf("alist(%s)", rest))[[1]])
  if (inherits(params, "error"))
    return(list())

  # inject the label back in
  names(params) <- names(params) %||% rep.int("", length(params))
  if (length(params) > 1 && names(params)[[2L]] == "")
    names(params)[[2L]] <- "label"

  # fix up 'label' if it's a missing value
  if (identical(params[["label"]], quote(expr = )))
    params[["label"]] <- NULL

  # if we parsed a label, add it in
  if (is.null(params[["label"]]) && nzchar(label))
    params[["label"]] <- label

  # evaluate the alist
  eval(params, envir = parent.frame())

}

renv_knitr_options_chunk <- function(code) {

  # find chunk option lines
  pattern <- "^[[:space:]]*#+[|]"
  matches <- grep(pattern, code[nzchar(code)], value = TRUE)

  # remove prefix
  text <- gsub(pattern, "", matches)

  # try to guess whether it's YAML
  isyaml <- any(grepl("^[[:space:]]*[^[:space:]:]+:", text))

  # first, try to parse as YAML, then as R code
  params <- if (isyaml) {
    catch(renv_yaml_load(text))
  } else {
    code <- paste(text, collapse = ", ")
    catch(renv_knitr_options_header_impl(code))
  }

  # check for error and report if this is in dependency discovery
  if (inherits(params, "error")) {

    state <- renv_dependencies_state()
    if (!is.null(state)) {
      problem <- list(file = state$path %||% "<unknown>", error = params)
      state$problems$push(problem)
    }

    return(list())

  }

  # return parsed params
  params

}

renv_knitr_patterns <- function() {

  list(

    rnw = list(
      chunk.begin = "^\\s*<<(.*)>>=.*$",
      chunk.end = "^\\s*@\\s*(%+.*|)$",
      inline.code = "\\\\Sexpr\\{([^}]+)\\}",
      inline.comment = "^\\s*%.*",
      ref.chunk = "^\\s*<<(.+)>>\\s*$",
      header.begin = "(^|\n)\\s*\\\\documentclass[^}]+\\}",
      document.begin = "\\s*\\\\begin\\{document\\}"
    ),

    tex = list(
      chunk.begin = "^\\s*%+\\s*begin.rcode\\s*(.*)",
      chunk.end = "^\\s*%+\\s*end.rcode",
      chunk.code = "^\\s*%+",
      ref.chunk = "^%+\\s*<<(.+)>>\\s*$",
      inline.comment = "^\\s*%.*",
      inline.code = "\\\\rinline\\{([^}]+)\\}",
      header.begin = "(^|\n)\\s*\\\\documentclass[^}]+\\}",
      document.begin = "\\s*\\\\begin\\{document\\}"
    ),

    html = list(
      chunk.begin = "^\\s*<!--\\s*begin.rcode\\s*(.*)",
      chunk.end = "^\\s*end.rcode\\s*-->",
      ref.chunk = "^\\s*<<(.+)>>\\s*$",
      inline.code = "<!--\\s*rinline(.+?)-->",
      header.begin = "\\s*<head>"
    ),

    md = list(
      chunk.begin = "^[\t >]*```+\\s*\\{([a-zA-Z0-9_]+( *[ ,].*)?)\\}\\s*$",
      chunk.end = "^[\t >]*```+\\s*$",
      ref.chunk = "^\\s*<<(.+)>>\\s*$",
      inline.code = "(?<!(^|\n)``)`r[ #]([^`]+)\\s*`"
    ),

    rst = list(
      chunk.begin = "^\\s*[.][.]\\s+\\{r(.*)\\}\\s*$",
      chunk.end = "^\\s*[.][.]\\s+[.][.]\\s*$",
      chunk.code = "^\\s*[.][.]",
      ref.chunk = "^\\.*\\s*<<(.+)>>\\s*$",
      inline.code = ":r:`([^`]+)`"
    ),

    asciidoc = list(
      chunk.begin = "^//\\s*begin[.]rcode(.*)$",
      chunk.end = "^//\\s*end[.]rcode\\s*$",
      chunk.code = "^//+",
      ref.chunk = "^\\s*<<(.+)>>\\s*$",
      inline.code = "`r +([^`]+)\\s*`|[+]r +([^+]+)\\s*[+]",
      inline.comment = "^//.*"
    ),

    textile = list(
      chunk.begin = "^###[.]\\s+begin[.]rcode(.*)$",
      chunk.end = "^###[.]\\s+end[.]rcode\\s*$",
      ref.chunk = "^\\s*<<(.+)>>\\s*$",
      inline.code = "@r +([^@]+)\\s*@",
      inline.comment = "^###[.].*"
    )

  )

}

renv_l10n_mbcs <- function() {
  info <- l10n_info()
  info$MBCS
}

renv_l10n_utf8 <- function() {
  info <- l10n_info()
  info$`UTF-8`
}

renv_l10n_latin1 <- function() {
  info <- l10n_info()
  info$`Latin-1`
}

`_renv_libpaths` <- new.env(parent = emptyenv())

# NOTE: if sandboxing is used then these symbols will be clobbered;
# save them so we can properly restore them later if so required
renv_libpaths_init <- function() {
  assign(".libPaths()",   .libPaths(),   envir = `_renv_libpaths`)
  assign(".Library",      .Library,      envir = `_renv_libpaths`)
  assign(".Library.site", .Library.site, envir = `_renv_libpaths`)
}

renv_libpaths_default <- function() {
  .libPaths()[1]
}

renv_libpaths_all <- function() {
  .libPaths()
}

renv_libpaths_system <- function() {
  get(".Library", envir = `_renv_libpaths`)
}

renv_libpaths_site <- function() {
  get(".Library.site", envir = `_renv_libpaths`)
}

renv_libpaths_external <- function(project) {
  projlib <- settings$external.libraries(project = project)
  conflib <- config$external.libraries(project)
  .expand_R_libs_env_var(c(projlib, conflib))
}

# on Windows, attempting to use a library path containing
# characters considered special by cmd.exe will fail.
# to guard against this, we try to create a junction point
# from the temporary directory to the target library path
#
# https://github.com/rstudio/renv/issues/334
renv_libpaths_safe <- function(libpaths) {

  if (renv_libpaths_safe_check(libpaths))
    return(libpaths)

  map_chr(libpaths, renv_libpaths_safe_impl)

}

renv_libpaths_safe_check <- function(libpaths) {

  # if any of the paths have single quotes, then
  # we need to use a safe path
  # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17973
  if (any(grepl("'", libpaths, fixed = TRUE)))
    return(FALSE)

  # on Windows, we need to use safe library paths for R < 4.0.0
  # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17709
  if (renv_platform_windows() && getRversion() < "4.0.0")
    return(FALSE)

  # otherwise, we're okay
  return(TRUE)

}

renv_libpaths_safe_impl <- function(libpath) {

  # check for an unsafe library path
  unsafe <-
    Encoding(libpath) == "UTF-8" ||
    grepl("[&<>^|'\"]", libpath)

  # if the path appears safe, use it as-is
  if (!unsafe)
    return(libpath)

  # try to form a safe library path
  methods <- c(
    renv_libpaths_safe_tempdir,
    renv_libpaths_safe_userlib
  )

  for (method in methods) {
    safelib <- catchall(method(libpath))
    if (is.character(safelib))
      return(safelib)
  }

  # could not form a safe library path;
  # just use the existing library path as-is
  libpath

}

renv_libpaths_safe_tempdir <- function(libpath) {
  safelib <- tempfile("renv-library-")

  if (renv_platform_windows())
    renv_file_junction(libpath, safelib)
  else
    file.symlink(libpath, safelib)

  safelib
}

renv_libpaths_safe_userlib <- function(libpath) {

  # form path into user library
  userlib <- renv_libpaths_user()[[1]]
  base <- file.path(userlib, ".renv-links")
  ensure_directory(base)

  # create name for actual junction point
  name <- renv_hash_text(libpath)
  safelib <- file.path(base, name)

  # if the junction already exists, use it
  if (renv_file_same(libpath, safelib))
    return(safelib)

  # otherwise, try to create it. note that junction
  # points can be removed with a non-recursive unlink
  unlink(safelib)

  if (renv_platform_windows())
    renv_file_junction(libpath, safelib)
  else
    file.symlink(libpath, safelib)

  safelib

}

renv_libpaths_set <- function(libpaths) {
  oldlibpaths <- .libPaths()
  safepaths <- renv_libpaths_safe(libpaths)
  .libPaths(safepaths)
  oldlibpaths
}

# NOTE: may return more than one library path!
renv_libpaths_user <- function() {

  # if renv is active, the user library will be saved
  envvars <- c("RENV_DEFAULT_R_LIBS_USER", "R_LIBS_USER")
  for (envvar in envvars) {

    value <- Sys.getenv(envvar, unset = NA)
    if (is.na(value) || value == "<NA>" || !nzchar(value))
      next

    parts <- strsplit(value, .Platform$path.sep, fixed = TRUE)[[1]]
    return(parts)

  }

  # otherwise, default to active library (shouldn't happen but best be safe)
  renv_libpaths_default()

}

renv_libpaths_activate <- function(project) {

  projlib <- renv_paths_library(project = project)
  extlib <- renv_libpaths_external(project = project)
  userlib <- if (config$user.library())
    renv_libpaths_user()

  libpaths <- c(projlib, extlib, userlib)

  lapply(libpaths, ensure_directory)
  renv_libpaths_set(libpaths)

  libpaths

}

renv_libpaths_restore <- function() {
  libpaths <- get(".libPaths()", envir = `_renv_libpaths`)
  renv_libpaths_set(libpaths)
}

renv_libpaths_resolve <- function(library) {
  library %||% renv_libpaths_all()
}

# check for problems in the project's private library (e.g. broken symlinks
# to the cache or similar)
renv_library_diagnose <- function(project, libpath) {

  children <- list.files(libpath, full.names = TRUE)
  if (empty(children))
    return(TRUE)

  # if all symlinks are broken, assume the cache is missing or has been moved
  missing <- !file.exists(children)
  if (all(missing)) {
    msg <- lines(
      "The project library's symlinks to the cache are all broken.",
      "Has the cache been removed, or is it otherwise inaccessible?",
      paste("Cache root:", shQuote(renv_paths_cache()[[1L]]))
    )
    warning(msg, call. = FALSE)
    return(FALSE)
  }

  # if only some symlinks are broken, report to user
  if (any(missing)) {

    renv_pretty_print(
      basename(children[missing]),
      "The following package(s) are missing entries in the cache:",
      "These packages will need to be reinstalled.",
      warningf
    )

    return(FALSE)

  }

  TRUE

}

# used to generate the CRAN-compatible license file in R CMD build
renv_license_generate <- function() {

  isbuild <-
    !is.na(Sys.getenv("R_CMD", unset = NA)) &&
    grepl("Rbuild", basename(dirname(getwd())))

  if (!isbuild)
    return(FALSE)

  contents <- c(
    paste("YEAR:", format(Sys.Date(), "%Y")),
    "COPYRIGHT HOLDER: RStudio, PBC"
  )

  writeLines(contents, con = "LICENSE")

  return(TRUE)

}

if (identical(.packageName, "renv"))
  renv_license_generate()

#' Load a Project
#'
#' Load an `renv` project.
#'
#' Calling `renv::load()` will set the session's library paths to use a
#' project-local library, and perform some other work to ensure the project is
#' properly isolated from other packages on the system.
#'
#' Normally, `renv::load()` is called automatically by the project auto-loader
#' written to the project `.Rprofile` by [renv::init()]. This allows \R sessions
#' launched from the root of an `renv` project directory to automatically load
#' that project, without requiring explicit action from the user. However, if
#' preferred or necessary, one can call `renv::load("<project>")` to explicitly
#' load an `renv` project located at a particular path.
#'
#' Use [renv::activate()] to activate (or re-activate) an `renv` project, so
#' that newly-launched \R sessions can automatically load the associated
#' project.
#'
#' @inherit renv-params
#'
#' @param quiet Boolean; be quiet during load?
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # load a project -- note that this is normally done automatically
#' # by the project's auto-loader, but calling this explicitly to
#' # load a particular project may be useful in some circumstances
#' renv::load()
#'
#' }
load <- function(project = NULL, quiet = FALSE) {

  renv_scope_error_handler()

  project <- project %||% renv_project_find(project)
  renv_scope_lock(project = project)

  # indicate that we're now loading the project
  renv_scope_options(renv.load.running = TRUE)

  # avoid suppressing the next auto snapshot
  renv_scope_var("running", TRUE, envir = `_renv_snapshot_auto`)

  # if load is being called via the autoloader,
  # then ensure RENV_PROJECT is unset
  # https://github.com/rstudio/renv/issues/887
  if (identical(getOption("renv.autoloader.running"), TRUE))
    renv_project_clear()

  # if we're loading a project different from the one currently loaded,
  # then unload the current project and reload the requested one
  switch <-
    !is.na(Sys.getenv("RENV_PROJECT", unset = NA)) &&
    !identical(project, renv_project())

  if (switch)
    return(renv_load_switch(project))

  if (quiet)
    renv_scope_options(renv.verbose = FALSE)

  renv_envvars_save()

  # load a minimal amount of state when testing
  if (renv_tests_running())
    return(renv_load_minimal(project))

  # load rest of renv components
  renv_load_init(project)
  renv_load_path(project)
  renv_load_shims(project)
  renv_load_renviron(project)
  renv_load_profile(project)
  renv_load_settings(project)
  renv_load_project(project)
  renv_load_sandbox(project)
  renv_load_libpaths(project)
  renv_load_rprofile(project)
  renv_load_cache(project)

  lockfile <- renv_lockfile_load(project)
  if (length(lockfile)) {
    renv_load_r(project, lockfile$R)
    renv_load_python(project, lockfile$Python)
    renv_load_bioconductor(project, lockfile$Bioconductor)
  }

  # allow failure to write infrastructure here to be non-fatal
  # https://github.com/rstudio/renv/issues/574#issuecomment-731159197
  catch({
    renv_infrastructure_write_rbuildignore(project)
    renv_infrastructure_write_gitignore(project)
  })

  renv_load_finish(project, lockfile)

  invisible(project)
}

renv_load_minimal <- function(project) {

  renv_load_libpaths(project)

  lockfile <- renv_lockfile_load(project)
  if (length(lockfile))
    renv_load_python(project, lockfile$Python)

  invisible(project)

}

renv_load_r <- function(project, fields) {

  # check for missing fields
  if (is.null(fields)) {
    warning("missing required [R] section in lockfile")
    return(NULL)
  }

  # load repositories
  renv_load_r_repos(fields$Repositories)

  # load (check) version
  version <- fields$Version
  if (is.null(version)) {
    warning("no R version recorded in this lockfile")
    return(NULL)
  }

  # normalize versions as plain old vectors
  requested <- unclass(numeric_version(version))[[1]]
  current <- unclass(numeric_version(getRversion()))[[1]]

  # only compare major, minor versions
  if (!identical(requested[1:2], current[1:2])) {
    fmt <- "Using R %s (lockfile was generated with R %s)"
    infof(fmt, getRversion(), version)
  }

}

renv_load_r_repos <- function(repos) {

  # force a character vector (https://github.com/rstudio/renv/issues/127)
  repos <- convert(repos, "character")

  # remove trailing slashes
  nms <- names(repos)
  repos <- sub("/+$", "", repos)
  names(repos) <- nms

  # convert to rspm if enabled
  if (renv_rspm_enabled())
    repos <- renv_rspm_transform(repos)

  # normalize option
  repos <- renv_repos_normalize(repos)

  # set sanitized repos
  options(repos = repos)

  # and return
  repos

}

renv_load_init <- function(project) {

  # warn if the project path cannot be translated into the native encoding,
  # as (especially on Windows) this will likely prevent renv from working
  actual <- enc2utf8(project)
  expected <- catch(enc2utf8(enc2native(actual)))
  if (identical(actual, expected))
    return(TRUE)

  msg <- paste(
    "the project path cannot be represented in the native encoding;",
    "renv may not function as expected"
  )

  warning(msg)

}

renv_load_path <- function(project) {

  # only required when running in RStudio
  if (!renv_rstudio_available())
    return(FALSE)

  # on macOS, read paths from /etc/paths and friends

  # nocov start
  if (renv_platform_macos()) {

    # read the current PATH
    old <- renv_envvar_get("PATH", unset = "") %>%
      strsplit(split = .Platform$path.sep, fixed = TRUE) %>%
      unlist()

    # get the new PATH entries
    files <- c(
      if (file.exists("/etc/paths")) "/etc/paths",
      list.files("/etc/paths.d", full.names = TRUE)
    )

    new <- uapply(files, readLines, warn = FALSE)

    # mix them together, preferring things in /etc/paths
    mix <- unique(c(new, old))

    # update the PATH
    Sys.setenv(PATH = paste(mix, collapse = .Platform$path.sep))

  }
  # nocov end

}

renv_load_shims <- function(project) {
  if (renv_shims_enabled())
    renv_shims_activate()
}

renv_load_renviron <- function(project) {

  environs <- c(
    renv_paths_root(".Renviron"),
    if (config$user.environ())
      Sys.getenv("R_ENVIRON_USER", unset = "~/.Renviron"),
    file.path(project, ".Renviron")
  )

  for (environ in environs)
    if (file.exists(environ))
      readRenviron(environ)

  renv_envvars_normalize()

}

renv_load_profile <- function(project) {

  renv_bootstrap_profile_load(project = project)

}

renv_load_settings <- function(project) {

  settings <- renv_paths_renv("settings.R", project = project)
  if (!file.exists(settings))
    return(FALSE)

  tryCatch(
    eval(parse(settings), envir = baseenv()),
    error = warning
  )

  TRUE

}

renv_load_project <- function(project) {

  # record the active project in this session
  project <- renv_path_normalize(project, winslash = "/")
  Sys.setenv(RENV_PROJECT = project)

  # update project list if enabled
  enabled <- renv_cache_config_enabled(project = project)
  if (enabled)
    renv_load_project_projlist(project)

  TRUE

}

renv_load_project_projlist <- function(project) {

  # read project list
  projects <- renv_paths_root("projects")
  projlist <- character()
  if (file.exists(projects))
    projlist <- readLines(projects, warn = FALSE, encoding = "UTF-8")

  # if the project is already recorded, nothing to do
  if (project %in% projlist)
    return(TRUE)

  # sort with C locale (ensure consistent sorting across OSes)
  projlist <- local({
    renv_scope_locale("LC_COLLATE", "C")
    sort(c(projlist, project))
  })

  # update the project list
  ensure_parent_directory(projects)
  catchall(writeLines(enc2utf8(projlist), projects, useBytes = TRUE))

  TRUE

}

renv_load_rprofile <- function(project = NULL) {

  project <- renv_project_resolve(project)

  # bail if not enabled by user
  enabled <- identical(config$user.profile(), TRUE)
  if (!enabled)
    return(FALSE)

  # callr will manage sourcing of user profile, so don't try
  # to source the user profile if we're in callr
  callr <- Sys.getenv("CALLR_CHILD_R_LIBS", unset = NA)
  if (!is.na(callr))
    return(FALSE)

  # check for existence of profile
  profile <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile")
  if (!file.exists(profile))
    return(FALSE)

  renv_scope_libpaths()
  renv_load_rprofile_impl(profile)

  TRUE

}

renv_load_rprofile_impl <- function(profile) {

  # NOTE: We'd like to use a regular tryCatch() handler here, but
  # that will cause issues for user profiles which attempt to add
  # global calling handlers. For that reason, we just register a
  # bare restart handler, so at least we can catch the jump.
  #
  # https://github.com/rstudio/renv/issues/1036

  status <- withRestarts(
    eval(parse(profile), envir = globalenv()),
    abort = function() { structure(list(), class = "_renv_error") }
  )

  if (inherits(status, "_renv_error")) {
    fmt <- "an error occurred while sourcing %s"
    warningf(fmt, renv_path_pretty(profile))
  }

  FALSE

}

renv_load_libpaths <- function(project = NULL) {
  renv_libpaths_activate(project)
  libpaths <- renv_libpaths_all()
  lapply(libpaths, renv_library_diagnose, project = project)
  Sys.setenv(R_LIBS_USER = paste(libpaths, collapse = .Platform$path.sep))
}

renv_load_sandbox <- function(project) {
  renv_sandbox_activate(project)
}

renv_load_python <- function(project, fields) {

  python <- tryCatch(
    renv_load_python_impl(project, fields),
    error = function(e) {
      warning(e)
      NULL
    }
  )

  if (is.null(python))
    return(FALSE)

  # set environment variables
  # - RENV_PYTHON is the version of Python renv was configured to use
  # - RETICULATE_PYTHON used to configure version of Python used by reticulate
  Sys.setenv(
    RENV_PYTHON       = python,
    RETICULATE_PYTHON = python
  )

  # place python + relevant utilities on the PATH
  bindir <- normalizePath(dirname(python), mustWork = FALSE)
  renv_envvar_prepend("PATH", bindir)

  # on Windows, for conda environments, we may also have a Scripts directory
  # which will need to be pre-pended to the PATH
  if (renv_platform_windows()) {
    scriptsdir <- file.path(bindir, "Scripts")
    if (file.exists(scriptsdir))
      renv_envvar_prepend("PATH", scriptsdir)
  }

  # for conda environments, we should try to find conda and place the conda
  # executable on the PATH, in case users want to use conda e.g. from
  # the terminal or even via R system calls
  #
  # we'll also need to set some environment variables to ensure that conda
  # uses this environment by default
  info <- renv_python_info(python)
  if (identical(info$type, "conda")) {
    conda <- renv_conda_find(python)
    if (file.exists(conda)) {
      renv_envvar_prepend("PATH", dirname(conda))
      Sys.setenv(CONDA_PREFIX = info$root)
    }
  }

  TRUE

}

renv_load_python_impl <- function(project, fields) {

  # if RENV_PYTHON is already set, just use it
  python <- Sys.getenv("RENV_PYTHON", unset = NA)
  if (!is.na(python))
    return(python)

  # set a default reticulate Python environment path
  envpath <- renv_paths_renv("python/r-reticulate", project = project)
  Sys.setenv(RETICULATE_MINICONDA_PYTHON_ENVPATH = envpath)

  # nothing more to do if no lockfile fields set
  if (is.null(fields))
    return(NULL)

  # delegate based on type appropriately
  type <- fields$Type
  if (is.null(type))
    return(NULL)

  python <- switch(type,
    system     = renv_load_python_default(project, fields),
    virtualenv = renv_load_python_virtualenv(project, fields),
    conda      = renv_load_python_condaenv(project, fields),
    stopf("unrecognized Python type '%s'", type)
  )

  renv_path_canonicalize(python)

}

renv_load_python_default <- function(project, fields) {

  # if 'Name' points to a valid copy of Python, use it
  name <- fields$Name
  if (!is.null(name) && file.exists(name))
    return(name)

  # otherwise, try to find a compatible version of Python
  renv_python_find(fields$Version)

}

renv_load_python_virtualenv <- function(project, fields) {

  renv_use_python_virtualenv_impl(
    project = project,
    name    = fields[["Name"]]    %NA% NULL,
    version = fields[["Version"]] %NA% NULL,
    python  = fields[["Python"]]  %NA% NULL
  )

}

renv_load_python_condaenv <- function(project, fields) {

  renv_use_python_condaenv_impl(
    project = project,
    name    = fields[["Name"]]    %NA% NULL,
    version = fields[["Version"]] %NA% NULL,
    python  = fields[["Python"]]  %NA% NULL
  )

}

renv_load_bioconductor <- function(project, bioconductor) {

  if (is.null(bioconductor) || getRversion() < "3.4")
    return()

  renv_bioconductor_init()
  BiocManager <- renv_namespace_load("BiocManager")
  if (is.null(BiocManager$.version_validate))
    return()

  status <- catch(BiocManager$.version_validate(bioconductor))
  if (!inherits(status, "error"))
    return()

  fmt <- lines(
    "This project is configured to use Bioconductor '%s', which is not compatible with R '%s'.",
    "Use 'renv::init(bioconductor = TRUE)' to re-initialize this project with the latest Bioconductor release."
  )

  warningf(fmt, bioconductor, getRversion())

}

renv_load_switch <- function(project) {

  # safety check: avoid recursive unload attempts
  unloading <- getOption("renv.unload.project")
  if (!is.null(unloading)) {
    fmt <- "ignoring recursive attempt to load project '%s'"
    warningf(fmt, renv_path_pretty(project))
    return(project)
  }

  # unset the RENV_PATHS_RENV environment variable
  # TODO: is there a path forward if different projects use
  # different RENV_PATHS_RENV paths?
  renvpath <- renv_envvar_get("RENV_PATHS_RENV")
  renv_envvar_clear("RENV_PATHS_RENV")

  # validate that this project has an activate script
  script <- renv_paths_activate(project = project)
  if (!file.exists(script)) {
    fmt <- "project %s has no activate script and so cannot be activated"
    stopf(fmt, renv_path_pretty(project))
  }

  # signal that we're unloading now
  renv_scope_options(renv.unload.project = project)

  # perform the unload
  unload()

  # unload the current version of renv (but keep track of position
  # on search path in case we need to revert later)
  path <- renv_namespace_path("renv")
  pos <- match("package:renv", search())
  unloadNamespace("renv")

  # move to new project directory
  owd <- setwd(project)
  on.exit(setwd(owd), add = TRUE)

  # source the activate script
  source(script)

  # check and see if renv was successfully loaded
  if (!"renv" %in% loadedNamespaces()) {
    fmt <- "could not load renv from project %s; reloading previously-loaded renv"
    warningf(fmt, renv_path_pretty(project))
    loadNamespace("renv", lib.loc = dirname(path))
    renv_envvar_set("RENV_PATHS_RENV", renvpath)
    if (!is.na(pos)) {
      args <- list(package = "renv", pos = pos, character.only = TRUE)
      do.call(base::library, args)
    }
  }

}

renv_load_cache <- function(project) {

  if (!interactive())
    return(FALSE)

  oldcache <- renv_paths_cache(version = renv_cache_version_previous())[[1L]]
  newcache <- renv_paths_cache(version = renv_cache_version())[[1L]]
  if (!file.exists(oldcache) || file.exists(newcache))
    return(FALSE)

  msg <- lines(
    "* The cache version has been updated in this version of renv.",
    "* Use `renv::rehash()` to migrate packages from the old renv cache."
  )

  vmessagef(msg)

}

renv_load_quiet <- function() {
  default <- identical(renv_verbose(), FALSE) || renv_session_quiet()
  config$startup.quiet(default = default)
}

renv_load_finish <- function(project, lockfile) {

  options(renv.project.path = project)

  if (!renv_load_quiet()) {
    renv_load_report_project(project)
    renv_load_report_python(project)
  }

  renv_load_report_updates(project)
  renv_load_report_synchronized(project, lockfile)

  renv_snapshot_auto_update(project = project)

}

renv_load_report_project <- function(project) {

  profile <- renv_profile_get()
  version <- renv_package_version("renv")

  if (length(profile)) {
    fmt <- "* (%s) Project '%s' loaded. [renv %s]"
    vwritef(fmt, profile, aliased_path(project), version)
  } else {
    fmt <- "* Project '%s' loaded. [renv %s]"
    vwritef(fmt, aliased_path(project), renv_package_version("renv"))
  }

}

renv_load_report_python <- function(project) {

  python <- Sys.getenv("RENV_PYTHON", unset = NA)
  if (is.na(python))
    return(FALSE)

  # fmt <- "* Using Python %s. [%s]"
  # vwritef(fmt, renv_python_version(python), renv_python_type(python))

}

renv_load_report_updates <- function(project) {

  # nocov start
  enabled <- interactive() && config$updates.check()
  if (!enabled)
    return(FALSE)

  callback <- function(...) renv_load_report_updates_impl(project = project)
  renv_load_invoke(callback)
  # nocov end

}

# nocov start
renv_load_report_updates_impl <- function(project) {

  lockpath <- renv_lockfile_path(project = project)
  if (!file.exists(lockpath))
    return(FALSE)

  status <- update(project = project, check = TRUE)
  available <- inherits(status, "renv_updates") && length(status$diff)
  if (!available)
    return(FALSE)

  vwritef("* Use `renv::update()` to install updated packages.")
  if (!interactive())
    print(status)

  TRUE

}
# nocov end

renv_load_report_synchronized <- function(project, lockfile) {

  # nocov start
  enabled <- interactive() && config$synchronized.check()
  if (!enabled)
    return(FALSE)

  callback <- function(...) renv_project_synchronized_check(project, lockfile)
  renv_load_invoke(callback)
  # nocov end

}

renv_load_invoke <- function(callback) {

  # helper function for running code that might need to
  # wait until RStudio has finished initializing
  if (renv_rstudio_loading())
    setHook("rstudio.sessionInit", callback, action = "append")
  else
    callback()

}


`_renv_locks` <- new.env(parent = emptyenv())

renv_lock_path <- function(project = NULL) {
  project <- renv_project_resolve(project)
  file.path(project, "renv/lock")
}

# NOTE: renv's locks are recursive process locks; once a given process
# has acquired a lock, it will hold onto that lock for as long as necessary
renv_lock_create <- function(path = NULL) {

  # resolve lock path
  path <- path %||% renv_lock_path()

  # ensure path normalized + exists
  path <- file.path(
    normalizePath(dirname(path), winslash = "/", mustWork = TRUE),
    basename(path)
  )

  # check for an existing id file; if it exists and we own it
  # then return an empty callback (indicating success but we previously
  # owned the lock)
  idpath <- file.path(path, "id")
  haslock <- exists(path, envir = `_renv_locks`) && file.exists(idpath)
  if (haslock) {
    id <- readLines(idpath)
    if (identical(id, `_renv_locks`[[path]]))
      return(function() {})
  }

  # try to create the lock (catch warnings / errors and treat them as failures)
  # TODO: how long should we wait here?
  i <- 1L

  while (TRUE) {

    # try to create the lock (exit on success)
    status <- catchall(dir.create(path))
    if (identical(status, TRUE))
      break

    # notify the user on the third attempt
    if (i == 3L) {
      fmt <- "* Another process is currently using renv in this project -- please wait a moment ..."
      vwritef(fmt)
    }

    # couldn't create the lock; sleep for a bit and try again
    Sys.sleep(1L)

    # update iterator
    i <- i + 1L

    # break after 30 minutes
    if (i == 300L)
      break

  }

  # check that we succeeded above
  if (!identical(status, TRUE)) {
    fmt <- "internal error: failed to acquire project lock"
    stop(fmt)
  }

  # validate that we created the lock
  if (!file.exists(path)) {
    msg <- "internal error: dir.create() returned TRUE but lock was not created"
    stop(msg)
  }

  # generate and write a UUID so we can confirm we are indeed
  # the owner of this lock when checking later
  id <- renv_id_generate()
  writeLines(id, con = file.path(path, "id"))
  assign(path, id, envir = `_renv_locks`)

  # we have created our lock: provide a callback to the caller that
  # can be used to destroy the lock
  function() { renv_lock_destroy(path) }

}

renv_lock_destroy <- function(path) {

  # remove the lockfile
  unlink(path, recursive = TRUE)

  # remove our lock cache entry
  rm(list = path, envir = `_renv_locks`)

  TRUE

}

renv_lockfile_resolve <- function(lockfile) {

  if (inherits(lockfile, "renv_lockfile_api"))
    return(lockfile$data())

  if (is.character(lockfile)) {
    if (any(grepl("\n", lockfile)))
      return(renv_lockfile_read(text = lockfile))
    else if (file.exists(lockfile))
      return(renv_lockfile_read(file = lockfile))
    else
      return(invisible(NULL))
  }

  lockfile

}

renv_lockfile_api <- function(lockfile = NULL) {

  .lockfile <- lockfile
  .self <- new.env(parent = emptyenv())

  .self$repos <- function(..., .repos = NULL) {

    if (nargs() == 0) {
      repos <- .lockfile$R$Repositories
      return(repos)
    }

    repos <- .repos %||% list(...)
    if (is.null(names(repos)) || "" %in% names(repos))
      stop("repositories must all be named", call. = FALSE)

    .lockfile$R$Repositories <<- as.list(convert(repos, "character"))
    invisible(.self)

  }

  .self$version <- function(..., .version = NULL) {

    if (nargs() == 0) {
      version <- .lockfile$R$Version
      return(version)
    }

    version <- .version %||% c(...)

    if (length(version) > 1) {
      stop("Version should be length 1 character e.g. `\"3.6.3\"`")
    }

    .lockfile$R$Version <<- version
    invisible(.self)

  }

  .self$add <- function(..., .list = NULL) {

    records <- renv_records(.lockfile)

    dots <- .list %||% list(...)
    enumerate(dots, function(package, remote) {
      resolved <- renv_remotes_resolve(remote)
      records[[package]] <<- resolved
    })

    renv_records(.lockfile) <<- records
    invisible(.self)

  }

  .self$remove <- function(packages) {
    records <- renv_records(.lockfile)
    records <- drop(records, packages)
    renv_records(.lockfile) <<- records
    invisible(.self)
  }

  .self$write <- function(file = stdout()) {
    renv_lockfile_write(.lockfile, file = file)
    invisible(.self)
  }

  .self$data <- function() {
    .lockfile
  }

  class(.self) <- "renv_lockfile_api"
  .self

}

#' @export
print.renv_lockfile_api <- function(x, ...) {
  lockfile <- x$data()
  records <- renv_records(lockfile)
  n <- length(records)
  fmt <- "A lockfile containing %i package %s."
  msg <- sprintf(fmt, n, plural("record", n))
  writeLines(msg)
}

#' @export
str.renv_lockfile_api <- function(object, ...) {
  lockfile <- object$data()
  str(lockfile)
}

#' Programmatically Create and Modify a Lockfile
#'
#' This function provides an API for creating and modifying `renv` lockfiles.
#' This can be useful when you'd like to programmatically generate or modify
#' a lockfile -- for example, because you want to update or change a package
#' record in an existing lockfile.
#'
#' @inheritParams renv-params
#'
#' @param file The path to an existing lockfile. When no lockfile is provided,
#'   a new one will be created based on the current project context. If you
#'   want to create a blank lockfile, use `file = NA` instead.
#'
#' @seealso \code{\link{lockfiles}}, for a description of the structure of an
#'   `renv` lockfile.
#'
#' @examples
#'
#' \dontrun{
#'
#' lock <- lockfile("renv.lock")
#'
#' # set the repositories for a lockfile
#' lock$repos(CRAN = "https://cran.r-project.org")
#'
#' # depend on digest 0.6.22
#' lock$add(digest = "digest@@0.6.22")
#'
#' # write to file
#' lock$write("renv.lock")
#'
#' }
lockfile <- function(file = NULL, project = NULL) {
  project <- renv_project_resolve(project)
  renv_scope_error_handler()

  lock <- if (is.null(file)) {

    renv_lockfile_create(
      project  = project,
      libpaths = renv_libpaths_all(),
      type     = settings$snapshot.type(project = project)
    )

  } else if (is.na(file)) {

    renv_lockfile_init(project)

  } else {

    renv_lockfile_read(file = file)

  }

  renv_lockfile_api(lock)

}

renv_lockfile_diff <- function(old, new, compare = NULL) {

  compare <- compare %||% function(lhs, rhs) {
    list(before = lhs, after = rhs)
  }

  # ensure both lists have the same names, inserting missing
  # entries for those without any value
  nms <- union(names(old), names(new)) %||% character()
  if (length(nms)) {

    nms <- sort(nms)
    old[renv_vector_diff(nms, names(old))] <- list(NULL)
    new[renv_vector_diff(nms, names(new))] <- list(NULL)

    old <- old[nms]
    new <- new[nms]

  }

  # ensure that these have the same length for comparison
  if (is.list(old) && is.list(new))
    length(old) <- length(new) <- max(length(old), length(new))

  # check for differences
  diffs <- mapply(
    renv_lockfile_diff_impl, old, new,
    MoreArgs = list(compare = compare),
    SIMPLIFY = FALSE
  )

  # drop NULL entries
  reject(diffs, empty)

}

renv_lockfile_diff_impl <- function(lhs, rhs, compare) {
  case(
    is.list(lhs) && empty(rhs)   ~ renv_lockfile_diff(lhs, list(), compare),
    empty(lhs) && is.list(rhs)   ~ renv_lockfile_diff(list(), rhs, compare),
    is.list(lhs) && is.list(rhs) ~ renv_lockfile_diff(lhs, rhs, compare),
    !identical(c(lhs), c(rhs))   ~ compare(lhs, rhs),
    NULL
  )
}

renv_lockfile_diff_record <- function(before, after) {

  before <- renv_record_normalize(before)
  after  <- renv_record_normalize(after)

  # first, compare on version / record existence
  type <- case(
    is.null(before) ~ "install",
    is.null(after)  ~ "remove",
    before$Version < after$Version ~ "upgrade",
    before$Version > after$Version ~ "downgrade"
  )

  if (!is.null(type))
    return(type)

  # check for a crossgrade -- where the package version is the same,
  # but details about the package's remotes have changed
  if (!setequal(renv_record_names(before), renv_record_names(after)))
    return("crossgrade")

  nm <- union(renv_record_names(before), renv_record_names(after))
  if (!identical(before[nm], after[nm]))
    return("crossgrade")

  NULL

}

renv_lockfile_diff_packages <- function(old, new) {

  old <- renv_records(old)
  new <- renv_records(new)

  packages <- named(union(names(old), names(new)))
  actions <- lapply(packages, function(package) {
    before <- old[[package]]; after <- new[[package]]
    renv_lockfile_diff_record(before, after)
  })

  Filter(Negate(is.null), actions)

}

renv_lockfile_override <- function(lockfile) {
  records <- renv_records(lockfile)
  overrides <- renv_records_override(records)
  renv_records(lockfile) <- overrides
  lockfile
}

renv_lockfile_repair <- function(lockfile) {

  records <- renv_records(lockfile)

  # fix up records in lockfile
  renv_records(lockfile) <- enumerate(records, function(package, record) {

    # if this package is from a repository, but doesn't specify an explicit
    # version, then use the latest-available version of that package
    source <- renv_record_source_normalize(record, record$Source)
    if (identical(source, "Repository") && is.null(record$Version)) {
      entry <- renv_available_packages_latest(package)
      record$Version <- entry$Version
    }

    # return normalized record
    record

  })

  lockfile

}

renv_lockfile_read_finish_impl <- function(key, val) {

  # convert repository records to named vectors
  # (be careful to handle NAs, NULLs)
  if (identical(key, "Repositories") && is.null(names(val))) {

    getter <- function(name) function(record) record[[name]] %||% "" %NA% ""
    keys <- map_chr(val, getter("Name"))
    vals <- map_chr(val, getter("URL"))

    result <- case(
      empty(keys)       ~ list(),
      any(nzchar(keys)) ~ named(vals, keys),
      TRUE              ~ vals
    )

    return(as.list(result))

  }

  # recurse for lists
  if (is.list(val))
    return(enumerate(val, renv_lockfile_read_finish_impl))

  # return other values as-is
  val

}

renv_lockfile_read_finish <- function(data) {

  # convert repository fields
  data <- enumerate(data, renv_lockfile_read_finish_impl)

  # set class
  class(data) <- "renv_lockfile"
  data

}

renv_lockfile_read_preflight <- function(contents) {

  # check for merge conflict markers
  starts <- grep("^[<]+", contents)
  ends   <- grep("^[>]+", contents)

  hasconflicts <-
    length(starts) &&
    length(ends) &&
    length(starts) == length(ends)

  if (hasconflicts) {

    parts <- .mapply(function(start, end) {
      c(contents[start:end], "")
    }, list(starts, ends), NULL)

    all <- unlist(parts, recursive = TRUE, use.names = FALSE)

    renv_pretty_print(
      values    = head(all, n = -1L),
      preamble  = "The lockfile contains one or more merge conflict markers:",
      postamble = "You will need to resolve these merge conflicts before the file can be read.",
      emitter   = message,
      wrap      = FALSE
    )

    stop("lockfile contains merge conflict markers; cannot proceed", call. = FALSE)

  }

}

renv_lockfile_read <- function(file = NULL, text = NULL) {

  # read the lockfile
  contents <- if (is.null(file))
    unlist(strsplit(text, "\n", fixed = TRUE))
  else
    readLines(file, warn = FALSE, encoding = "UTF-8")

  # check and report some potential errors (e.g. merge conflicts)
  renv_lockfile_read_preflight(contents)
  json <- renv_json_read(text = contents)
  renv_lockfile_read_finish(json)

}

`_renv_lockfile_state` <- new.env(parent = emptyenv())

renv_lockfile_state_get <- function(key) {
  if (exists(key, envir = `_renv_lockfile_state`))
    get(key, envir = `_renv_lockfile_state`, inherits = FALSE)
}

renv_lockfile_state_set <- function(key, value) {
  assign(key, value, envir = `_renv_lockfile_state`, inherits = FALSE)
}

renv_lockfile_state_clear <- function() {
  rm(list = ls(`_renv_lockfile_state`), envir = `_renv_lockfile_state`)
}

renv_lockfile_write_preflight <- function(old, new) {

  diff <- renv_lockfile_diff(old, new)
  if (empty(diff))
    return(new)

  packages <- diff$Packages
  if (empty(diff$Packages))
    return(new)

  enumerate(packages, function(package, changes) {

    # avoid spurious changes between CRAN and RSPM
    spurious <-
      identical(changes, list(Repository = list(before = "CRAN", after = "RSPM"))) ||
      identical(changes, list(Repository = list(before = "RSPM", after = "CRAN")))

    if (spurious)
      new$Packages[[package]]$Repository <<- old$Packages[[package]]$Repository

  })

  new

}

renv_lockfile_write <- function(lockfile, file = stdout()) {

  # if we're updating an existing lockfile, try to avoid
  # "unnecessary" diffs that might otherwise be annoying
  if (is.character(file) && file.exists(file)) {
    old <- catch(renv_lockfile_read(file))
    if (!inherits(old, "error"))
      lockfile <- renv_lockfile_write_preflight(old, lockfile)
  }

  # specify the dependencies for each package, so that
  # pak can figure out the correct installation order
  lockfile$Packages <- enumerate(lockfile$Packages, function(package, record) {

    # collect package requirements
    keys <- c("Depends", "Imports", "LinkingTo", "Requirements")
    vals <- keep(record, keys)
    record <- drop(record, keys)

    # normalize required packages
    record$Requirements <- vals %>%
      unlist(use.names = FALSE) %>%
      gsub(pattern = "\\s*\\(.*", replacement = "", perl = TRUE) %>%
      intersect(names(lockfile$Packages)) %>%
      csort()

    # return updated record
    record

  })

  lockfile <- renv_lockfile_sort(lockfile)
  renv_lockfile_write_json(lockfile, file)

}

renv_lockfile_write_json_prepare_repos <- function(repos) {

  prepared <- enumerate(repos, function(name, url) {
    url <- sub("/+$", "", url)
    list(Name = name, URL = url)
  })

  unname(prepared)
}

renv_lockfile_write_json_prepare <- function(key, val) {

  if (key == "Repositories")
    renv_lockfile_write_json_prepare_repos(val)
  else if (is.list(val))
    enumerate(val, renv_lockfile_write_json_prepare)
  else
    val

}

renv_lockfile_write_json <- function(lockfile, file = stdout()) {

  prepared <- enumerate(lockfile, renv_lockfile_write_json_prepare)

  box <- c("Depends", "Imports", "Suggests", "LinkingTo", "Requirements")
  config <- list(box = box)
  json <- renv_json_convert(prepared, config)
  if (is.null(file))
    return(json)

  writeLines(json, con = file)

}

renv_lockfile_write_internal <- function(lockfile,
                                         file = stdout(),
                                         delim = "=",
                                         emitter = NULL)
{
  if (is.character(file)) {
    file <- textfile(file)
    on.exit(close(file), add = TRUE)
  }

  emitter <- emitter %||% function(text) writeLines(text, con = file)

  renv_lockfile_state_set("delim", delim)
  renv_lockfile_state_set("emitter", emitter)
  on.exit(renv_lockfile_state_clear(), add = TRUE)

  renv_lockfile_write_list(lockfile, section = character())
  invisible(lockfile)
}

renv_lockfile_write_list <- function(entry, section) {
  enumerate(entry, renv_lockfile_write_atoms, section = section)
  enumerate(entry, renv_lockfile_write_lists, section = section)
}

renv_lockfile_write_atoms <- function(key, value, section) {

  sublists <- map_lgl(value, function(x) identical(class(x), "list"))
  if (all(sublists))
    return()

  subsection <- c(section, key)
  label <- sprintf("[%s]", paste(subsection, collapse = "/"))
  renv_lockfile_write_emit(label)

  enumerate(value[!sublists], renv_lockfile_write_atom)
  renv_lockfile_write_emit()

}

renv_lockfile_write_atom <- function(key, value) {

  lhs <- key
  rhs <- if (is_named(value))
    paste(sprintf("\n\t%s=%s", names(value), value), collapse = "")
  else
    paste(value, collapse = ", ")

  delim <- renv_lockfile_state_get("delim")
  text <- paste(lhs, rhs, sep = delim)
  renv_lockfile_write_emit(text)

}

renv_lockfile_write_lists <- function(key, value, section) {
  sublists <- map_lgl(value, function(x) identical(class(x), "list"))
  renv_lockfile_write_list(value[sublists], section = c(section, key))
}

renv_lockfile_write_emit <- function(text = "") {
  emitter <- renv_lockfile_state_get("emitter")
  emitter(text)
}

renv_lockfile_init <- function(project) {

  lockfile <- list()

  lockfile$R        <- renv_lockfile_init_r(project)
  lockfile$Python   <- renv_lockfile_init_python(project)
  lockfile$Packages <- list()

  class(lockfile) <- "renv_lockfile"
  lockfile

}

renv_lockfile_init_r_version <- function(project) {

  version <-
    settings$r.version(project = project) %||%
    getRversion()

  format(version)

}

renv_lockfile_init_r_repos <- function(project) {

  repos <- getOption("repos")

  # save names
  nms <- names(repos)

  # force as character
  repos <- as.character(repos)

  # clear RStudio attribute
  attr(repos, "RStudio") <- NULL

  # set a default URL
  repos[repos == "@CRAN@"] <- getOption(
    "renv.repos.cran",
    "https://cloud.r-project.org"
  )

  # remove RSPM bits from URL
  if (config$rspm.enabled()) {
    pattern <- "/__[^_]+__/[^/]+/"
    repos <- sub(pattern, "/", repos)
  }

  # force as list
  repos <- as.list(repos)

  # ensure names
  names(repos) <- nms

  repos

}

renv_lockfile_init_r <- function(project) {
  version <- renv_lockfile_init_r_version(project)
  repos   <- renv_lockfile_init_r_repos(project)
  list(Version = version, Repositories = repos)
}

renv_lockfile_init_python <- function(project) {

  python <- Sys.getenv("RENV_PYTHON", unset = NA)
  if (is.na(python))
    return(NULL)

  if (!file.exists(python))
    return(NULL)

  info <- renv_python_info(python)
  if (is.null(info))
    return(NULL)

  version <- renv_python_version(python)
  type <- info$type
  root <- info$root
  name <- renv_python_envname(project, root, type)

  fields <- list()

  fields$Version <- version
  fields$Type    <- type
  fields$Name    <- name

  fields

}

renv_lockfile_fini <- function(lockfile, project) {
  lockfile$Bioconductor <- renv_lockfile_fini_bioconductor(lockfile, project)
  lockfile
}

renv_lockfile_fini_bioconductor <- function(lockfile, project) {

  records <- renv_records(lockfile)
  if (empty(records))
    return(NULL)

  for (package in c("BiocManager", "BiocInstaller"))
    if (!is.null(records[[package]]))
      return(list(Version = renv_bioconductor_version(project = project)))

  sources <- extract_chr(records, "Source")
  if ("Bioconductor" %in% sources)
    return(list(Version = renv_bioconductor_version(project = project)))

}

renv_lockfile_path <- function(project) {
  renv_paths_lockfile(project = project)
}

renv_lockfile_save <- function(lockfile, project) {
  file <- renv_lockfile_path(project)
  renv_lockfile_write(lockfile, file = file)
}

renv_lockfile_load <- function(project) {

  path <- renv_lockfile_path(project)
  if (file.exists(path))
    return(renv_lockfile_read(path))

  renv_lockfile_init(project = project)

}

renv_lockfile_sort <- function(lockfile) {

  # ensure C locale for consistent sorting
  renv_scope_locale("LC_COLLATE", "C")

  # extract R records (nothing to do if empty)
  records <- renv_records(lockfile)
  if (empty(records))
    return(lockfile)

  # sort the records
  sorted <- records[sort(names(records))]
  renv_records(lockfile) <- sorted

  # sort top-level fields
  fields <- unique(c("R", "Python", "Packages"), names(lockfile))
  lockfile <- lockfile[intersect(fields, names(lockfile))]

  # return post-sort
  lockfile

}

renv_lockfile_create <- function(project, libpaths, type, packages) {

  lockfile <- renv_lockfile_init(project)

  renv_records(lockfile) <-

    renv_snapshot_r_packages(libpaths = libpaths,
                             project  = project) %>%

    renv_snapshot_filter(project = project,
                         type = type,
                         packages = packages) %>%

    renv_snapshot_fixup()

  lockfile <- renv_lockfile_fini(lockfile, project)

  keys <- unique(c("R", "Bioconductor", names(lockfile)))
  lockfile <- lockfile[intersect(keys, names(lockfile))]

  class(lockfile) <- "renv_lockfile"
  lockfile

}

renv_lockfile_modify <- function(lockfile, records) {

  enumerate(records, function(package, record) {
    renv_records(lockfile)[[package]] <<- record
  })

  lockfile

}

renv_lockfile_compact <- function(lockfile) {

  records <- renv_records(lockfile)
  remotes <- map_chr(records, renv_record_format_remote)

  renv_scope_locale("LC_COLLATE", "C")
  remotes <- sort(remotes)

  formatted <- sprintf("  \"%s\"", remotes)
  joined <- paste(formatted, collapse = ",\n")

  all <- c("renv::use(", joined, ")")
  paste(all, collapse = "\n")

}

#' Lockfiles
#'
#' A **lockfile** records the state of a project at some point in time.
#'
#' A lockfile captures the state of a project's library at some point in time.
#' In particular, the package names, their versions, and their sources (when
#' known) are recorded in the lockfile.
#'
#' Projects can be restored from a lockfile using the [restore()] function. This
#' implies reinstalling packages into the project's private library, as encoded
#' within the lockfile.
#'
#' While lockfiles are normally generated and used with [snapshot()] /
#' [restore()], they can also be edited by hand if so desired. Lockfiles are
#' written as `.json`, to allow for easy consumption by other tools.
#'
#' An example lockfile follows:
#'
#' ```
#' {
#'   "R": {
#'     "Version": "3.6.1",
#'     "Repositories": [
#'       {
#'         "Name": "CRAN",
#'         "URL": "https://cloud.r-project.org"
#'       }
#'     ]
#'   },
#'   "Packages": {
#'     "markdown": {
#'       "Package": "markdown",
#'       "Version": "1.0",
#'       "Source": "Repository",
#'       "Repository": "CRAN",
#'       "Hash": "4584a57f565dd7987d59dda3a02cfb41"
#'     },
#'     "mime": {
#'       "Package": "mime",
#'       "Version": "0.7",
#'       "Source": "Repository",
#'       "Repository": "CRAN",
#'       "Hash": "908d95ccbfd1dd274073ef07a7c93934"
#'     }
#'   }
#' }
#' ```
#'
#' The sections used within a lockfile are described next.
#'
#' @section \[renv\]:
#'
#' Information about the version of `renv` used to manage this project.
#'
#' \tabular{ll}{
#' \strong{Version}     \tab The version of the `renv` package used with this project. \cr
#' }
#'
#' @section \[R\]:
#'
#' Properties related to the version of \R associated with this project.
#'
#' \tabular{ll}{
#' \strong{Version}      \tab The version of \R used. \cr
#' \strong{Repositories} \tab The \R repositories used in this project. \cr
#' }
#'
#' @section \[Packages\]:
#'
#' \R package records, capturing the packages used or required by a project
#' at the time when the lockfile was generated.
#'
#' \tabular{ll}{
#' \strong{Package}      \tab The package name. \cr
#' \strong{Version}      \tab The package version. \cr
#' \strong{Source}       \tab The location from which this package was retrieved. \cr
#' \strong{Repository}   \tab The name of the repository (if any) from which this package was retrieved. \cr
#' \strong{Hash}         \tab (Optional) A unique hash for this package, used for package caching. \cr
#' }
#'
#' Additional remote fields, further describing how the package can be
#' retrieved from its corresponding source, will also be included as
#' appropriate (e.g. for packages installed from GitHub).
#'
#' @section \[Python\]:
#'
#' Metadata related to the version of Python used with this project (if any).
#'
#' \tabular{ll}{
#' \strong{Version} \tab The version of Python being used. \cr
#' \strong{Type}    \tab The type of Python environment being used ("virtualenv", "conda", "system") \cr
#' \strong{Name}    \tab The (optional) name of the environment being used.
#' }
#'
#' Note that the `Name` field may be empty. In that case, a project-local Python
#' environment will be used instead (when not directly using a system copy of Python).
#'
#' @family reproducibility
#' @name lockfiles
#' @rdname lockfiles
NULL

log <- function(level, fmt, ...) {

  if (level >= getOption("renv.log.level", default = 4L)) {
    msg <- sprintf(fmt, ...)
    renv_log_impl(msg)
  }

}

elog <- function(fmt, ...) {
  log(4L, fmt, ...)
}

wlog <- function(fmt, ...) {
  log(3L, fmt, ...)
}

ilog <- function(fmt, ...) {
  log(2L, fmt, ...)
}

dlog <- function(fmt, ...) {
  log(1L, fmt, ...)
}


renv_log_impl <- function(msg) {

  # build log message
  fmt <- "[%s] renv: %s"
  now <- format(Sys.time(), tz = "UTC")
  all <- sprintf(fmt, now, msg)

  # write it out
  con <- getOption("renv.log.file", default = stdout())
  cat(all, file = con, sep = "\n", append = TRUE)

}

renv_log_init <- function() {
  renv_log_init_level()
  renv_log_init_file()
}

renv_log_init_level <- function() {

  # check for environment variable
  level <- Sys.getenv("RENV_LOG_LEVEL", unset = NA)
  if (is.na(level))
    return()

  # read and assign
  override <- case(
    level %in% c("error",   "ERROR")   ~ 4L,
    level %in% c("warning", "WARNING") ~ 3L,
    level %in% c("info",    "INFO")    ~ 2L,
    level %in% c("debug",   "DEBUG")   ~ 1L,
    ~ warningf("ignoring invalid RENV_LOG_LEVEL environment variable")
  )

  options(renv.log.level = override)

}

renv_log_init_file <- function() {

  file <- Sys.getenv("RENV_LOG_FILE", unset = NA)
  if (is.na(file))
    return()

  options(renv.log.file = file)

}

#' Generate `renv.lock` from an RStudio Connect `manifest.json`
#'
#' Use `renv_lockfile_from_manifest()` to convert a `manifest.json` file from
#' an RStudio Connect content bundle into an `renv.lock` lockfile.
#'
#' This function can be useful when you need to recreate the package environment
#' of a piece of content that is deployed to RStudio Connect. The content bundle
#' contains a `manifest.json` file that is used to recreate the package
#' environment. This function will let you convert that manifest file to an
#' `renv.lock` file. Run `renv::restore()` after you've converted the file to
#' restore the package environment.
#'
#' @param manifest
#'   The path to a `manifest.json` file.
#'
#' @param lockfile
#'   The path to the lockfile to be generated and / or updated.
#'   When `NA` (the default), the generated lockfile is returned as an \R
#'   object; otherwise, the lockfile will be written to the path specified by
#'   `lockfile`.
#'
#' @details
#' By default the `lockfile` argument is set to `NA`. This will not create a new
#' `renv.lock` file. Rather, it will return a lockfile object (see `?lockfile`)
#' that can be used to create a new `renv.lock` file. If `lockfile` is set to a
#' character string, a new file will be created with that path -- e.g.
#' `renv.lock` -- and the lockfile object will be returned.
#'
#' @return
#' An `renv` lockfile.
#'
#' @keywords internal
renv_lockfile_from_manifest <- function(manifest,
                                        lockfile = NA,
                                        project = NULL)
{
  renv_scope_error_handler()
  project <- renv_project_resolve(project)

  # read the manifest (accept both lists and file paths)
  manifest <- case(
    is.character(manifest) ~ renv_json_read(manifest),
    is.list(manifest)      ~ manifest,
    TRUE                   ~ renv_type_unexpected(manifest)
  )

  # convert descriptions into records
  records <- map(manifest[["packages"]], function(entry) {
    desc <- entry[["description"]]
    renv_snapshot_description_impl(desc)
  })

  # extract repositories from descriptions
  repos <- list()
  for (entry in manifest[["packages"]]) {

    if (is.null(entry[["Repository"]]))
      next

    src <- entry[["Source"]] %||% "CRAN"
    repo <- entry[["Repository"]]

    repos[[src]] <- repo

  }

  # extract version
  version <- numeric_version(manifest[["platform"]] %||% getRversion())

  # create R field for lockfile
  r <- list(Version = version, Repositories = repos)

  # create the lockfile
  lock <- list(R = r, Packages = records)
  class(lock) <- "renv_lockfile"

  # return lockfile as R object if requested
  if (is.na(lockfile))
    return(lock)

  # otherwise, write to file and report for user
  renv_lockfile_write(lock, file = lockfile)
  fmt <- "* Lockfile written to %s."
  vwritef(fmt, renv_path_pretty(lockfile))

  invisible(lock)

}

renv_methods_map <- function() {

  list(

    renv_path_normalize = c(
      unix  = "renv_path_normalize_unix",
      win32 = "renv_path_normalize_win32"
    ),

    renv_file_list_impl = c(
      unix  = "renv_file_list_impl_unix",
      win32 = "renv_file_list_impl_win32"
    ),

    renv_file_broken = c(
      unix  = "renv_file_broken_unix",
      win32 = "renv_file_broken_win32"
    )

  )

}

renv_methods_init <- function() {

  # get list of method mappings
  methods <- renv_methods_map()

  # determine appropriate lookup key for finding alternative
  key <- if (renv_platform_windows()) "win32" else "unix"
  alts <- map(methods, `[[`, key)

  # update methods in namespace
  envir <- renv_envir_self()
  enumerate(alts, function(name, alt) {
    replacement <- eval(parse(text = alt), envir = envir)
    assign(name, replacement, envir = envir)
  })

}

renv_methods_error <- function() {
  call <- sys.call(sys.parent())
  fmt <- "internal error: '%s()' not initialized in .onLoad()"
  stopf(fmt, as.character(call[[1L]]), call. = FALSE)
}

#' Migrate a Project from Packrat to renv
#'
#' Migrate a project's infrastructure from Packrat to `renv`.
#'
#' @section Migration:
#'
#' When migrating Packrat projects to `renv`, the set of components migrated
#' can be customized using the `packrat` argument. The set of components that
#' can be migrated are as follows:
#'
#' \tabular{ll}{
#'
#' **Name** \tab **Description** \cr
#'
#' `lockfile` \tab
#'   Migrate the Packrat lockfile (`packrat/packrat.lock`) to the `renv` lockfile
#'   (`renv.lock`). \cr
#'
#' `sources` \tab
#'   Migrate package sources from the `packrat/src` folder to the `renv`
#'   sources folder. Currently, only CRAN packages are migrated to `renv` --
#'   packages retrieved from other sources (e.g. GitHub) are ignored.
#'   \cr
#'
#' `library` \tab
#'   Migrate installed packages from the Packrat library to the `renv` project
#'   library.
#'   \cr
#'
#' `options` \tab
#'   Migrate compatible Packrat options to the `renv` project.
#'   \cr
#'
#' `cache` \tab
#'   Migrate packages from the Packrat cache to the `renv` cache.
#'   \cr
#'
#' }
#'
#' @inherit renv-params
#'
#' @param packrat Components of the Packrat project to migrate. See the default
#'   argument list for components of the Packrat project that can be migrated.
#'   Select a subset of those components for migration as appropriate.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # migrate Packrat project infrastructure to renv
#' renv::migrate()
#'
#' }
migrate <- function(
  project = NULL,
  packrat = c("lockfile", "sources", "library", "options", "cache"))
{
  renv_consent_check()
  renv_scope_error_handler()

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  # for jetpack
  if (renv_package_checking())
    renv_patch_repos()

  project <- renv_path_normalize(project, winslash = "/", mustWork = TRUE)
  if (file.exists(file.path(project, "packrat/packrat.lock"))) {
    packrat <- match.arg(packrat, several.ok = TRUE)
    renv_migrate_packrat(project, packrat)
  }

  invisible(project)
}

renv_migrate_packrat <- function(project = NULL, components = NULL) {
  project <- renv_project_resolve(project)

  if (!requireNamespace("packrat", quietly = TRUE))
    stopf("migration requires the 'packrat' package to be installed")

  callbacks <- list(
    lockfile = renv_migrate_packrat_lockfile,
    sources  = renv_migrate_packrat_sources,
    library  = renv_migrate_packrat_library,
    options  = renv_migrate_packrat_options,
    cache    = renv_migrate_packrat_cache
  )

  components <- components %||% names(callbacks)
  callbacks <- callbacks[components]
  for (callback in callbacks)
    callback(project)

  renv_migrate_packrat_infrastructure(project)
  renv_imbue_impl(project)

  fmt <- "* Project '%s' has been migrated from Packrat to renv."
  vwritef(fmt, aliased_path(project))

  vwritef("* Consider deleting the project 'packrat' folder if it is no longer needed.")
  invisible(TRUE)
}

renv_migrate_packrat_lockfile <- function(project) {

  plock <- file.path(project, "packrat/packrat.lock")
  if (!file.exists(plock))
    return(FALSE)

  # read the lockfile
  contents <- read(plock)
  splat <- strsplit(contents, "\n{2,}")[[1]]
  dcf <- lapply(splat, function(section) {
    renv_dcf_read(text = section)
  })

  # split into header + package fields
  header <- dcf[[1]]
  records <- dcf[-1L]

  # parse the repositories
  repos <- getOption("repos")
  if (!is.null(header$Repos)) {
    parts <- strsplit(header$Repos, "\\s*,\\s*")[[1]]
    repos <- renv_properties_read(text = parts, delimiter = "=")
  }

  # fix-up some record fields for renv
  fields <- c("Package", "Version", "Source")
  records <- lapply(records, function(record) {

    # remove an old packrat hash
    record$Hash <- NULL

    # add RemoteType for GitHub records
    if (any(grepl("^Github", names(record))))
      record$RemoteType <- "github"

    # remap '^Github'-style records to '^Remote'
    map <- c(
      "GithubRepo"     = "RemoteRepo",
      "GithubUsername" = "RemoteUsername",
      "GithubRef"      = "RemoteRef",
      "GithubSha1"     = "RemoteSha",
      "GithubSHA1"     = "RemoteSha",
      "GithubSubdir"   = "RemoteSubdir"
    )
    names(record) <- remap(names(record), map)

    # keep only fields of interest
    keep <- c(fields, grep("^Remote", names(record), value = TRUE))
    as.list(record[keep])

  })

  # pull out names for records
  names(records) <- extract_chr(records, "Package")

  # ensure renv is added
  records <- renv_snapshot_fixup_renv(records)

  # generate a blank lockfile
  lockfile <- structure(list(), class = "renv_lockfile")
  lockfile$R <- renv_lockfile_init_r(project)

  # update fields
  lockfile$R$Version <- header$RVersion
  lockfile$R$Repositories <- as.list(repos)
  renv_records(lockfile) <- records

  # finish
  lockfile <- renv_lockfile_fini(lockfile, project)

  # write the lockfile
  lockpath <- renv_lockfile_path(project = project)
  renv_lockfile_write(lockfile, file = lockpath)

}

renv_migrate_packrat_sources <- function(project) {

  packrat <- asNamespace("packrat")
  srcdir <- packrat$srcDir(project = project)
  if (!file.exists(srcdir))
    return(TRUE)

  pattern <- paste0(
    "^",                   # start
    "[^_]+",               # package name
    "_",                   # separator
    "\\d+(?:[_.-]\\d+)*",  # version
    "\\.tar\\.gz",         # extension
    "$"                    # end
  )

  suffixes <- list.files(
    srcdir,
    pattern = pattern,
    recursive = TRUE
  )

  sources <- file.path(srcdir, suffixes)
  targets <- renv_paths_source("cran", suffixes)

  keep <- !file.exists(targets)
  sources <- sources[keep]; targets <- targets[keep]

  vprintf("* Migrating package sources from Packrat to renv ... ")
  copy <- renv_progress_callback(renv_file_copy, length(targets))
  mapply(sources, targets, FUN = function(source, target) {
    ensure_parent_directory(target)
    copy(source, target)
  })
  vwritef("Done!")

  TRUE

}

renv_migrate_packrat_library <- function(project) {

  packrat <- asNamespace("packrat")

  libdir <- packrat$libDir(project = project)
  if (!file.exists(libdir))
    return(TRUE)

  sources <- list.files(libdir, full.names = TRUE)
  if (empty(sources))
    return(TRUE)

  targets <- renv_paths_library(basename(sources), project = project)

  names(targets) <- sources
  targets <- targets[!file.exists(targets)]
  if (empty(targets)) {
    vwritef("* The renv library is already synchronized with the Packrat library.")
    return(TRUE)
  }

  # copy packages from Packrat to renv private library
  vprintf("* Migrating library from Packrat to renv ... ")
  ensure_parent_directory(targets)
  copy <- renv_progress_callback(renv_file_copy, length(targets))
  enumerate(targets, copy)
  vwritef("Done!")

  # move packages into the cache
  if (renv_cache_config_enabled(project = project)) {
    vprintf("* Moving packages into the renv cache ... ")
    records <- lapply(targets, renv_description_read)
    sync <- renv_progress_callback(renv_cache_synchronize, length(targets))
    lapply(records, sync, linkable = TRUE)
    vwritef("Done!")
  }

  TRUE

}

renv_migrate_packrat_options <- function(project) {

  packrat <- asNamespace("packrat")
  opts <- packrat$get_opts(project = project)

  settings$ignored.packages(opts$ignored.packages, project = project)

}

renv_migrate_packrat_cache <- function(project) {

  # find packages in the packrat cache
  packrat <- asNamespace("packrat")
  cache <- packrat$cacheLibDir()
  packages <- list.files(cache, full.names = TRUE)
  hashes <- list.files(packages, full.names = TRUE)
  sources <- list.files(hashes, full.names = TRUE)

  # sanity check: make sure the source folder is an R package
  ok <- file.exists(file.path(sources, "DESCRIPTION"))
  sources <- sources[ok]

  # construct cache target paths
  targets <- map_chr(sources, renv_cache_path)
  names(targets) <- sources

  # only copy to cache target paths that don't exist
  targets <- targets[!file.exists(targets)]
  if (empty(targets)) {
    vwritef("* The renv cache is already synchronized with the Packrat cache.")
    return(TRUE)
  }

  # cache each installed package
  if (renv_cache_config_enabled(project = project))
    renv_migrate_packrat_cache_impl(targets)

  TRUE

}

renv_migrate_packrat_cache_impl <- function(targets) {

  # attempt to copy packages from Packrat to renv cache
  vprintf("* Migrating Packrat cache to renv cache ... ")
  ensure_parent_directory(targets)
  copy <- renv_progress_callback(renv_file_copy, length(targets))

  result <- enumerate(targets, function(source, target) {
    status <- catch(copy(source, target))
    broken <- inherits(status, "error")
    reason <- if (broken) conditionMessage(status) else ""
    list(source = source, target = target, broken = broken, reason = reason)
  })

  vwritef("Done!")

  # report failures
  status <- bind(result)
  bad <- status[status$broken, ]
  if (nrow(bad) == 0)
    return(TRUE)

  renv_pretty_print(
    with(bad, sprintf("%s [%s]", format(source), reason)),
    "The following packages could not be copied from the Packrat cache:",
    "These packages may need to be reinstalled and re-cached."
  )

}

renv_migrate_packrat_infrastructure <- function(project) {
  unlink(file.path(project, ".Rprofile"))
  renv_infrastructure_write(project)
  vwritef("* renv support infrastructure has been written.")
  TRUE
}

#' Modify a Lockfile
#'
#' Modify a project's lockfile, either interactively or non-interactively.
#'
#' After edit, if the lockfile edited is associated with the active project, any
#' state-related changes (e.g. to \R repositories) will be updated in the
#' current session.
#'
#' @inherit renv-params
#'
#' @param changes A list of changes to be merged into the lockfile.
#'   When `NULL` (the default), the lockfile is instead opened for
#'   interactive editing.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # modify an existing lockfile
#' if (interactive())
#'   renv::modify()
#'
#' }
modify <- function(project = NULL, changes = NULL) {
  renv_scope_error_handler()
  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)
  renv_modify_impl(project, changes)
  invisible(project)
}

renv_modify_impl <- function(project, changes) {

  lockfile <- if (is.null(changes))
    renv_modify_interactive(project)
  else
    renv_modify_noninteractive(project, changes)

  if (identical(renv_project(), project))
    renv_modify_fini(lockfile)

}

renv_modify_interactive <- function(project) {

  # check for interactive session
  if (!interactive())
    stop("can't modify lockfile in non-interactive session")

  # resolve path to lockfile
  lockpath <- renv_lockfile_path(project)
  if (!file.exists(lockpath))
    stopf("lockfile '%s' does not exist", aliased_path(lockpath))

  # copy the lockfile to a temporary file
  dir <- tempfile("renv-lockfile-")
  ensure_directory(dir)
  on.exit(unlink(dir, recursive = TRUE), add = TRUE)

  templock <- file.path(dir, "renv.lock")
  file.copy(lockpath, templock)

  # edit the temporary lockfile
  renv_file_edit(templock)

  # check that the new lockfile can be read
  lockfile <- catch(renv_lockfile_read(file = templock))
  if (inherits(lockfile, "error")) {

    renv_pretty_print(
      conditionMessage(lockfile),
      preamble  = "renv was uanble to parse the modified lockfile:",
      postamble = "Your changes will be discarded.",
      wrap = FALSE
    )

    stop("error modifying lockfile")

  }

  lockfile

}

renv_modify_noninteractive <- function(project, changes) {

  # resolve path to lockfile
  lockpath <- renv_lockfile_path(project)
  if (!file.exists(lockpath))
    stopf("lockfile '%s' does not exist", aliased_path(lockpath))

  # read it
  lockfile <- renv_lockfile_read(file = lockpath)

  # merge changes
  merged <- modifyList(lockfile, changes)

  # write updated lockfile to a temporary file
  templock <- tempfile("renv-lock-")
  renv_lockfile_write(merged, file = templock)

  # try reading it once more
  renv_lockfile_read(file = templock)

  # overwrite the original lockfile
  file.rename(templock, lockpath)

  # finish up
  merged

}

renv_modify_fini <- function(lockfile) {

  # synchronize relevant changes into the session
  repos <- lockfile$R$Repositories
  options(repos = convert(repos, "character"))

}

renv_mran_enabled <- function() {
  !identical(getOption("pkgType"), "source") && config$mran.enabled()
}

renv_mran_database_path <- function() {
  renv_paths_mran("packages.rds")
}

renv_mran_database_encode <- function(database) {
  database <- as.list(database)
  encoded <- lapply(database, renv_mran_database_encode_impl)
  encoded[order(names(encoded))]
}

renv_mran_database_encode_impl <- function(entry) {

  entry <- as.list(entry)
  keys <- names(entry)
  vals <- unlist(entry)

  splat <- strsplit(keys, " ", fixed = TRUE)

  encoded <- data.frame(
    Package          = map_chr(splat, `[[`, 1L),
    Version          = map_chr(splat, `[[`, 2L),
    Date             = as.integer(vals),
    stringsAsFactors = FALSE
  )

  encoded <- encoded[order(encoded$Package, encoded$Version), ]
  rownames(encoded) <- NULL

  encoded$Package <- as.factor(encoded$Package)
  encoded$Version <- as.factor(encoded$Version)

  encoded

}

renv_mran_database_decode <- function(encoded) {
  decoded <- lapply(encoded, renv_mran_database_decode_impl)
  list2env(decoded, parent = emptyenv())
}

renv_mran_database_decode_impl <- function(entry) {

  entry$Package <- as.character(entry$Package)
  entry$Version <- as.character(entry$Version)

  keys <- paste(entry$Package, entry$Version)
  vals <- as.list(entry$Date)
  names(vals) <- keys

  list2env(vals, parent = emptyenv())

}

renv_mran_database_save <- function(database, path = NULL) {

  path <- path %||% renv_mran_database_path()
  ensure_parent_directory(path)

  encoded <- renv_mran_database_encode(database)

  conn <- xzfile(path)
  on.exit(close(conn), add = TRUE)
  saveRDS(encoded, file = conn, version = 2L)

}

renv_mran_database_load <- function(path = NULL) {
  path <- path %||% renv_mran_database_path()
  filebacked("mran", path, renv_mran_database_load_impl)
}

renv_mran_database_load_impl <- function(path) {

  # read from database file if it exists
  if (file.exists(path)) {
    encoded <- readRDS(path)
    return(renv_mran_database_decode(encoded))
  }

  # otherwise, initialize a new database
  new.env(parent = emptyenv())

}

renv_mran_database_dates <- function(version, all = TRUE) {

  # release dates for old versions of R
  releases <- c(
    "3.2" = "2015-04-16",
    "3.3" = "2016-05-03",
    "3.4" = "2017-04-21",
    "3.5" = "2018-04-23",
    "3.6" = "2019-04-26",
    "4.0" = "2020-04-24",
    "4.1" = "2021-05-18",
    "4.2" = "2022-04-22",
    "4.3" = "2023-05-18",  # a guess
    "4.4" = "2024-05-18",  # a guess
    NULL
  )

  # find the start date
  index <- match(version, names(releases))
  if (is.na(index))
    stopf("no known release date for R %s", version)

  start <- as.Date(releases[[index]])
  if (!all)
    return(start)

  # form end date (ensure not in future)
  # we look 2 releases in the future as R builds binaries for
  # the previous releases of R as well
  end <- min(
    as.Date(releases[[index + 2L]]),
    as.Date(Sys.time(), tz = "UTC")
  )

  # generate list of dates
  seq(start, end, by = 1L)

}

renv_mran_database_key <- function(platform, version) {
  sprintf("/bin/%s/contrib/%s", platform, version)
}

renv_mran_database_update <- function(platform, version, dates = NULL) {

  # load database
  database <- renv_mran_database_load()

  # get reference to entry in database (initialize if not yet created)
  suffix <- renv_mran_database_key(platform, version)
  database[[suffix]] <- database[[suffix]] %||% new.env(parent = emptyenv())
  entry <- database[[suffix]]

  # rough release dates for R releases
  dates <- as.list(dates %||% renv_mran_database_dates(version))

  for (date in dates) {

    # attempt to update our database entry for this date
    url <- renv_mran_url(date, suffix)
    tryCatch(
      renv_mran_database_update_impl(date, url, entry),
      error = warning
    )

  }

  # save at end
  vprintf("[%s]: saving database ... ", date)
  renv_mran_database_save(database)
  vwritef("DONE")

}

renv_mran_database_update_impl <- function(date, url, entry) {

  vprintf("[%s]: reading package database ... ", date)

  # get date as number of days since epoch
  idate <- as.integer(date)

  # retrieve available packages
  errors <- new.env(parent = emptyenv())
  db <- renv_available_packages_query(url, errors)
  if (is.null(db)) {
    vwritef("ERROR")
    return(FALSE)
  }

  # insert packages into database
  for (i in seq_len(nrow(db))) {

    # construct key for index
    name <- db[i, "Package"]
    vers <- db[i, "Version"]
    key <- paste(name, vers)

    # update database
    entry[[key]] <- max(entry[[key]] %||% 0L, idate)

  }

  vwritef("OK")
  TRUE

}

renv_mran_url <- function(date, suffix) {
  root <- Sys.getenv("RENV_MRAN_URL", unset = "https://mran.microsoft.com/snapshot")
  snapshot <- file.path(root, date)
  paste(snapshot, suffix, sep = "")
}

renv_mran_database_url <- function() {
  default <- "https://rstudio-buildtools.s3.amazonaws.com/renv/mran/packages.rds"
  Sys.getenv("RENV_MRAN_DATABASE_URL", unset = default)
}

renv_mran_database_refresh <- function(explicit = TRUE) {

  if (explicit || renv_mran_database_refresh_required())
    renv_mran_database_refresh_impl()

}

renv_mran_database_refresh_required <- function() {

  # if the cache doesn't exist, we must refresh
  path <- renv_mran_database_path()
  if (!file.exists(path))
    return(TRUE)

  # if we're using an older version of R, but we have newer package
  # versions available in the cache, we don't need to refresh
  db <- tryCatch(renv_mran_database_load(), error = identity)
  if (!inherits(db, "error")) {
    keys <- names(db)
    versions <- unique(basename(keys))
    if (any(versions > getRversion()))
      return(FALSE)
  }

  # read the file mtime
  info <- renv_file_info(path)
  if (is.na(info$mtime))
    return(FALSE)

  # if it's older than a day, then we should update
  difftime(Sys.time(), info$mtime, units = "days") > 1

}

renv_mran_database_refresh_impl <- function() {

  url  <- renv_mran_database_url()
  path <- renv_mran_database_path()

  if (nzchar(url) && nzchar(path)) {
    ensure_parent_directory(path)
    download(url = url, destfile = path, quiet = TRUE)
  }

}

renv_mran_database_sync <- function(platform, version) {

  # read database
  database <- renv_mran_database_load()

  # read entry for this platform + version combo
  key <- renv_mran_database_key(platform, version)
  entry <- database[[key]]
  if (is.null(entry)) {
    database[[key]] <- new.env(parent = emptyenv())
    entry <- database[[key]]
  }

  # get the last known updated date
  last <- max(0L, as.integer(as.list(entry)))
  if (identical(last, 0L)) {
    date <- renv_mran_database_dates(version, all = FALSE)
    last <- as.integer(date)
  }

  # get yesterday's date
  now <- as.integer(as.Date(Sys.time(), tz = "UTC")) - 1L

  # sync up to the last version's release date
  dates <- as.integer(renv_mran_database_dates(version))
  now <- min(now, max(dates))

  # if we've already in sync, nothing to do
  if (last >= now)
    return(FALSE)

  # invoke update for missing dates
  vwritef("==> Synchronizing MRAN database (%s/%s)", platform, version)
  dates <- as.Date(seq(last + 1L, now, by = 1L), origin = "1970-01-01")
  renv_mran_database_update(platform, version, dates)
  vwritef("Finished synchronizing MRAN database (%s/%s)", platform, version)

  # return TRUE to indicate update occurred
  return(TRUE)

}

renv_mran_database_sync_all <- function() {

  # NOTE: this needs to be manually updated since the binary URL for
  # packages can change from version to version, especially on macOS

  # R 3.2
  renv_mran_database_sync("windows", "3.2")
  renv_mran_database_sync("macosx/mavericks", "3.2")

  # R 3.3
  renv_mran_database_sync("windows", "3.3")
  renv_mran_database_sync("macosx/mavericks", "3.3")

  # R 3.4
  renv_mran_database_sync("windows", "3.4")
  renv_mran_database_sync("macosx/el-capitan", "3.4")

  # R 3.5
  renv_mran_database_sync("windows", "3.5")
  renv_mran_database_sync("macosx/el-capitan", "3.5")

  # R 3.6
  renv_mran_database_sync("windows", "3.6")
  renv_mran_database_sync("macosx/el-capitan", "3.6")

  # R 4.0
  renv_mran_database_sync("windows", "4.0")
  renv_mran_database_sync("macosx", "4.0")

  # R 4.1
  renv_mran_database_sync("windows", "4.1")
  renv_mran_database_sync("macosx", "4.1")
  renv_mran_database_sync("macosx/big-sur-arm64", "4.1")



}

renv_namespace_spec <- function(package) {
  namespace <- asNamespace(package)
  .getNamespaceInfo(namespace, "spec")
}

renv_namespace_version <- function(package) {
  spec <- renv_namespace_spec(package)
  spec[["version"]]
}

renv_namespace_path <- function(package) {
  namespace <- asNamespace(package)
  .getNamespaceInfo(namespace, "path")
}

renv_namespace_load <- function(package) {
  suppressPackageStartupMessages(getNamespace(package))
}

renv_namespace_unload <- function(package) {
  unloadNamespace(package)
}

renv_namespace_parse <- function(package) {

  parseNamespaceFile(
    package     = package,
    package.lib = dirname(renv_package_find(package)),
    mustExist   = TRUE
  )

}

# mechanism for running a block of code only once; e.g.
# if (once()) { ... }
`_renv_once` <- new.env(parent = emptyenv())

once <- function() {

  invoker <- sys.function(sys.parent())
  call    <- sys.call(sys.parent())
  envir   <- environment(invoker)

  id <- paste(
    paste(format(envir), collapse = ""),
    paste(format(call), collapse = ""),
    sep = " :: "
  )

  if (exists(id, envir = `_renv_once`, inherits = FALSE))
    return(FALSE)

  assign(id, TRUE, envir = `_renv_once`, inherits = FALSE)
  TRUE
}

renv_options_set <- function(key, value) {
  data <- list(value)
  names(data) <- key
  do.call(base::options, data)
}

renv_options_override <- function(scope, key, default = NULL) {

  if (is.null(key))
    return(default)

  value <-
    getOption(paste(scope, key, sep = ".")) %||%
    getOption(scope)[[key]] %||%
    default

  value

}

# NOTE: intentionally checks library paths before checking loaded namespaces
renv_package_find <- function(package,
                              lib.loc = renv_libpaths_all(),
                              check.loaded = TRUE)
{
  map_chr(
    package,
    renv_package_find_impl,
    lib.loc = lib.loc,
    check.loaded = check.loaded
  )
}

renv_package_find_impl <- function(package,
                                   lib.loc = renv_libpaths_all(),
                                   check.loaded = TRUE)
{
  # if we've been given the path to an existing package, use it as-is
  if (file.exists(file.path(package, "DESCRIPTION")))
    return(normalizePath(package, winslash = "/", mustWork = TRUE))

  # first, look in the library paths
  for (libpath in lib.loc) {
    pkgpath <- file.path(libpath, package)
    descpath <- file.path(pkgpath, "DESCRIPTION")
    if (file.exists(descpath))
      return(pkgpath)
  }

  # if that failed, check to see if it's loaded and use the associated path
  if (check.loaded && package %in% loadedNamespaces()) {
    path <- renv_namespace_path(package)
    if (file.exists(path))
      return(path)
  }

  # failed to find package
  ""
}

renv_package_installed <- function(package, lib.loc = renv_libpaths_all()) {
  paths <- renv_package_find(package, lib.loc, check.loaded = FALSE)
  nzchar(paths)
}

renv_package_available <- function(package) {
  package %in% loadedNamespaces() || renv_package_installed(package)
}

renv_package_version <- function(package) {
  renv_package_description_field(package, "Version")
}

renv_package_description_field <- function(package, field) {
  path <- renv_package_find(package)
  desc <- renv_description_read(path)
  desc[[field]]
}

renv_package_type <- function(path, quiet = FALSE, default = "source") {

  info <- renv_file_info(path)
  if (is.na(info$isdir))
    stopf("no package at path '%s'", aliased_path(path))

  # for directories, check for Meta
  if (info$isdir) {
    hasmeta <- file.exists(file.path(path, "Meta"))
    type <- if (hasmeta) "binary" else "source"
    return(type)
  }

  # otherwise, guess based on contents of package
  methods <- list(
    tar = function(path) untar(tarfile = path, list = TRUE),
    zip = function(path) unzip(zipfile = path, list = TRUE)$Name
  )

  # guess appropriate method when possible
  type <- renv_archive_type(path)
  if (type %in% c("tar", "zip"))
    methods <- methods[type]

  for (method in methods) {

    # suppress warnings to avoid issues with e.g.
    # 'skipping pax global extended headers' when
    # using internal tar
    files <- catch(suppressWarnings(method(path)))
    if (inherits(files, "error"))
      next

    hasmeta <- any(grepl("^[^/]+/Meta/?$", files))
    type <- if (hasmeta) "binary" else "source"
    return(type)

  }

  if (!quiet) {
    fmt <- "failed to determine type of package '%s'; assuming source"
    warningf(fmt, aliased_path(path))
  }

  default

}

renv_package_priority <- function(package) {

  # treat 'R' as pseudo base package
  if (package == "R")
    return("base")

  # read priority from db
  db <- renv_installed_packages()
  entry <- db[db$Package == package, ]
  entry$Priority %NA% ""

}

renv_package_tarball_name <- function(path) {
  desc <- renv_description_read(path)
  with(desc, sprintf("%s_%s.tar.gz", Package, Version))
}

renv_package_ext <- function(type) {

  # always use '.tar.gz' for source packages
  type <- match.arg(type, c("binary", "source"))
  if (type == "source")
    return(".tar.gz")

  # otherwise, infer appropriate extension based on platform
  case(
    renv_platform_macos()   ~ ".tgz",
    renv_platform_windows() ~ ".zip",
    renv_platform_unix()    ~ ".tar.gz"
  )

}

renv_package_pkgtypes <- function() {

  # only use binaries if the user has specifically requested it
  # and binaries are available for this installation of R
  # (users may want to install from sources explicitly to take
  # advantage of custom local compiler configurations)
  binaries <-
    !identical(.Platform$pkgType, "source") &&
    !identical(getOption("pkgType"), "source")

  if (binaries) c("binary", "source") else "source"

}

renv_package_augment <- function(installpath, record) {

  # check for remotes fields
  remotes <- record[grep("^Remote", names(record))]
  if (empty(remotes))
    return(FALSE)

  # for backwards compatibility with older versions of Packrat,
  # we write out 'Github*' fields as well
  if (identical(record$Source, "GitHub")) {

    map <- list(
      "GithubHost"     = "RemoteHost",
      "GithubRepo"     = "RemoteRepo",
      "GithubUsername" = "RemoteUsername",
      "GithubRef"      = "RemoteRef",
      "GithubSHA1"     = "RemoteSha"
    )

    enumerate(map, function(old, new) {
      remotes[[old]] <<- remotes[[old]] %||% remotes[[new]]
    })

  }

  # ensure RemoteType field is written out
  remotes$RemoteType <- remotes$RemoteType %||% renv_record_source(record)
  remotes <- remotes[c("RemoteType", renv_vector_diff(names(remotes), "RemoteType"))]

  # update package items
  renv_package_augment_description(installpath, remotes)
  renv_package_augment_metadata(installpath, remotes)

}

renv_package_augment_impl <- function(data, remotes) {
  remotes <- remotes[map_lgl(remotes, Negate(is.null))]
  nonremotes <- grep("^(?:Remote|Github)", names(data), invert = TRUE)
  c(data[nonremotes], remotes, Remotes = data[["Remotes"]])
}

renv_package_augment_description <- function(path, remotes) {

  descpath <- file.path(path, "DESCRIPTION")

  before <- renv_description_read(descpath)
  after <- renv_package_augment_impl(before, remotes)
  if (identical(before, after))
    return(FALSE)

  renv_dcf_write(after, file = descpath)

}

renv_package_augment_metadata <- function(path, remotes) {

  metapath <- file.path(path, "Meta/package.rds")
  meta <- readRDS(metapath)

  before <- as.list(meta$DESCRIPTION)
  after <- renv_package_augment_impl(before, remotes)
  if (identical(before, after))
    return(FALSE)

  meta$DESCRIPTION <- map_chr(after, identity)
  saveRDS(meta, file = metapath, version = 2L)

}

# find recursive dependencies of a package. note that this routine
# doesn't farm out to CRAN; it relies on the package and its dependencies
# all being installed locally. returns a named vector mapping package names
# to the path where they were discovered, or NA if those packages are not
# installed
renv_package_dependencies <- function(packages,
                                      project = NULL,
                                      libpaths = NULL,
                                      fields = NULL)
{
  visited <- new.env(parent = emptyenv())
  ignored <- renv_project_ignored_packages(project = project)
  packages <- renv_vector_diff(packages, ignored)
  libpaths <- libpaths %||% renv_libpaths_all()
  fields <- fields %||% settings$package.dependency.fields(project = project)

  for (package in packages)
    renv_package_dependencies_impl(package, visited, libpaths, fields)

  as.list(visited)
}

renv_package_dependencies_impl <- function(package,
                                           visited,
                                           libpaths = NULL,
                                           fields = NULL)
{
  # skip the 'R' package
  if (package == "R")
    return()

  # if we've already visited this package, bail
  if (exists(package, envir = visited, inherits = FALSE))
    return()

  # default to unknown path for visited packages
  assign(package, NA, envir = visited, inherits = FALSE)

  # find the package
  libpaths <- libpaths %||% renv_libpaths_all()
  location <- renv_package_find(package, libpaths)
  if (!file.exists(location))
    return(location)

  # we know the path, so set it now
  assign(package, location, envir = visited, inherits = FALSE)

  # find its dependencies from the DESCRIPTION file
  deps <- renv_dependencies_discover_description(location, fields)
  subpackages <- deps$Package
  for (subpackage in subpackages)
    renv_package_dependencies_impl(subpackage, visited, libpaths, fields)
}

renv_package_reload <- function(package, library = NULL) {
  status <- catch(renv_package_reload_impl(package, library))
  !inherits(status, "error") && status
}

renv_package_reload_impl <- function(package, library) {

  if (renv_tests_running())
    return(FALSE)

  # record if package is attached (and, if so, where)
  name <- paste("package", package, sep = ":")
  pos <- match(name, search())

  # unload the package
  if (!is.na(pos))
    renv_package_reload_impl_searchpath(package, library, pos)
  else
    renv_package_reload_impl_namespace(package, library)

  TRUE

}

renv_package_reload_impl_searchpath <- function(package, library, pos) {

  args <- list(pos = pos, unload = TRUE, force = TRUE)
  quietly(do.call(base::detach, args), sink = FALSE)

  args <- list(package = package, pos = pos, lib.loc = library, quietly = TRUE)
  quietly(do.call(base::library, args), sink = FALSE)

}

renv_package_reload_impl_namespace <- function(package, library) {
  unloadNamespace(package)
  loadNamespace(package, lib.loc = library)
}

renv_package_hook <- function(package, hook) {
  if (package %in% loadedNamespaces())
    hook()
  else
    setHook(packageEvent(package, "onLoad"), hook)
}

renv_package_metadata <- function(package) {
  pkgpath <- renv_package_find(package)
  metapath <- file.path(pkgpath, "Meta/package.rds")
  readRDS(metapath)
}

renv_package_shlib <- function(package) {

  pkgpath <- renv_package_find(package)

  pkgname <- basename(package)
  if (pkgname == "data.table")
    pkgname <- "datatable"

  libname <- paste0(pkgname, .Platform$dynlib.ext)
  file.path(pkgpath, "libs", libname)

}

renv_package_built <- function(path) {

  info <- renv_file_info(path)

  # list files in package
  isarchive <- identical(info$isdir, FALSE)
  files <- if (isarchive)
    renv_archive_list(path)
  else
    list.files(path, full.names = TRUE, recursive = TRUE)

  # for a source package, the canonical way to determine if it has already
  # been built is the presence of a 'Packaged:' field in the DESCRIPTION file
  # ('Built:' for binary packages) but we want to avoid the overhead of
  # unpacking the package if at all possible
  pattern <- "/(?:MD5$|INDEX/|Meta/package\\.rds$)"
  matches <- grep(pattern, files)
  if (length(matches) != 0L)
    return(TRUE)

  # if the above failed, then we'll use the contents of the DESCRIPTION file
  descpaths <- grep("/DESCRIPTION$", files, value = TRUE)
  if (length(descpaths) == 0L)
    return(FALSE)

  n <- nchar(descpaths)
  descpath <- descpaths[n == min(n)]
  contents <- if (isarchive)
    renv_archive_read(path, descpath)
  else
    readLines(descpath, warn = FALSE)

  # check for signs it was built
  pattern <- "^(?:Packaged|Built):"
  matches <- grep(pattern, contents)
  if (length(matches) != 0L)
    return(TRUE)

  # does not appear to be a source package
  FALSE

}

renv_package_checking <- function() {
  "CheckExEnv" %in% search() ||
    !is.na(Sys.getenv("_R_CHECK_PACKAGE_NAME_", unset = NA)) ||
    !is.na(Sys.getenv("_R_CHECK_SIZE_OF_TARBALL_", unset = NA)) ||
    !is.na(Sys.getenv("TESTTHAT", unset = NA))
}

renv_package_unpack <- function(package, path, subdir = "", force = FALSE) {

  # if this isn't an archive, nothing to do
  info <- renv_file_info(path)
  if (identical(info$isdir, TRUE))
    return(path)

  # find DESCRIPTION files in the archive
  descpaths <- renv_archive_find(path, "(?:^|/)DESCRIPTION$")

  # check for a top-level DESCRIPTION file
  # this is done in case the archive has been already been re-packed, so that a
  # package originally located within a sub-directory is now at the top level
  if (!force) {
    descpath <- grep("^[^/]+/DESCRIPTION$", descpaths, perl = TRUE, value = TRUE)
    if (length(descpath))
      return(path)
  }

  # try to resolve the path to the DESCRIPTION file in the archive
  descpath <- if (nzchar(subdir)) {
    pattern <- sprintf("(?:^|/)\\Q%s\\E/DESCRIPTION$", subdir)
    grep(pattern, descpaths, perl = TRUE, value = TRUE)
  } else {
    n <- nchar(descpaths)
    descpaths[n == min(n)]
  }

  # if this failed, error
  if (length(descpath) != 1L) {
    fmt <- "internal error: couldn't find DESCRIPTION file for package '%s' in archive '%s'"
    stopf(fmt, package, path)
  }

  # create extraction directory
  old <- tempfile("renv-package-old-")
  new <- tempfile("renv-package-new-")
  ensure_directory(c(old, new))

  # decompress archive to dir
  renv_archive_decompress(path, exdir = old)

  # rename (without sub-directory)
  oldpath <- file.path(old, dirname(descpath))
  newpath <- file.path(new, package)
  file.rename(oldpath, newpath)

  # use newpath
  newpath

}

renv_packages_base <- function() {
  db <- renv_installed_packages_base()
  c("R", db$Package, "translations")
}


renv_pak_init <- function(library, type, rebuild, project) {

  if (requireNamespace("pak", quietly = TRUE))
    return(renv_namespace_load("pak"))

  # prefer using prebuilt binaries
  fmt <- "https://r-lib.github.io/p/pak/stable/%s/%s/%s"
  repos <- sprintf(fmt, .Platform$pkgType, version$os, version$arch)
  utils::install.packages("pak", repos = repos)

}

renv_pak_install <- function(packages, library) {

  pak <- renv_namespace_load("pak")
  pak$pkg_install(
    pkg     = packages,
    lib     = library[[1L]],
    upgrade = TRUE
  )

}

renv_parallel_cores <- function() {

  if (renv_platform_windows())
    return(1L)

  value <- config$updates.parallel()
  case(
    identical(value, TRUE)  ~ getOption("mc.cores", default = 2L),
    identical(value, FALSE) ~ 1L,
    ~ as.integer(value)
  )

}

renv_parallel_exec <- function(data, callback) {
  cores <- renv_parallel_cores()
  if (cores > 1)
    parallel::mclapply(data, callback, mc.cores = cores)
  else
    lapply(data, callback)
}

renv_parse_file <- function(file = "", ...) {
  if (nzchar(file)) {
    text <- readLines(file, warn = FALSE, encoding = "UTF-8")
    renv_parse_impl(text, srcfile = file, ...)
  }
}

renv_parse_text <- function(text = NULL, ...) {
  if (is.character(text)) {
    renv_parse_impl(text, ...)
  }
}

renv_parse_impl <- function(text, ...) {

  # save default encoding
  enc <- Encoding(text)

  # disable warnings + encoding conversions
  renv_scope_options(
    warn     = 1L,
    encoding = "native.enc"
  )

  # attempt multiple parse methods
  methods <- list(
    renv_parse_impl_asis,
    renv_parse_impl_native,
    renv_parse_impl_utf8
  )

  # attempt with different guessed encodings
  encodings <- c("UTF-8", "unknown")

  for (encoding in encodings) {
    Encoding(text) <- encoding
    for (method in methods) {
      parsed <- catch(method(text, ...))
      if (!inherits(parsed, "error"))
        return(parsed)
    }
  }

  # if these all fail, then just try the default
  # parse and let the error propagate
  on.exit(Sys.setlocale(), add = TRUE)
  Encoding(text) <- enc
  parse(text = text, ...)

}

renv_parse_impl_asis <- function(text, ...) {
  on.exit(Sys.setlocale(), add = TRUE)
  parse(text = text, ...)
}

renv_parse_impl_native <- function(text, ...) {
  on.exit(Sys.setlocale(), add = TRUE)
  parse(text = enc2native(text), encoding = "unknown", ...)
}

renv_parse_impl_utf8 <- function(text, ...) {
  on.exit(Sys.setlocale(), add = TRUE)
  parse(text = enc2utf8(text), encoding = "UTF-8", ...)
}


renv_deparse <- function(expr, width.cutoff = 500L, ...) {
  paste(deparse(expr = expr, width.cutoff = width.cutoff, ...), collapse = " ")
}

renv_patch_init <- function() {
  renv_patch_rprofile()
  renv_patch_tar()
  renv_patch_repos()
  renv_patch_golem()
  renv_patch_methods_table()
}

renv_patch_rprofile <- function() {

  # resolve path to user profile
  path <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile")
  info <- renv_file_info(path)
  if (!identical(info$isdir, FALSE))
    return(FALSE)

  # if the .Rprofile is empty, do nothing
  if (info$size == 0)
    return(TRUE)

  # check for trailing newline
  data <- readBin(path, raw(), n = info$size)
  if (empty(data))
    return(TRUE)

  last <- data[length(data)]
  endings <- as.raw(c(0x0a, 0x0d))
  if (last %in% endings)
    return(TRUE)

  # if it's missing, inform the user
  warningf("%s is missing a trailing newline", renv_path_pretty(path))
  FALSE

}

renv_patch_tar <- function() {

  # read value of TAR
  tar <- Sys.getenv("TAR", unset = "")

  # on Windows, if TAR is unset, then force the usage
  # of R's internal tar implementation. this is done to
  # avoid issues where e.g. versions of tar which do not
  # understand Windows paths are on the PATH
  #
  # https://github.com/rstudio/renv/issues/521
  if (renv_platform_windows() && !nzchar(tar)) {
    Sys.setenv(TAR = "internal")
    return(TRUE)
  }

  # otherwise, allow empty / internal tars
  if (tar %in% c("", "internal"))
    return(TRUE)

  # the user (or R itself) has set the TAR environment variable
  # validate that it exists (resolve from PATH)
  #
  # note that the user can set TAR to be a full command; e.g.
  #
  #    TAR = /path/to/tar --force-local
  #
  # so we need to handle that case appropriately
  whitespace <- gregexpr("(?:\\s+|$)", tar, perl = TRUE)[[1L]]
  for (index in whitespace) {
    candidate <- substring(tar, 1L, index - 1L)
    resolved <- Sys.which(candidate)
    if (nzchar(resolved))
      return(TRUE)
  }

  # TAR appears to be set but invalid; override it
  # and warn the user
  newtar <- Sys.which("tar") %""% "internal"
  Sys.setenv(TAR = newtar)

  # report to the user
  fmt <- "requested TAR '%s' does not exist; using '%s' instead"
  warningf(fmt, tar, newtar)

}

renv_patch_golem <- function() {
  renv_package_hook("golem", renv_patch_golem_impl)
}

renv_patch_golem_impl <- function(...) {

  if (packageVersion("golem") != "0.2.1")
    return()

  golem <- getNamespace("golem")

  replacement <- function(file, pattern, replace) {

    # skip .rds files
    if (grepl("[.]rds$", file))
      return()

    # skip files containing nul bytes
    info <- renv_file_info(file)
    bytes <- readBin(file, "raw", info$size)
    if (any(bytes == 0L))
      return()

    # otherwise, attempt replacement
    old <- readLines(file)
    new <- gsub(pattern, replace, old)
    writeLines(new, con = file)

  }

  environment(replacement) <- golem

  if ("compiler" %in% loadedNamespaces())
    replacement <- compiler::cmpfun(replacement)

  renv_binding_replace(
    symbol = "replace_word",
    envir  = golem,
    replacement = replacement
  )

}

renv_patch_methods_table <- function() {
  catchall(renv_patch_methods_table_impl())
}

renv_patch_methods_table_impl <- function() {

  # ensure promises in S3 methods table are forced
  # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=16644
  for (envir in list(.BaseNamespaceEnv, renv_namespace_load("utils"))) {

    # unlock binding if it's locked
    binding <- ".__S3MethodsTable__."
    base <- baseenv()
    if (base$bindingIsLocked(binding, env = envir)) {
      base$unlockBinding(binding, env = envir)
      on.exit(base$lockBinding(binding, envir), add = TRUE)
    }

    # force everything defined in the environment
    table <- envir[[binding]]
    for (key in ls(envir = table, all.names = TRUE))
      table[[key]] <- force(table[[key]])

  }

}

# puts the current version of renv into an on-disk package repository,
# so that packages using renv can find this version of renv in tests
# this helps renv survive CRAN revdep checks (e.g. jetpack)
renv_patch_repos <- function() {

  # nothing to do if we're not running tests
  checking <- renv_package_checking()
  if (!checking)
    return()

  # nothing to do if we're running our own tests
  name <- Sys.getenv("_R_CHECK_PACKAGE_NAME_", unset = NA)
  if (identical(name, "renv"))
    return()

  # nothing to do if this version of 'renv' is already available
  version <- renv_package_version("renv")
  entry <- catch(renv_available_packages_entry("renv", filter = version, quiet = TRUE))
  if (!inherits(entry, "error"))
    return()

  # check if we've already set repos
  if ("RENV" %in% names(getOption("repos")))
    return()

  # use package-local repository path
  repopath <- system.file("repos", package = "renv")

  # update our repos option
  fmt <- if (renv_platform_windows()) "file:///%s" else "file://%s"
  repourl <- sprintf(fmt, repopath)

  # renv needs to be first so the right version is found?
  repos <- c(RENV = repourl, getOption("repos"))
  names(repos) <- make.names(names(repos))
  options(repos = repos)

  # make sure these repositories are used in restore too
  options(renv.config.repos.override = repos)

}

`_renv_alpha` <- c(letters, LETTERS)

renv_path_absolute <- function(path) {

  substr(path, 1L, 1L) %in% c("~", "/", "\\") || (
    substr(path, 1L, 1L) %in% `_renv_alpha` &&
    substr(path, 2L, 3L) %in% c(":/", ":\\")
  )

}

renv_path_within <- function(path, parent) {
  path <- renv_path_canonicalize(path)
  prefix <- paste(renv_path_canonicalize(parent), "/", sep = "")
  path == parent | substring(path, 1L, nchar(prefix)) == prefix
}

renv_path_normalize <- function(path, winslash = "/", mustWork = FALSE) {
  if (renv_platform_windows())
    renv_path_normalize_win32(path, winslash, mustWork)
  else
    renv_path_normalize_unix(path, winslash, mustWork)
}

renv_path_normalize_unix <- function(path,
                                     winslash = "/",
                                     mustWork = FALSE)
{
  # force paths to be absolute
  bad <- !map_lgl(path, renv_path_absolute)
  if (any(bad)) {
    prefix <- normalizePath(".", winslash = winslash)
    path[bad] <- paste(prefix, path[bad], sep = winslash)
  }

  # normalize the expanded paths
  normalizePath(path, winslash, mustWork)
}

# NOTE: in versions of R < 4.0.0, normalizePath() does not normalize path
# casing; e.g. normalizePath("~/MyPaTh") will not normalize to "~/MyPath"
# (assuming that is the "true" underlying casing on the filesystem)
#
# we work around this by round-tripping between the short name and
# the long name, as Windows then has no choice but to figure out
# the correct casing for us
#
# this isn't 100% reliable (not all paths have a short-path equivalent)
# but seems to be good enough in practice ...
#
# except that, if the path contains characters that cannot be represented in the
# current encoding, then attempting to normalize the short version of that path
# will fail -- so if the path is already UTF-8, then we need to avoid
# round-tripping through the short path.
#
# furthermore, it appears that shortPathName() can mis-encode its result for
# strings marked with latin1 encoding?
#
# https://github.com/rstudio/renv/issues/629
renv_path_normalize_win32 <- function(path,
                                      winslash = "/",
                                      mustWork = FALSE)
{

  # see the NOTE above, this workaround is only necessary for R < 4.0.0,
  # and it complicates things unnecessarily
  if (getRversion() >= "4.0.0")
    return(renv_path_normalize_unix(path, winslash, mustWork))

  # get encoding for this set of paths
  enc <- Encoding(path)

  # perform separate operations for each
  utf8    <- enc == "UTF-8"
  latin1  <- enc == "latin1"
  unknown <- enc == "unknown"

  # normalize based on their encoding
  path[utf8]    <- normalizePath(path[utf8], winslash, mustWork)
  path[latin1]  <- normalizePath(path[latin1], winslash, mustWork)
  path[unknown] <- renv_path_normalize_win32_impl(path[unknown], winslash, mustWork)

  # return resulting path
  path
}

renv_path_normalize_win32_impl <- function(path,
                                           winslash = "/",
                                           mustWork = FALSE)
{
  short <- utils::shortPathName(path.expand(path))
  normalizePath(short, winslash, mustWork)
}

# TODO: this is a lie; for existing paths symlinks will be resolved
renv_path_canonicalize <- function(path) {
  parent <- dirname(path)
  root <- renv_path_normalize(parent, winslash = "/", mustWork = FALSE)
  trimmed <- sub("/+$", "", root)
  file.path(trimmed, basename(path))
}

renv_path_same <- function(lhs, rhs) {
  renv_path_canonicalize(lhs) == renv_path_canonicalize(rhs)
}

# get the nth path component from the end of the path
renv_path_component <- function(path, index = 1) {
  splat <- strsplit(path, "[/\\]+")
  map_chr(splat, function(parts) parts[length(parts) - index + 1])
}

renv_path_pretty <- function(path) {
  renv_json_quote(aliased_path(path))
}

`_renv_root` <- NULL

renv_paths_override <- function(name) {

  # # check for value from option
  # optname <- paste("renv.paths", name, sep = ".")
  # optval <- getOption(optname)
  # if (!is.null(optval))
  #   return(optval)

  # check for value from envvar
  envname <- paste("RENV_PATHS", toupper(name), sep = "_")
  envval  <- Sys.getenv(envname, unset = NA)
  if (!is.na(envval))
    return(envval)

}

renv_paths_common <- function(name, prefixes = NULL, ...) {

  # check for single absolute path supplied by user
  # TODO: handle multiple?
  end <- file.path(...)
  if (length(end) == 1 && renv_path_absolute(end))
    return(end)

  # check for path provided via option
  root <- renv_paths_override(name) %||% renv_paths_root(name)

  # split path entries containing a separator
  if (name %in% c("cache", "local", "cellar")) {
    pattern <- if (renv_platform_windows()) "[;]" else "[;:]"
    root <- strsplit(root, pattern)[[1L]]
  }

  # form rest of path
  prefixed <- if (length(prefixes))
    file.path(root, paste(prefixes, collapse = "/"))
  else
    root

  file.path(prefixed, ...) %||% ""

}

renv_paths_project <- function(..., project = NULL) {
  project <- renv_project_resolve(project)
  file.path(project, ...) %||% ""
}

renv_paths_library_root <- function(project) {
  renv_bootstrap_library_root(project)
}

renv_paths_library <- function(..., project = NULL) {
  project <- renv_project_resolve(project)
  root <- renv_paths_library_root(project)
  file.path(root, renv_platform_prefix(), ...) %||% ""
}

renv_paths_lockfile <- function(project = NULL) {

  # allow override
  # TODO: profiles?
  override <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = NA)
  if (!is.na(override)) {
    last <- substr(override, nchar(override), nchar(override))
    if (last %in% c("/", "\\"))
      override <- paste0(override, "renv.lock")
    return(override)
  }

  # otherwise, use default location (location location relative to renv folder)
  project <- renv_project_resolve(project)
  renv <- renv_paths_renv(project = project)
  file.path(dirname(renv), "renv.lock")

}

renv_paths_settings <- function(project = NULL) {
  renv_paths_renv("settings.dcf", project = project)
}

renv_paths_activate <- function(project = NULL) {
  renv_paths_renv("activate.R", profile = FALSE, project = project)
}

renv_paths_renv <- function(..., profile = TRUE, project = NULL) {
  renv_bootstrap_paths_renv(..., profile = profile, project = project)
}

renv_paths_cellar <- function(...) {
  renv_paths_common("cellar", c(), ...)
}

renv_paths_local <- function(...) {
  renv_paths_common("local", c(), ...)
}

renv_paths_source <- function(...) {
  renv_paths_common("source", c(), ...)
}

renv_paths_binary <- function(...) {
  renv_paths_common("binary", c(renv_platform_prefix()), ...)
}

renv_paths_cache <- function(..., version = NULL) {
  platform <- renv_platform_prefix()
  version <- version %||% renv_cache_version()
  renv_paths_common("cache", c(version, platform), ...)
}

renv_paths_rtools <- function(...) {

  root <- renv_paths_override("rtools")
  if (is.null(root)) {
    spec <- renv_rtools_find()
    root <- spec$root
  }

  file.path(root, ...) %||% ""

}

renv_paths_extsoft <- function(...) {
  renv_paths_common("extsoft", c(), ...)
}

renv_paths_mran <- function(...) {
  renv_paths_common("mran", c(), ...)
}



renv_paths_root <- function(...) {
  root <- renv_paths_override("root") %||% renv_paths_root_default()
  file.path(root, ...) %||% ""
}

# nocov start
renv_paths_root_default <- function() {

  # if we have a cached root value, use it
  if (!is.null(`_renv_root`))
    return(`_renv_root`)

  # use tempdir for cache when running tests
  # this check is necessary here to support packages which might use renv
  # during testing (and we don't want those to try to use the user dir)
  checking <- renv_package_checking()

  # compute the root directory
  root <- if (checking)
    renv_paths_root_default_tempdir()
  else
    renv_paths_root_default_impl()

  # cache the value
  renv_binding_replace("_renv_root", root, renv_envir_self())

  # return it
  invisible(`_renv_root`)

}

renv_paths_root_default_impl <- function() {

  # compute known root directories
  roots <- c(
    renv_paths_root_default_impl_v2(),
    renv_paths_root_default_impl_v1()
  )

  # iterate through those roots, finding the first existing
  for (root in roots)
    if (file.exists(root))
      return(root)

  # if none exist, choose the most recent definition
  roots[[1L]]

}

renv_paths_root_default_impl_v2 <- function() {

  # try using tools to get the user directory
  tools <- renv_namespace_load("tools")
  if (is.function(tools$R_user_dir))
    return(tools$R_user_dir("renv", "cache"))

  renv_paths_root_default_impl_v2_fallback()

}

renv_paths_root_default_impl_v2_fallback <- function() {

  # try using our own backfill for older versions of R
  envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME")
  for (envvar in envvars) {
    root <- Sys.getenv(envvar, unset = NA)
    if (!is.na(root)) {
      path <- file.path(root, "R/renv")
      return(path)
    }
  }

  # use platform-specific default fallbacks
  if (renv_platform_windows())
    file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv")
  else if (renv_platform_macos())
    "~/Library/Caches/org.R-project.R/R/renv"
  else
    "~/.cache/R/renv"

}

renv_paths_root_default_impl_v1 <- function() {

  base <- switch(
    Sys.info()[["sysname"]],
    Darwin  = Sys.getenv("XDG_DATA_HOME", "~/Library/Application Support"),
    Windows = Sys.getenv("LOCALAPPDATA", Sys.getenv("APPDATA")),
    Sys.getenv("XDG_DATA_HOME", "~/.local/share")
  )

  file.path(base, "renv")

}

renv_paths_root_default_tempdir <- function() {
  temp <- file.path(tempdir(), "renv")
  ensure_directory(temp)
  return(temp)
}

# nocov end

#' Path Customization
#'
#' Access the paths that `renv` uses for global state storage.
#'
#' By default, `renv` collects state into these folders:
#'
#' \tabular{ll}{
#' **Platform** \tab **Location** \cr
#' Linux        \tab `~/.local/share/renv` \cr
#' macOS        \tab `~/Library/Application Support/renv` \cr
#' Windows      \tab `%LOCALAPPDATA%/renv` \cr
#' }
#'
#' For new installations of `renv` using R (>= 4.0.0), `renv` will use
#' [tools::R_user_dir()] to resolve the root directory. If an `renv` root
#' directory has already been created in one of the old locations, that will
#' still be used. This change was made to comply with the CRAN policy
#' requirements of \R packages. By default, these paths resolve as:
#'
#' \tabular{ll}{
#' **Platform** \tab **Location** \cr
#' Linux        \tab `~/.cache/R/renv` \cr
#' macOS        \tab `~/Library/Caches/org.R-project.R/R/renv` \cr
#' Windows      \tab `%LOCALAPPDATA%/R/cache/R/renv` \cr
#' }
#'
#' If desired, this path can be customized by setting the `RENV_PATHS_ROOT`
#' environment variable. This can be useful if you'd like, for example, multiple
#' users to be able to share a single global cache.
#'
#' The various state sub-directories can also be individually adjusted, if so
#' desired (e.g. you'd prefer to keep the cache of package installations on a
#' separate volume). The various environment variables that can be set are
#' enumerated below:
#'
#' \tabular{ll}{
#' \strong{Environment Variable}     \tab \strong{Description} \cr
#' \code{RENV_PATHS_ROOT}            \tab The root path used for global state storage. \cr
#' \code{RENV_PATHS_LIBRARY}         \tab The path to the project library. \cr
#' \code{RENV_PATHS_LIBRARY_ROOT}    \tab The parent path for project libraries. \cr
#' \code{RENV_PATHS_LIBRARY_STAGING} \tab The parent path used for staged package installs. \cr
#' \code{RENV_PATHS_LOCKFILE}        \tab The path to the [lockfile][lockfiles]. \cr
#' \code{RENV_PATHS_CELLAR}          \tab The path to the cellar, containing local package binaries and sources. \cr
#' \code{RENV_PATHS_SOURCE}          \tab The path containing downloaded package sources. \cr
#' \code{RENV_PATHS_BINARY}          \tab The path containing downloaded package binaries. \cr
#' \code{RENV_PATHS_CACHE}           \tab The path containing cached package installations. \cr
#' \code{RENV_PATHS_PREFIX}          \tab An optional prefix to prepend to the constructed library / cache paths. \cr
#' \code{RENV_PATHS_RTOOLS}          \tab (Windows only) The path to [Rtools](https://cran.r-project.org/bin/windows/Rtools/). \cr
#' \code{RENV_PATHS_EXTSOFT}         \tab (Windows only) The path containing external software needed for compilation of Windows source packages. \cr
#' \code{RENV_PATHS_MRAN}            \tab The path containing MRAN-related metadata. See `vignette("mran", package = "renv")` for more details. \cr
#' }
#'
#' Note that `renv` will append platform-specific and version-specific entries
#' to the set paths as appropriate. For example, if you have set:
#'
#' ```
#' Sys.setenv(RENV_PATHS_CACHE = "/mnt/shared/renv/cache")
#' ```
#'
#' then the directory used for the cache will still depend on the `renv` cache
#' version (e.g. `v2`), the \R version (e.g. `3.5`) and the platform (e.g.
#' `x86_64-pc-linux-gnu`). For example:
#'
#' ```
#' /mnt/shared/renv/cache/v2/R-3.5/x86_64-pc-linux-gnu
#' ```
#'
#' This ensures that you can set a single `RENV_PATHS_CACHE` environment variable
#' globally without worry that it may cause collisions or errors if multiple
#' versions of \R needed to interact with the same cache.
#'
#' If you need to share the same cache with multiple different Linux operating
#' systems, you may want to set the `RENV_PATHS_PREFIX` environment variable
#' to help disambiguate the paths used on Linux. For example, setting
#' `RENV_PATHS_PREFIX = "ubuntu-bionic"` would instruct `renv` to construct a
#' cache path like:
#'
#' ```
#' /mnt/shared/renv/cache/v2/ubuntu-bionic/R-3.5/x86_64-pc-linux-gnu
#' ```
#'
#' If this is required, it's strongly recommended that this environment
#' variable is set in your \R installation's `Renviron.site` file, typically
#' located at `file.path(R.home("etc"), "Renviron.site")`, so that it can be
#' active for any \R sessions launched on that machine.
#'
#' Starting from `renv 0.13.0`, you can also instruct `renv` to auto-generate
#' an OS-specific component to include as part of library and cache paths,
#' by setting the environment variable:
#'
#' ```
#' RENV_PATHS_PREFIX_AUTO = TRUE
#' ```
#'
#' The prefix will be constructed based on fields within the system's
#' `/etc/os-release` file.
#'
#' If reproducibility of a project is desired on a particular machine, it is
#' highly recommended that the `renv` cache of installed packages + binary
#' packages is backed up and persisted, so that packages can be easily restored
#' in the future -- installation of packages from source can often be arduous.
#'
#' If you want these settings to persist in your project, it is recommended that
#' you add these to an appropriate \R startup file. For example, these could be
#' set in:
#'
#' - A project-local `.Renviron`;
#' - The user-level `.Renviron`;
#' - A file at `file.path(R.home("etc"), "Renviron.site")`.
#'
#' Please see ?[Startup] for more details.
#'
#' @section Package Cellar:
#'
#' If your project depends on one or \R packages that are not available in any
#' remote location, you can still provide a locally-available tarball for `renv`
#' to use during restore. By default, these packages should be made available in
#' the folder as specified by the `RENV_PATHS_CELLAR` environment variable. The
#' package sources should be placed in a file at one of these locations:
#'
#' - `${RENV_PATHS_CELLAR}/<package>_<version>.<ext>`
#' - `${RENV_PATHS_CELLAR}/<package>/<package>_<version>.<ext>`
#' - `<project>/renv/cellar/<package>_<version>.<ext>`
#' - `<project>/renv/cellar/<package>/<package>_<version>.<ext>`
#'
#' where `.<ext>` is `.tar.gz` for source packages, or `.tgz` for binaries on
#' macOS and `.zip` for binaries on Windows. During `restore()`, `renv` will
#' search the cellar for a compatible package, and prefer installation with
#' that copy of the package if appropriate.
#'
#' @section Projects:
#'
#' In order to determine whether a package can safely be removed from the cache,
#' `renv` needs to know which projects are using packages from the cache. Since
#' packages may be symlinked from the cache, and symlinks are by nature a one-way
#' link, projects need to also report that they're using the `renv` cache.
#'
#' To accomplish this, whenever `renv` is used with a project, it will record
#' itself as being used within a file located at:
#'
#' - `${RENV_PATHS_ROOT}/projects`
#'
#' This file is list of projects currently using the `renv` cache. With this,
#' `renv` can crawl projects registered with `renv` and use that to determine if
#' any packages within the cache are no longer in use, and can be removed.
#'
#' @rdname paths
#' @name paths
#'
#' @export
#'
#' @examples
#' # get the path to the project library
#' path <- renv::paths$library()
paths <- list(
  root     = renv_paths_root,
  library  = renv_paths_library,
  lockfile = renv_paths_lockfile,
  settings = renv_paths_settings,
  cache    = renv_paths_cache
)

pip_freeze <- function(..., python = NULL) {
  python <- python %||% renv_python_active()
  renv_scope_envvars(PIP_DISABLE_PIP_VERSION_CHECK = "1")
  python <- renv_path_canonicalize(python)
  args <- c("-m", "pip", "freeze")
  action <- "invoking pip freeze"
  renv_system_exec(python, args, action, ...)
}

pip_install <- function(modules, ..., python = NULL) {
  python <- python %||% renv_python_active()
  renv_scope_envvars(PIP_DISABLE_PIP_VERSION_CHECK = "1")
  python <- renv_path_canonicalize(python)
  args <- c("-m", "pip", "install", "--upgrade", modules)
  action <- paste("installing", paste(shQuote(modules), collapse = ", "))
  renv_system_exec(python, args, action, ...)
}

pip_install_requirements <- function(requirements, ..., python = NULL) {

  python <- python %||% renv_python_active()

  file <- renv_scope_tempfile("renv-requirements-", fileext = ".txt")
  writeLines(requirements, con = file)

  renv_scope_envvars(PIP_DISABLE_PIP_VERSION_CHECK = "1")
  python <- renv_path_canonicalize(python)
  args <- c("-m", "pip", "install", "--upgrade", "-r", renv_shell_path(file))
  action <- "restoring Python packages"
  renv_system_exec(python, args, action, ...)

}

pip_uninstall <- function(modules, ..., python = NULL) {

  python <- python %||% renv_python_active()

  renv_scope_envvars(PIP_DISABLE_PIP_VERSION_CHECK = "1")
  python <- renv_path_canonicalize(python)
  args <- c("-m", "pip", "uninstall", "--yes", modules)
  action <- paste("uninstalling", paste(shQuote(modules), collapse = ", "))
  renv_system_exec(python, args, action, ...)

  TRUE

}

`_renv_sysinfo` <- NULL

renv_platform_init <- function() {
  `_renv_sysinfo` <<- Sys.info()
}

renv_platform_unix <- function() {
  .Platform$OS.type == "unix"
}

renv_platform_windows <- function() {
  .Platform$OS.type == "windows"
}

renv_platform_macos <- function() {
  `_renv_sysinfo`[["sysname"]] == "Darwin"
}

renv_platform_linux <- function() {
  `_renv_sysinfo`[["sysname"]] == "Linux"
}

renv_platform_solaris <- function() {
  `_renv_sysinfo`[["sysname"]] == "SunOS"
}

renv_platform_wsl <- function() {

  pv <- "/proc/version"
  if (!file.exists(pv))
    return(FALSE)

  contents <- catch(readLines(pv, warn = FALSE))
  if (inherits(contents, "error"))
    return(FALSE)

  any(grepl("(?:Microsoft|WSL)", contents, ignore.case = TRUE))

}

renv_platform_prefix <- function() {
  renv_bootstrap_platform_prefix()
}

renv_platform_os <- function() {
  renv_bootstrap_platform_os()
}

renv_platform_machine <- function() {
  `_renv_sysinfo`[["machine"]]
}

pscalar <- function(x) {
  length(x) == 1L
}

pstring <- function(x) {
  is.character(x) && length(x) == 1L
}


# returns TRUE if problems detected
renv_preflight <- function(lockfile) {

  problems <- stack()

  # check that we can compile C programs
  renv_preflight_compiler(problems)

  # if rJava is being used, ensure that Java is properly configured
  renv_preflight_java(lockfile, problems)

  data <- problems$data()
  if (length(data)) {

    feedback <- lines(
      "The following problems were detected in your environment:",
      "",
      paste(data, collapse = "\n\n"),
      "",
      "The environment may not be restored correctly."
    )

    vwritef(feedback)

  }

  length(data) == 0

}

renv_preflight_compiler <- function(problems) {

  # try to compile a simple program
  program <- "void test() {}"
  file <- renv_scope_tempfile("renv-test-compile-", fileext = ".c")
  writeLines(program, con = file)

  args <- c("CMD", "SHLIB", renv_shell_path(file))
  status <- system2(R(), args, stdout = FALSE, stderr = FALSE)

  if (!identical(status, 0L)) {

    feedback <- lines(
      "- Cannot compile C / C++ files from source.",
      "  Please ensure you have a compiler toolchain installed."
    )

    problems$push(feedback)

  }

}

renv_preflight_java <- function(lockfile, problems) {

  # no need to check if we're not using rJava
  records <- renv_records(lockfile)
  if (is.null(records[["rJava"]]))
    return(TRUE)

  # TODO: no need to do anything if we're only installing binaries?
  switch(
    Sys.info()[["sysname"]],
    Windows = renv_preflight_java_windows(problems),
    renv_preflight_java_unix(problems)
  )

}

renv_preflight_java_windows <- function(problems) {

  home <- Sys.getenv("JAVA_HOME", unset = NA)
  feedback <- case(

    is.na(home) ~ lines(
      "- JAVA_HOME is not set.",
      "  Please ensure you have a Java Development Kit (JDK) installed."
    ),

    !file.exists(home) ~ lines(
      "- JAVA_HOME is set to a non-existent directory.",
      "  Please ensure you have a Java Development Kit (JDK) installed."
    )

  )

  if (!is.null(feedback))
    problems$push(feedback)

}

renv_preflight_java_unix <- function(problems) {

  args <- c("CMD", "javareconf", "--dry-run")
  status <- system2(R(), args, stdout = FALSE, stderr = FALSE)
  if (!identical(status, 0L)) {

    feedback <- lines(
      "- Cannot compile Java files from source.",
      "  Please ensure you have a Java Development Kit (JDK) installed."
    )

    problems$push(feedback)

  }

}

renv_pretty_print <- function(values,
                              preamble  = NULL,
                              postamble = NULL,
                              emitter   = NULL,
                              wrap      = TRUE)
{
  if (renv_tests_running() && !renv_tests_verbose())
    return()

  msg <- stack()
  if (empty(values))
    return()

  if (!is.null(preamble)) {
    msg$push(paste(preamble, collapse = "\n"))
    msg$push("")
  }

  formatted <- if (wrap)
    strwrap(paste(values, collapse = ", "), width = 60)
  else
    values

  msg$push(paste("\t", formatted, sep = "", collapse = "\n"))

  if (!is.null(postamble)) {
    msg$push("")
    msg$push(paste(postamble, collapse = "\n"))
  }

  msg$push("")
  text <- paste(as.character(msg$data()), collapse = "\n")

  emitter <- emitter %||% renv_pretty_print_emitter()
  emitter(text)
}

renv_pretty_print_records <- function(records,
                                      preamble  = NULL,
                                      postamble = NULL,
                                      emitter   = NULL)
{
  if (empty(records))
    return(invisible(NULL))

  packages <- extract_chr(records, "Package")
  descs <- map_chr(records, renv_record_format_short)

  lhs <- paste(" ", format(packages))
  rhs <- descs

  n <- max(nchar(lhs))
  header <- paste(c(rep.int(" ", n + 1), "_"), collapse = "")
  text <- sprintf("%s   [%s]", lhs, rhs)

  all <- c(
    if (length(preamble)) preamble,
    c(header, text, ""),
    if (length(postamble)) c(postamble, "")
  )

  emitter <- emitter %||% renv_pretty_print_emitter()
  emitter(all)

  invisible(NULL)
}

renv_pretty_print_records_pair <- function(old,
                                           new,
                                           preamble  = NULL,
                                           postamble = NULL,
                                           emitter   = NULL)
{

  all <- c(
    if (length(preamble)) c(preamble, ""),
    renv_pretty_print_records_pair_impl(old, new),
    if (length(postamble)) c(postamble, "")
  )

  emitter <- emitter %||% renv_pretty_print_emitter()
  emitter(all)

  invisible(NULL)

}

renv_pretty_print_records_pair_impl <- function(old, new) {

  renv_scope_locale("LC_COLLATE", "C")
  all <- sort(union(names(old), names(new)))

  # compute groups
  groups <- map_chr(all, function(package) {

    lhs <- old[[package]]; rhs <- new[[package]]
    case(
      is.null(lhs$Source)      ~ rhs$Repository %||% rhs$Source,
      is.null(rhs$Source)      ~ lhs$Repository %||% lhs$Source,
      !is.null(rhs$Repository) ~ rhs$Repository,
      !is.null(rhs$Source)     ~ rhs$Source
    )

  })

  n <- max(nchar(all))

  # iterate over each group and print
  uapply(sort(unique(groups)), function(group) {

    lhs <- renv_records_select(old, groups, group)
    rhs <- renv_records_select(new, groups, group)

    nms <- union(names(lhs), names(rhs))
    text <- map_chr(nms, function(nm) {
      renv_record_format_pair(lhs[[nm]], rhs[[nm]])
    })

    if (group == "unknown")
      group <- "(Unknown Source)"

    c(
      header(group),
      paste("-", format(nms, width = n), " ", text),
      ""
    )

  })

}

renv_pretty_print_emitter <- function() {

  emitter <- getOption("renv.pretty.print.emitter", default = NULL)
  if (!is.null(emitter))
    return(emitter)

  if (interactive())
    function(text, ...) writeLines(text, con = stdout(), ...)
  else
    function(text, ...) writeLines(text, con = stderr(), ...)

}

renv_profile_prefix <- function() {
  renv_bootstrap_profile_prefix()
}

renv_profile_get <- function() {
  renv_bootstrap_profile_get()
}

renv_profile_set <- function(profile) {
  renv_bootstrap_profile_set(profile)
}

renv_profile_normalize <- function(profile) {
  renv_bootstrap_profile_normalize(profile)
}

renv_progress_create <- function(max, wait = 1.0) {

  # local variables for closure
  count <- 0L
  max <- max
  message <- ""
  start <- Sys.time()

  function() {

    # check for and print progress
    count <<- count + 1L

    # if not enough time has elapsed yet, nothing to do
    if (Sys.time() - start < wait)
      return()

    # create message
    backspaces <- paste(rep("\b", nchar(message)), collapse = "")
    message <<- sprintf("[%i/%i] ", count, max)
    all <- paste(backspaces, message, sep = "")
    cat(all, file = stdout(), sep = "")

  }

}

renv_progress_callback <- function(callback, max, wait = 1.0) {
  tick <- renv_progress_create(max, wait)
  function(...) { tick(); callback(...) }
}

#' Retrieve the Active Project
#'
#' Retrieve the path to the active project (if any).
#'
#' @param default The value to return when no project is
#'   currently active. Defaults to `NULL`.
#'
#' @export
#'
#' @return The active project directory, as a length-one character vector.
#'
#' @examples
#' \dontrun{
#'
#' # get the currently-active renv project
#' renv::project()
#'
#' }
project <- function(default = NULL) {
  renv_project(default = default)
}

renv_project_get <- function(default = NULL) {

  project <- Sys.getenv("RENV_PROJECT", unset = NA)
  if (is.na(project))
    return(default)

  project

}

renv_project_set <- function(project) {
  Sys.setenv(RENV_PROJECT = project)
}

renv_project_clear <- function() {
  Sys.unsetenv("RENV_PROJECT")
}

renv_project <- function(default = getwd()) {
  renv_project_get(default = default)
}

renv_project_resolve <- function(project = NULL) {
  project <- project %||% renv_project()
  normalizePath(project, winslash = "/", mustWork = FALSE)
}

renv_project_initialized <- function(project) {

  lockfile <- renv_lockfile_path(project)
  if (file.exists(lockfile))
    return(TRUE)

  library <- renv_paths_library(project = project)
  if (file.exists(library))
    return(TRUE)

  FALSE

}

renv_project_type <- function(path) {
  renv_bootstrap_project_type(path)
}

renv_project_remotes <- function(project) {

  # if this project has a DESCRIPTION file, use it to provide records
  descpath <- file.path(project, "DESCRIPTION")
  if (file.exists(descpath))
    return(renv_project_remotes_description(project, descpath))

  # otherwise, use the set of (non-base) packages used in the project
  deps <- dependencies(
    path     = project,
    progress = FALSE,
    errors   = "ignored",
    dev      = TRUE
  )

  packages <- sort(unique(deps$Package))
  setdiff(packages, renv_packages_base())

}

renv_project_remotes_description <- function(project, descpath) {

  # first, parse remotes (if any)
  remotes <- renv_project_remotes_description_remotes(project, descpath)

  # next, find packages mentioned in the DESCRIPTION file
  fields <- c("Depends", "Imports", "Suggests", "LinkingTo")
  deps <- renv_dependencies_discover_description(
    path    = descpath,
    fields  = fields,
    project = project
  )

  if (empty(deps))
    return(list())

  # split according to package
  specs <- split(deps, deps$Package)

  # drop ignored specs
  ignored <- renv_project_ignored_packages(project = project)
  specs <- specs[setdiff(names(specs), c("R", ignored))]

  # if any Roxygen fields are included,
  # infer a dependency on roxygen2 and devtools
  desc <- renv_description_read(descpath)
  if (any(grepl("^Roxygen", names(desc)))) {
    for (package in c("devtools", "roxygen2")) {
      specs[[package]] <-
        specs[[package]] %||%
        renv_dependencies_list(descpath, package, dev = TRUE)
    }
  }

  # now, try to resolve the packages
  records <- enumerate(specs, function(package, spec) {

    # use remote if supplied
    if (!is.null(remotes[[package]]))
      return(remotes[[package]])

    # check for explicit version requirement
    explicit <- spec[spec$Require == "==", ]
    if (nrow(explicit) == 0)
      return(renv_remotes_resolve(package))

    version <- spec$Version[[1]]
    if (!nzchar(version))
      return(renv_remotes_resolve(package))

    entry <- paste(package, version, sep = "@")
    renv_remotes_resolve(entry)

  })

  # return records
  records

}

renv_project_remotes_description_remotes <- function(project, descpath) {

  desc <- renv_description_read(descpath)

  profile <- renv_profile_get()
  field <- if (is.null(profile))
    "Remotes"
  else
    sprintf("Config/renv/profiles/%s/remotes", profile)

  remotes <- desc[[field]]
  if (is.null(remotes))
    return(list())

  splat <- strsplit(remotes, "[[:space:]]*,[[:space:]]*")[[1]]
  resolved <- lapply(splat, renv_remotes_resolve)
  names(resolved) <- extract_chr(resolved, "Package")
  resolved

}

renv_project_ignored_packages <- function(project) {

  # if we don't have a project, nothing to do
  if (is.null(project))
    return(character())

  # read base set of ignored packages
  ignored <- c(
    settings$ignored.packages(project = project),
    renv_project_ignored_packages_self(project)
  )

  # return collected set of ignored packages
  ignored

}

renv_project_ignored_packages_self <- function(project) {

  # only ignore self in package projects
  if (renv_project_type(project) != "package")
    return(NULL)

  # read current package
  desc <- renv_description_read(project)
  package <- desc[["Package"]]

  # respect user preference if set
  ignore <- getOption("renv.snapshot.ignore.self", default = NULL)
  if (identical(ignore, TRUE))
    return(package)
  else if (identical(ignore, FALSE))
    return(NULL)

  # don't ignore self in golem projets
  golem <- file.path(project, "inst/golem-config.yml")
  if (file.exists(golem))
    return(NULL)

  # hack for renv: don't depend on self
  if (identical(package, "renv"))
    return(NULL)

  # return the package name
  package

}

renv_project_id <- function(project) {

  idpath <- renv_id_path(project = project)
  if (!file.exists(idpath)) {
    id <- renv_id_generate()
    writeLines(id, con = idpath)
  }

  readLines(idpath, n = 1L, warn = FALSE)

}

renv_project_synchronized_check <- function(project = NULL, lockfile = NULL) {

  project  <- renv_project_resolve(project)
  lockfile <- lockfile %||% renv_lockfile_load(project)

  # if there are no packages (other than renv) available in the project library,
  # but there are multiple packages referenced in the lockfile,
  # then instruct the user that they may need to run restore
  libpath <- renv_paths_library(project = project)
  packages <- list.files(libpath)

  needsrestore <-
    empty(setdiff(packages, "renv")) &&
    length(lockfile$Packages) > 1

  if (needsrestore) {

    msg <- lines(
      "* The project library is out of sync with the lockfile.",
      "* Use `renv::restore()` to install packages recorded in the lockfile."
    )

    ewritef(msg)
    return(FALSE)
  }

  # perform a lightweight comparison between the project
  # library and lockfile, and report if there may be
  # any conflicts
  library <- renv_libpaths_all()

  # don't validate lockfile state in this scope; just try
  # to read and use it as-is
  renv_scope_options(renv.config.snapshot.validate = FALSE)

  # indicate that we're doing an automatic snapshot
  renv_scope_var("running", TRUE, envir = `_renv_snapshot_auto`)

  # read current state of project library
  libstate <- snapshot(
    project  = project,
    library  = library,
    lockfile = NULL,
    type     = "all",
    force    = TRUE
  )

  # compare with the current lockfile
  diff <- renv_lockfile_diff_packages(libstate, lockfile)

  # we only want to report cases where a package version
  # has changed, or the lockfile references a package that
  # is not currently installed in the project library
  diff <- diff[diff != "remove"]
  if (!empty(diff)) {
    msg <- "* The project may be out of sync -- use `renv::status()` for more details."
    ewritef(msg)
    return(FALSE)
  }

  TRUE

}

# TODO: this gets really dicey once the user starts configuring where
# renv places its project-local state ...
renv_project_find <- function(project = NULL) {

  project <- project %||% getwd()

  anchors <- c("renv.lock", "renv/activate.R")
  resolved <- renv_file_find(project, function(parent) {
    for (anchor in anchors)
      if (file.exists(file.path(parent, anchor)))
        return(parent)
  })

  if (is.null(resolved)) {
    fmt <- "couldn't resolve renv project associated with path %s"
    stopf(fmt, renv_path_pretty(project))
  }

  resolved

}

#' Purge Packages from the Cache
#'
#' Purge packages from the cache. This can be useful if a package which had
#' previously been installed in the cache has become corrupted or unusable,
#' and needs to be reinstalled.
#'
#' `purge()` is an inherently destructive option. It removes packages from the
#' cache, and so any project which had symlinked that package into its own
#' project library would find that package now unavailable. These projects would
#' hence need to reinstall any purged packages. Take heed of this in case you're
#' looking to purge the cache of a package which is difficult to install, or
#' if the original sources for that package are no longer available!
#'
#' @inherit renv-params
#'
#' @param package A single package to be removed from the cache.
#' @param version The package version to be removed. When `NULL`, all versions
#'   of the requested package will be removed.
#' @param hash The specific hashes to be removed. When `NULL`, all hashes
#'   associated with a particular package's version will be removed.
#'
#' @return The set of packages removed from the `renv` global cache,
#'   as a character vector of file paths.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # remove all versions of 'digest' from the cache
#' renv::purge("digest")
#'
#' # remove only a particular version of 'digest' from the cache
#' renv::purge("digest", version = "0.6.19")
#'
#' }
purge <- function(package,
                  ...,
                  version = NULL,
                  hash    = NULL,
                  prompt  = interactive())
{
  renv_scope_error_handler()
  renv_dots_check(...)
  invisible(renv_purge_impl(package, version, hash, prompt))
}

renv_purge_impl <- function(package,
                            version = NULL,
                            hash = NULL,
                            prompt = interactive())
{
  if (length(package) != 1)
    stop("argument 'package' is not of length one", call. = FALSE)

  bail <- function() {
    vwritef("* The requested package is not installed in the cache -- nothing to do.")
    character()
  }

  # get root cache path entry for package
  paths <- renv_paths_cache(package)
  if (!any(file.exists(paths)))
    return(bail())

  # construct versioned path
  paths <- if (is.null(version))
    list.files(paths, full.names = TRUE)
  else
    file.path(paths, version)
  if (!any(file.exists(paths)))
    return(bail())

  # construct hashed path
  paths <- if (is.null(hash))
    list.files(paths, full.names = TRUE)
  else
    file.path(paths, hash)
  if (all(!file.exists(paths)))
    return(bail())

  # now add package name
  paths <- file.path(paths, renv_path_component(paths, 3))

  # check that these entries exist
  missing <- !file.exists(paths)
  if (any(missing)) {

    renv_pretty_print(
      paths[missing],
      "The following entries were not found in the cache:",
      "They will be ignored.",
      wrap = FALSE
    )

    paths <- paths[!missing]

  }

  # nocov start
  if (prompt || renv_verbose()) {

    renv_pretty_print(
      renv_cache_format_path(paths),
      "The following packages will be purged from the cache:",
      wrap = FALSE
    )

    if (prompt && !proceed()) {
      renv_report_user_cancel()
      return(paths)
    }

  }
  # nocov end

  unlink(paths, recursive = TRUE)
  renv_cache_clean_empty()

  n <- length(paths)
  vwritef("* Removed %i %s from the cache.", n, plural("package", n))

  invisible(paths)

}

renv_pyenv_root <- function() {
  root <- Sys.getenv("PYENV_ROOT", unset = renv_pyenv_root_default())
  path.expand(root)
}

renv_pyenv_root_default <- function() {

  if (renv_platform_windows())
    "~/.pyenv/pyenv-win"
  else
    "~/.pyenv"

}


renv_python_conda_select <- function(name, version = NULL) {

  # get python package
  version <- version %||% Sys.getenv("RENV_CONDA_PYTHON_VERSION", unset = "3.7")
  packages <- paste("python", version, sep = "=")

  # handle paths (as opposed to environment names)
  if (grepl("[/\\\\]", name)) {
    if (!file.exists(name))
      return(reticulate::conda_create(envname = name, packages = packages))
    return(renv_python_exe(name))
  }

  # check for an existing conda environment
  envs <- reticulate::conda_list()
  idx <- which(name == envs$name)
  if (length(idx))
    return(envs$python[[idx]])

  # no environment exists; create it
  reticulate::conda_create(envname = name, packages = packages)

}

# TODO: support prompt
renv_python_conda_snapshot <- function(project, prompt, python) {

  owd <- setwd(project)
  on.exit(setwd(owd), add = TRUE)

  path <- file.path(project, "environment.yml")

  # find the root of the associated conda environment
  lockfile <- renv_lockfile_load(project = project)
  name <- lockfile$Python$Name %||% renv_python_envpath(project, "conda", version)
  python <- renv_python_conda_select(name)
  info <- renv_python_info(python)
  prefix <- info$root

  conda <- reticulate::conda_binary()
  args <- c(
    "env", "export",
    "--prefix", renv_shell_path(prefix),
    "--file", renv_shell_path(path)
  )

  output <- if (renv_tests_running()) FALSE else ""
  system2(conda, args, stdout = output, stderr = output)

  vwritef("* Wrote Python packages to '%s'.", aliased_path(path))
  return(TRUE)
}

# TODO: support prompt
renv_python_conda_restore <- function(project, prompt, python) {

  owd <- setwd(project)
  on.exit(setwd(owd), add = TRUE)

  path <- file.path(project, "environment.yml")

  # find the root of the associated conda environment
  lockfile <- renv_lockfile_load(project = project)
  name <- lockfile$Python$Name %||% renv_python_envpath(project, "conda", version)
  python <- renv_python_conda_select(name)
  info <- renv_python_info(python)
  prefix <- info$root

  conda <- reticulate::conda_binary()
  cmd <- if (file.exists(prefix)) "update" else "create"
  args <- c(
    "env", cmd,
    "--prefix", renv_shell_path(prefix),
    "--file", renv_shell_path(path)
  )

  output <- if (renv_tests_running()) FALSE else ""
  system2(conda, args, stdout = output, stderr = output)

  return(TRUE)

}

renv_python_virtualenv_home <- function() {
  Sys.getenv("WORKON_HOME", unset = "~/.virtualenvs")
}

renv_python_virtualenv_path <- function(name) {

  # if the name contains a slash, use it as-is
  if (grepl("/", name, fixed = TRUE))
    return(renv_path_canonicalize(name))

  # treat names starting with '.' specially
  if (substring(name, 1L, 1L) == ".")
    return(renv_path_canonicalize(name))

  # otherwise, resolve relative to virtualenv home
  home <- renv_python_virtualenv_home()
  file.path(home, name)

}

renv_python_virtualenv_validate <- function(path, version) {

  # get path to python executable
  python <- renv_python_exe(path)

  # compare requested + actual versions
  if (!is.null(version)) {
    request <- version
    current <- renv_python_version(python)
    if (!renv_version_eq(request, current, 2L)) {
      fmt <- "Project requested Python version '%s' but '%s' is currently being used"
      warningf(fmt, request, current)
    }
  }

  python

}

renv_python_virtualenv_create <- function(python, path) {

  ensure_parent_directory(path)

  python <- renv_path_canonicalize(python)
  version <- renv_python_version(python)
  module <- if (numeric_version(version) > "3.2") "venv" else "virtualenv"
  args <- c("-m", module, renv_shell_path(path))
  renv_system_exec(python, args, "creating virtual environment")

  info <- renv_python_info(path)
  info$python

}

renv_python_virtualenv_update <- function(python) {

  # resolve python executable path
  python <- renv_python_exe(python)
  python <- renv_path_canonicalize(python)

  # resolve packages
  packages <- c("pip", "setuptools", "wheel")

  # don't upgrade these packages for older versions of python, as we may
  # end up installing versions of packages that aren't actually compatible
  # with the version of python we're running
  version <- renv_python_version(python)
  if (renv_version_lt(version, "3.6"))
    return(TRUE)

  # perform the install
  # make errors non-fatal as the environment will still be functional even
  # if we're not able to install or update these packages
  status <- catch(pip_install(packages, python = python))
  if (inherits(status, "error"))
    warning(status)

  TRUE

}

renv_python_virtualenv_snapshot <- function(project, prompt, python) {

  owd <- setwd(project)
  on.exit(setwd(owd), add = TRUE)

  path <- file.path(project, "requirements.txt")
  before <- character()
  if (file.exists(path))
    before <- readLines(path, warn = FALSE)

  after <- pip_freeze(python = python)
  if (setequal(before, after)) {
    vwritef("* Python requirements are already up to date.")
    return(FALSE)
  }

  renv_pretty_print(
    values   = after,
    preamble = "The following will be written to requirements.txt:",
    wrap     = FALSE
  )

  if (prompt && !proceed()) {
    renv_report_user_cancel()
    return(FALSE)
  }

  writeLines(after, con = path)

  fmt <- "* Wrote Python packages to %s."
  vwritef(fmt, renv_path_pretty(path))
  return(TRUE)

}

renv_python_virtualenv_restore <- function(project, prompt, python) {

  owd <- setwd(project)
  on.exit(setwd(owd), add = TRUE)

  path <- file.path(project, "requirements.txt")
  if (!file.exists(path))
    return(FALSE)

  before <- readLines(path, warn = FALSE)
  after <- pip_freeze(python = python)
  diff <- renv_vector_diff(before, after)
  if (empty(diff)) {
    vwritef("* The Python library is already up to date.")
    return(FALSE)
  }

  renv_pretty_print(
    values   = diff,
    preamble = "The following Python packages will be restored:",
    wrap     = FALSE
  )

  if (prompt && !proceed()) {
    renv_report_user_cancel()
    return(FALSE)
  }

  pip_install_requirements(diff, python = python, stream = TRUE)
  TRUE

}

renv_python_resolve <- function(python = NULL) {

  # if Python was explicitly supplied, use it
  if (!is.null(python)) {

    resolved <- Sys.which(renv_path_canonicalize(python))
    if (nzchar(resolved))
      return(resolved)

    stopf("'%s' does not refer to a valid python interpreter", python)

  }

  # in interactive sessions, ask user what version of python they'd like to use
  if (interactive()) {

    python <- renv_python_select()

    fmt <- "* Selected %s [Python %s]."
    vwritef(fmt, renv_path_pretty(python), renv_python_version(python))

    return(path.expand(python))

  }

  # check environment variables
  envvars <- c("RETICULATE_PYTHON", "RETICULATE_PYTHON_ENV")
  for (envvar in envvars) {
    val <- Sys.getenv(envvar, unset = NA)
    if (!is.na(val) && file.exists(val))
      return(val)
  }

  # check on the PATH (prefer Python 3)
  for (binary in c("python3", "python")) {
    python <- Sys.which(binary)
    if (nzchar(python))
      return(python)
  }

  stopf("could not locate Python (not available on the PATH)")

}

renv_python_find <- function(version, path = NULL) {
  renv_python_find_impl(version, path)
}

renv_python_find_impl <- function(version, path = NULL) {

  # if we've been given the name of an environment,
  # check to see if it's already been initialized
  # and use the associated copy of Python if possible
  if (!is.null(path) && file.exists(path)) {
    python <- catch(renv_python_exe(path))
    if (!inherits(python, "error"))
      return(python)
  }

  # try to find a compatible version of python
  pythons <- renv_python_discover()
  if (length(pythons) == 0) {

    fmt <- lines(
      "project requested Python %s, but no compatible Python installation could be found.",
      "renv's Python integration will be disabled in this session.",
      "See `?renv::use_python` for more details."
    )

    msg <- sprintf(fmt, version)
    stop(msg)

  }

  # read python versions
  pyversions <- map_chr(pythons, function(python) {
    tryCatch(
      renv_python_version(python),
      error = function(e) "0.0.0"
    )
  })

  # try to find a compatible version
  renv_version_match(pyversions, version)

}

renv_python_exe <- function(path) {

  # if this already looks like a Python executable, use it directly
  info <- renv_file_info(path)
  if (identical(info$isdir, FALSE) && startswith(basename(path), "python"))
    return(renv_path_canonicalize(path))

  # otherwise, attempt to infer the Python executable type
  info <- renv_python_info(path)
  if (!is.null(info$python))
    return(renv_path_canonicalize(info$python))

  fmt <- "failed to find Python executable associated with path %s"
  stopf(fmt, renv_path_pretty(path))

}

renv_python_version <- function(python) {
  python <- normalizePath(python, winslash = "/", mustWork = TRUE)
  filebacked("python.versions", python, renv_python_version_impl)
}

renv_python_version_impl <- function(python) {
  python <- renv_path_canonicalize(python)
  code <- "from platform import python_version; print(python_version())"
  args <- c("-c", shQuote(code))
  action <- "reading Python version"
  renv_system_exec(python, args, action)
}

renv_python_info <- function(python) {

  found <- renv_file_find(python, function(path) {

    # check for virtual environment files
    virtualenv <-
      file.exists(file.path(path, "pyvenv.cfg")) ||
      file.exists(file.path(path, ".Python")) ||
      file.exists(file.path(path, "bin/activate_this.py"))

    if (virtualenv) {
      suffix <- if (renv_platform_windows()) "Scripts/python.exe" else "bin/python"
      python <- file.path(path, suffix)
      return(list(python = python, type = "virtualenv", root = path))
    }

    # check for conda-meta
    condaenv <-
      file.exists(file.path(path, "conda-meta")) &&
      !file.exists(file.path(path, "condabin"))

    if (condaenv) {
      suffix <- if (renv_platform_windows()) "python.exe" else "bin/python"
      python <- file.path(path, suffix)
      return(list(python = python, type = "conda", root = path))
    }

  })

  if (!is.null(found))
    return(found)

  if (file.exists(python))
    list(python = python, type = "system", root = python)

}

renv_python_type <- function(python) {
  info <- renv_python_info(python)
  info$type
}

renv_python_action <- function(action, prompt, project) {

  python <- Sys.getenv("RENV_PYTHON", unset = NA)
  if (is.na(python) || !file.exists(python))
    return(NULL)

  type <- renv_python_type(python)
  if (is.null(type))
    return(NULL)

  if (type == "conda" && !requireNamespace("reticulate", quietly = TRUE))
    return(NULL)

  action(python, type, prompt, project)

}

renv_python_snapshot <- function(project, prompt) {
  renv_python_action(
    renv_python_snapshot_impl,
    prompt  = prompt,
    project = project
  )
}

renv_python_snapshot_impl <- function(python, type, prompt, project) {

  switch(type,
    virtualenv = renv_python_virtualenv_snapshot(project, prompt, python),
    conda      = renv_python_conda_snapshot(project, prompt, python)
  )

}

renv_python_restore <- function(project, prompt) {
  renv_python_action(
    renv_python_restore_impl,
    prompt  = prompt,
    project = project
  )
}

renv_python_restore_impl <- function(python, type, prompt, project) {

  case(
    type == "virtualenv" ~ renv_python_virtualenv_restore(project, prompt, python),
    type == "conda"      ~ renv_python_conda_restore(project, prompt, python)
  )

}

renv_python_envpath_virtualenv <- function(version) {
  majmin <- paste(renv_version_components(version, 1L:2L), collapse = ".")
  fmt <- "python/virtualenvs/renv-python-%s"
  sprintf(fmt, majmin)
}

renv_python_envpath_condaenv <- function(version) {
  "python/condaenvs/renv-python"
}

renv_python_envpath <- function(project, type, version = NULL) {

  suffix <- case(
    type == "virtualenv" ~ renv_python_envpath_virtualenv(version),
    type == "conda"      ~ renv_python_envpath_condaenv(version),
    ~ stopf("internal error: unrecognized environment type '%s'", type)
  )

  renv_paths_renv(suffix, project = project)

}

renv_python_envname <- function(project, path, type) {

  # check for a project-local environment
  if (renv_path_within(path, project)) {
    stem <- substring(path, nchar(project) + 2L)
    path <- paste(".", stem, sep = "/")
    return(path)
  }

  bn <- basename(path)

  # check for file within virtualenv
  ok <-
    type == "virtualenv" &&
    identical(renv_python_virtualenv_path(bn), path)

  if (ok)
    return(bn)

  # check for named conda environment
  ok <-
    type == "conda" &&
    bn %in% reticulate::conda_list()$name

  if (ok)
    return(bn)

  # doesn't match any known named environments; return full path
  path

}

renv_python_discover <- function() {

  all <- stack()

  # find python in some pre-determined root directories
  roots <- c(
    getOption("renv.python.root"),
    Sys.getenv("WORKON_HOME", "~/.virtualenvs"),
    "/opt/python",
    "/opt/local/python",
    "~/opt/python",
    file.path(renv_pyenv_root(), "versions")
  )

  for (root in roots) {
    versions <- sort(list.files(root, full.names = TRUE), decreasing = TRUE)
    exts <- if (renv_platform_windows()) "Scripts/python.exe" else "bin/python"
    pythons <- file.path(versions, exts)
    all$push(pythons)
  }

  # find Homebrew python
  if (renv_platform_macos()) {

    homebrew <- renv_homebrew_root()
    roots <- sort(list.files(
      path       = file.path(homebrew, "opt"),
      pattern    = "^python@[[:digit:]]+[.][[:digit:]]+$",
      full.names = TRUE
    ), decreasing = TRUE)

    for (root in roots) {

      # homebrew python doesn't install bin/python, so we need
      # to be a little bit more clever here
      exes <- list.files(
        path = file.path(root, "bin"),
        pattern = "^python[[:digit:]]+[.][[:digit:]]+$",
        full.names = TRUE
      )

      if (length(exes))
        all$push(exes[[1L]])

    }

  }

  # find Windows python installations
  if (renv_platform_windows()) {

    sd <- Sys.getenv("SYSTEMDRIVE", unset = "C:")
    roots <- file.path(sd, c("", "Program Files"))

    lad <- Sys.getenv("LOCALAPPDATA", unset = NA)
    if (!is.na(lad))
      roots <- c(roots, file.path(lad, "Programs/Python"))

    dirs <- list.files(
      path       = roots,
      pattern    = "^Python",
      full.names = TRUE
    )

    if (length(dirs)) {
      exes <- file.path(dirs, "python.exe")
      pythons <- normalizePath(exes, winslash = "/", mustWork = FALSE)
      all$push(pythons)
    }

  }

  # find Python installations on the PATH
  path <- Sys.getenv("PATH", unset = "")
  splat <- strsplit(path, .Platform$path.sep, fixed = TRUE)[[1L]]
  for (entry in splat) {
    for (exe in c("python3", "python")) {
      python <- Sys.which(file.path(entry, exe))
      if (nzchar(python))
        all$push(python)
    }
  }

  # collect discovered pythons as vector
  pythons <- unlist(all$data(), recursive = FALSE, use.names = TRUE)

  # don't include /usr/bin/python on macOS (too old)
  if (renv_platform_macos())
    pythons <- setdiff(pythons, "/usr/bin/python")

  # get list of pythons
  pythons <- renv_path_canonicalize(pythons[file.exists(pythons)])

  # don't include WindowsApps
  if (renv_platform_windows())
    pythons <- grep("/WindowsApps/", pythons, invert = TRUE, value = TRUE)

  unique(pythons)

}

renv_python_select_error <- function() {

  lines <- c(
    "renv was unable to find any Python installations on your machine.",
    if (renv_platform_windows())
      "Consider installing Python from https://www.python.org/downloads/windows/.",
    if (renv_platform_macos())
      "Consider installing Python from https://www.python.org/downloads/mac-osx/."
  )

  stop(paste(lines, collapse = "\n"))

}

renv_python_select <- function(candidates = NULL) {

  candidates <- aliased_path(candidates %||% renv_python_discover())
  if (empty(candidates))
    return(renv_python_select_error())

  title <- "Please select a version of Python to use with this project:"
  selection <- tryCatch(
    utils::select.list(candidates, title = title, graphics = FALSE),
    interrupt = identity
  )

  if (selection %in% "" || inherits(selection, "interrupt"))
    stop("operation canceled by user")

  return(path.expand(selection))

}

renv_python_module_available <- function(python, module) {
  python <- renv_path_canonicalize(python)
  command <- paste("import", module)
  args <- c("-c", shQuote(command))
  status <- system2(python, args, stdout = FALSE, stderr = FALSE)
  identical(status, 0L)
}

renv_python_active <- function() {

  python <- Sys.getenv("RENV_PYTHON", unset = NA)
  if (is.na(python))
    stop("internal error: RENV_PYTHON is not set")

  renv_python_validate(python)

}

renv_python_validate <- function(python) {

  if (!file.exists(python)) {
    fmt <- "%s does not exist"
    stopf(fmt, renv_path_pretty(python))
  }

  invisible(python)

}

R <- function() {
  bin <- R.home("bin")
  exe <- if (renv_platform_windows()) "R.exe" else "R"
  file.path(bin, exe)
}

r <- function(args, ...) {

  # ensure R_LIBS is set; unset R_LIBS_USER and R_LIBS_SITE
  # so that R_LIBS will always take precedence
  rlibs <- paste(renv_libpaths_all(), collapse = .Platform$path.sep)
  renv_scope_envvars(R_LIBS = rlibs, R_LIBS_USER = "NULL", R_LIBS_SITE = "NULL")

  # ensure Rtools is on the PATH for Windows
  renv_scope_rtools()

  # invoke r
  suppressWarnings(system2(R(), args, ...))

}

r_exec_error <- function(package, output, label, extra) {

  # installation failed; write output for user
  fmt <- "Error %sing package '%s':"
  header <- sprintf(fmt, label, package)

  lines <- paste(rep("=", nchar(header)), collapse = "")
  all <- c(header, lines, "", output)

  # try to add diagnostic information if possible
  diagnostics <- r_exec_error_diagnostics(package, output)
  if (!empty(diagnostics)) {
    size <- min(getOption("width"), 78L)
    dividers <- paste(rep.int("-", size), collapse = "")
    all <- c(all, paste(dividers, diagnostics, collapse = "\n\n"))
  }

  # normalize 'extra'
  extra <- if (is.integer(extra))
    paste("error code", extra)
  else
    paste(renv_path_pretty(extra), "does not exist")

  # stop with an error
  message <- sprintf("%s of package '%s' failed [%s]", label, package, extra)
  error <- simpleError(message = message)
  error$output <- all
  stop(error)

}

r_exec_error_diagnostics_fortran_library <- function() {

  checker <- function(output) {
    pattern <- "library not found for -l(quadmath|gfortran|fortran)"
    idx <- grep(pattern, output, ignore.case = TRUE)
    if (length(idx))
      return(unique(output[idx]))
  }

  suggestion <- "
R was unable to find one or more FORTRAN libraries during compilation.
This often implies that the FORTRAN compiler has not been properly configured.
Please see https://stackoverflow.com/q/35999874 for more information.
"

  list(
    checker = checker,
    suggestion = suggestion
  )

}

r_exec_error_diagnostics_fortran_binary <- function() {

  checker <- function(output) {
    pattern <- "gfortran: no such file or directory"
    idx <- grep(pattern, output, ignore.case = TRUE)
    if (length(idx))
      return(unique(output[idx]))
  }

  suggestion <- "
R was unable to find the gfortran binary.
gfortran is required for the compilation of FORTRAN source files.
Please check that gfortran is installed and available on the PATH.
Please see https://stackoverflow.com/q/35999874 for more information.
"

  list(
    checker = checker,
    suggestion = suggestion
  )

}

r_exec_error_diagnostics_openmp <- function() {

  checker <- function(output) {
    pattern <- "unsupported option '-fopenmp'"
    idx <- grep(pattern, output, fixed = TRUE)
    if (length(idx))
      return(unique(output[idx]))
  }

  suggestion <- "
R is currently configured to use a compiler that does not have OpenMP support.
You may need to disable OpenMP, or update your compiler toolchain.
Please see https://support.bioconductor.org/p/119536/ for a related discussion.
"

  list(
    checker = checker,
    suggestion = suggestion
  )

}

r_exec_error_diagnostics <- function(package, output) {

  diagnostics <- list(
    r_exec_error_diagnostics_fortran_library(),
    r_exec_error_diagnostics_fortran_binary(),
    r_exec_error_diagnostics_openmp()
  )

  suggestions <- uapply(diagnostics, function(diagnostic) {

    check <- catch(diagnostic$checker(output))
    if (!is.character(check))
      return()

    suggestion <- diagnostics$suggestion
    reasons <- paste("-", shQuote(check), collapse = "\n")
    paste(diagnostic$suggestion, "Reason(s):", reasons, sep = "\n")

  })

  as.character(suggestions)

}

# install package called 'package' located at path 'path'
r_cmd_install <- function(package, path, ...) {

  # normalize path to package
  path <- renv_path_normalize(path, winslash = "/", mustWork = TRUE)

  # unpack source packages in zip archives
  unpack <-
    renv_archive_type(path) %in% "zip" &&
    renv_package_type(path) %in% "source"

  if (unpack) {
    path <- renv_package_unpack(package, path, force = TRUE)
    on.exit(unlink(path, recursive = TRUE), add = TRUE)
  }

  # resolve default library path
  library <- renv_libpaths_default()

  # validate that we have command line tools installed and
  # available for e.g. macOS
  if (renv_platform_macos() && renv_package_type(path) == "source")
    renv_xcode_check()

  # perform platform-specific pre-install checks
  renv_scope_install()

  # perform the install
  # note that we need to supply '-l' below as otherwise the library paths
  # could be changed by, for example, site-specific profiles
  args <- c(
    "--vanilla",
    "CMD", "INSTALL", "--preclean", "--no-multiarch",
    r_cmd_install_option(package, "configure.args", TRUE),
    r_cmd_install_option(package, "configure.vars", TRUE),
    r_cmd_install_option(package, c("install.opts", "INSTALL_opts"), FALSE),
    "-l", renv_shell_path(library),
    ...,
    renv_shell_path(path)
  )

  if (config$install.verbose()) {

    status <- r(args, stdout = "", stderr = "")
    if (!identical(status, 0L))
      stopf("install of package '%s' failed", package)

    installpath <- file.path(library, package)
    if (!file.exists(installpath)) {
      fmt <- "install of package '%s' failed: %s does not exist"
      stopf(fmt, package, renv_path_pretty(installpath))
    }

    installpath

  } else {

    output <- r(args, stdout = TRUE, stderr = TRUE)
    status <- attr(output, "status") %||% 0L
    if (!identical(status, 0L))
      r_exec_error(package, output, "install", status)

    installpath <- file.path(library, package)
    if (!file.exists(installpath))
      r_exec_error(package, output, "install", installpath)

    installpath

  }


}

r_cmd_build <- function(package, path, ...) {

  path <- renv_path_normalize(path, winslash = "/", mustWork = TRUE)
  args <- c("--vanilla", "CMD", "build", "--md5", ..., renv_shell_path(path))

  output <- r(args, stdout = TRUE, stderr = TRUE)
  status <- attr(output, "status") %||% 0L
  if (!identical(status, 0L))
    r_exec_error(package, output, "build", status)

  pasted <- paste(output, collapse = "\n")
  pattern <- "[*] building .([a-zA-Z0-9_.-]+)."
  matches <- regexec(pattern, pasted)
  text <- regmatches(pasted, matches)

  tarball <- text[[1L]][[2L]]
  if (!file.exists(tarball))
    r_exec_error(package, output, "build", tarball)

  file.path(getwd(), tarball)

}

r_cmd_install_option <- function(package, options, configure) {

  # read option -- first, check for package-specific option, then
  # fall back to 'global' option
  for (option in options) {
    value <- r_cmd_install_option_impl(package, option, configure)
    if (!is.null(value))
      return(value)
  }

}

r_cmd_install_option_impl <- function(package, option, configure) {

  value <-
    getOption(paste(option, package, sep = ".")) %||%
    getOption(option)

  if (is.null(value))
    return(NULL)

  # if the value is named, treat it as a list,
  # mapping package names to their configure arguments
  if (!is.null(names(value)))
    value <- as.list(value)

  # check for named values
  if (!is.null(names(value))) {
    value <- value[[package]]
    if (is.null(value))
      return(NULL)
  }

  # if this is a configure option, format specially
  if (configure) {
    confkey <- sub(".", "-", option, fixed = TRUE)
    confval <- if (!is.null(names(value)))
      shQuote(paste(names(value), value, sep = "=", collapse = " "))
    else
      shQuote(paste(value, collapse = " "))
    return(sprintf("--%s=%s", confkey, confval))
  }

  # otherwise, just paste it
  paste(value, collapse = " ")

}

renv_properties_read <- function(path = NULL,
                                 text = NULL,
                                 delimiter = ":",
                                 dequote = TRUE,
                                 trim = TRUE)
{
  text <- text %||% readLines(path, warn = FALSE)

  # drop empty lines, commented values
  text <- text[nzchar(text)]
  text <- grep("^\\s*[#;]", text, value = TRUE, invert = TRUE)

  # find the delimiter for each line
  text <- grep(delimiter, text, fixed = TRUE, value = TRUE)
  index <- regexpr(delimiter, text, fixed = TRUE)
  index <- index[index != -1]

  # separate into keys, values
  keys <- substring(text, 1, index - 1)
  vals <- substring(text, index + nchar(delimiter))

  # trim whitespace when requested
  if (trim) {
    keys <- trimws(keys)
    vals <- trimws(vals)
  }

  # strip quotes if requested
  if (dequote) {
    keys <- dequote(keys)
    vals <- dequote(vals)
  }

  # return as named list
  names(vals) <- keys
  as.list(vals)

}

#' Rebuild the Packages in your Project Library
#'
#' Rebuild and reinstall packages in your library. This can be useful as a
#' diagnostic tool -- for example, if you find that one or more of your
#' packages fail to load, and you want to ensure that you are starting from a
#' clean slate.
#'
#' @inherit renv-params
#'
#' @param packages The package(s) to be rebuilt. When `NULL`, all packages
#'   in the library will be reinstalled.
#'
#' @param recursive Boolean; should dependencies of packages be rebuilt
#'   recursively? Defaults to `TRUE`.
#'
#' @return A named list of package records which were installed by `renv`.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # rebuild the 'dplyr' package + all of its dependencies
#' renv::rebuild("dplyr", recursive = TRUE)
#'
#' # rebuild only 'dplyr'
#' renv::rebuild("dplyr", recursive = FALSE)
#'
#' }
rebuild <- function(packages  = NULL,
                    recursive = TRUE,
                    ...,
                    type    = NULL,
                    prompt  = interactive(),
                    library = NULL,
                    project = NULL)
{
  renv_consent_check()
  renv_scope_error_handler()
  renv_dots_check(...)

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  libpaths <- renv_libpaths_resolve(library)
  library <- nth(libpaths, 1L)

  # get collection of packages currently installed
  records <- renv_snapshot_r_packages(libpaths = libpaths, project = project)
  if (empty(records)) {
    vwritef("* There are no packages currently installed -- nothing to rebuild.")
    return(invisible(records))
  }

  # subset packages based on user request
  packages <- setdiff(packages %||% names(records), "renv")
  records <- named(records[packages], packages)

  # for any packages that are missing, use the latest available instead
  records <- enumerate(records, function(package, record) {
    record %||% renv_available_packages_latest(package) %||% {
      fmt <- "package '%s' is not available"
      stopf(fmt, package)
    }
  })

  # apply any overrides
  records <- renv_records_override(records)

  # notify the user
  preamble <- if (recursive)
    "The following package(s) and their dependencies will be reinstalled:"
  else
    "The following package(s) will be reinstalled:"

  renv_pretty_print_records(records, preamble)

  if (prompt && !proceed()) {
    renv_report_user_cancel()
    return(invisible(records))
  }

  # figure out rebuild parameter
  rebuild <- if (recursive) NA else packages

  # perform the install
  install(
    packages = records,
    library  = libpaths,
    type     = type,
    rebuild  = rebuild,
    project  = project
  )
}

#' Update Package Records in a Lockfile
#'
#' Use `record()` to record a new entry within an existing `renv` lockfile.
#'
#' This function can be useful when you need to change one or more of the
#' package records within an `renv` lockfile -- for example, because a recorded
#' package cannot be restored in a particular environment, and you know of a
#' suitable alternative.
#'
#' @section Records:
#'
#' Records can be provided either using the **remotes** short-hand syntax,
#' or by using an \R list of entries to record within the lockfile. See
#' `?lockfiles` for more information on the structure of a package record.
#'
#' @inheritParams renv-params
#'
#' @param records A list of named records, mapping package names to a definition
#'   of their source. See **Records** for more details.
#'
#' @param lockfile The path to a lockfile. By default, the project lockfile
#'   is used.
#'
#' @example examples/examples-record.R
#' @export
record <- function(records,
                   lockfile = NULL,
                   project  = NULL)
{
  renv_scope_error_handler()

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  lockfile <- lockfile %||% renv_lockfile_path(project)

  records <- case(
    is.character(records) ~ lapply(records, renv_remotes_resolve, latest = TRUE),
    is.list(records)      ~ renv_records_resolve(records, latest = TRUE),
    ~ stopf("unexpected records format '%s'", typeof(records))
  )

  names(records) <- enum_chr(records, function(package, record) {
    if (is.null(package) || is.na(package) || !nzchar(package))
      record[["Package"]]
    else
      package
  })

  if (is.list(lockfile))
    return(renv_lockfile_modify(lockfile, records))

  if (!file.exists(lockfile)) {
    fmt <- "no lockfile exists at path %s"
    stopf(fmt, renv_path_pretty(lockfile))
  }

  old <- renv_lockfile_read(lockfile)
  new <- renv_lockfile_modify(old, records)
  renv_lockfile_write(new, lockfile)

  n <- length(records)
  fmt <- "* Updated %i %s in %s."
  vwritef(fmt, n, plural("record", n), renv_path_pretty(lockfile))

  renv <- records[["renv"]]
  if (!is.null(renv) && !is.null(renv[["Version"]])) {
    renv_infrastructure_write_activate(
      project = project,
      version = renv[["Version"]]
    )
  }

  invisible(lockfile)

}

renv_record_normalize <- function(record) {

  # drop remotes from records with a repository source
  if (identical(record$Source, "Repository"))
    record <- record[grep("^Remote", names(record), invert = TRUE)]

  record

}

# tools for interacting with the R package records encoded
# within a lockfile
renv_records <- function(records) {
  if (inherits(records, "renv_lockfile"))
    return(records$Packages)
  records
}

`renv_records<-` <- function(x, value) {
  x$Packages <- filter(value, Negate(empty))
  x
}

renv_records_select <- function(records, actions, action) {
  records <- renv_records(records)
  matching <- actions[actions %in% action]
  keep(records, names(matching))
}

renv_records_sort <- function(records) {
  renv_scope_locale("LC_COLLATE", "C")
  records[order(names(records))]
}

renv_records_override <- function(records) {
  enumerate(records, renv_options_override, scope = "renv.records")
}

renv_record_names <- function(record, fields = NULL) {
  fields <- fields %||% c("Package", "Version", "Source")
  remotes <- grep("^Remote", names(record), value = TRUE)
  nms <- c(fields, setdiff(remotes, "Remotes"))
  renv_vector_intersect(nms, names(record))
}

renv_record_cacheable <- function(record) {

  # check if the record has been marked as cacheable
  cacheable <- record$Cacheable %||% TRUE
  if (identical(cacheable, FALSE))
    return(FALSE)

  # check for unknown source
  source <- renv_record_source(record)
  if (source == "unknown")
    return(FALSE)

  # record is ok
  TRUE

}

renv_record_source <- function(record, normalize = FALSE) {

  # if this appears to be a file path, then keep it as-is
  source <- record$Source %||% "unknown"
  if (grepl("[/\\]", source))
    return(source)

  # otherwise, try to normalize it
  source <- tolower(record$Source %||% "unknown")
  if (normalize)
    source <- renv_record_source_normalize(record, source)

  source

}

renv_record_source_normalize <- function(record, source) {

  # normalize different types of git remotes
  if (source %in% c("git2r", "xgit"))
    source <- "git"

  # handle old lockfiles where 'source' was explicitly set as CRAN
  if (source %in% c("cran"))
    source <- "repository"

  # check for ad-hoc requests to install from bioc
  if (identical(source, "repository")) {
    repos <- record$Repository %||% ""
    if (tolower(repos) %in% c("bioc", "bioconductor"))
      source <- "bioconductor"
  }

  # all done; return normalized source
  source

}

renv_record_validate <- function(package, record) {

  # check for a record -- minimally, a list with a package name
  if (is.list(record) && is.character(record$Package))
    return(record)

  # if we're running tests, or in CI, then report
  if (renv_tests_running() || !is.na(Sys.getenv("CI", unset = NA))) {
    fmt <- "! Internal error: unexpected record for package '%s'"
    writef(fmt, package)
    print(record)
  }

  # return record as-is
  record

}

renv_record_format_remote <- function(record) {

  remotes <- c("RemoteUsername", "RemoteRepo")
  if (all(remotes %in% names(record)))
    return(renv_record_format_short_remote(record))

  paste(record$Package, record$Version, sep = "@")

}

renv_record_format_short <- function(record) {

  remotes <- c("RemoteUsername", "RemoteRepo")
  if (all(remotes %in% names(record)))
    return(renv_record_format_short_remote(record))

  # TODO: include other information (e.g. repository name)?
  record$Version

}

renv_record_format_short_remote <- function(record) {

  text <- paste(record$RemoteUsername, record$RemoteRepo, sep = "/")

  subdir <- record$RemoteSubdir %||% ""
  if (nzchar(subdir))
    text <- paste(text, subdir, sep = ":")

  if (!is.null(record$RemoteRef)) {
    ref <- record$RemoteRef
    if (!identical(ref, "master"))
      text <- paste(text, record$RemoteRef, sep = "@")
  } else if (!is.null(record$RemoteSha)) {
    sha <- substring(record$RemoteSha, 1L, 8L)
    text <- paste(text, sha, sep = "@")
  }

  text

}

renv_record_format_pair <- function(lhs, rhs) {

  # check for install / remove
  if (is.null(lhs))
    return(sprintf("[* -> %s]", renv_record_format_short(rhs)))
  else if (is.null(rhs))
    return(sprintf("[%s -> *]", renv_record_format_short(lhs)))

  map <- list(
    Source         = "src",
    Repository     = "repo",
    Version        = "ver",
    RemoteHost     = "host",
    RemoteUsername = "user",
    RemoteRepo     = "repo",
    RemoteRef      = "ref",
    RemoteSha      = "sha",
    RemoteSubdir   = "subdir"
  )

  fields <- names(map)

  # check to see which fields have changed between the two
  diff <- map_lgl(fields, function(field) {
    !identical(lhs[[field]], rhs[[field]])
  })

  changed <- names(which(diff))

  if (empty(changed)) {
    fmt <- "[%s: unchanged]"
    lhsf <- renv_record_format_short(lhs)
    return(sprintf(fmt, lhsf))
  }

  # check for only sha changed
  usesha <-
    setequal(changed, "RemoteSha") ||
    setequal(changed, c("RemoteSha", "Version"))

  if (usesha) {

    user <- lhs$RemoteUsername %||% "*"
    repo <- lhs$RemoteRepo %||% "*"
    spec <- paste(user, repo, sep = "/")

    ref <- lhs$RemoteRef %||% "*"
    if (!ref %in% c("master", "*"))
      spec <- paste(spec, ref, sep = "@")

    fmt <- "[%s: %s -> %s]"
    lsha <- substring(lhs$RemoteSha %||% "*", 1L, 8L)
    rsha <- substring(rhs$RemoteSha %||% "*", 1L, 8L)

    return(sprintf(fmt, spec, lsha, rsha))

  }

  # check for only source change
  if (setequal(changed, "Source")) {
    fmt <- "[%s: %s -> %s]"
    ver <- lhs$Version %||% "*"
    lhsf <- lhs$Source %||% "*"
    rhsf <- rhs$Source %||% "*"
    return(sprintf(fmt, ver, lhsf, rhsf))
  }

  # check only version changed
  if (setequal(changed, "Version")) {
    fmt <- "[%s -> %s]"
    lhsf <- lhs$Version %||% "*"
    rhsf <- rhs$Version %||% "*"
    return(sprintf(fmt, lhsf, rhsf))
  }

  # if the source has changed, highlight that
  if ("Source" %in% changed) {
    fmt <- "[%s -> %s]"
    lhsf <- renv_record_format_short(lhs)
    rhsf <- renv_record_format_short(rhs)
    return(sprintf(fmt, lhsf, rhsf))
  }

  # otherwise, report each diff individually
  diffs <- map_chr(changed, function(field) {

    lhsf <- lhs[[field]] %||% "*"
    rhsf <- rhs[[field]] %||% "*"

    if (field == "RemoteSha") {
      lhsf <- substring(lhsf, 1L, 8L)
      rhsf <- substring(rhsf, 1L, 8L)
    }

    fmt <- "%s: %s -> %s"
    sprintf(fmt, map[[field]], lhsf, rhsf)
  })

  sprintf("[%s]", paste(diffs, collapse = "; "))

}

renv_records_equal <- function(lhs, rhs) {

  lhs <- reject(lhs, is.null)
  rhs <- reject(rhs, is.null)

  nm <- setdiff(union(names(lhs), names(rhs)), "Hash")
  identical(keep(lhs, nm), keep(rhs, nm))

}

renv_records_resolve <- function(records, latest = FALSE) {

  enumerate(records, function(package, record) {

    # check for already-resolved records
    if (is.null(record) || is.list(record))
      return(record)

    # check for version-only specifications and
    # prepend the package name in such a case
    pattern <- "^(?:[[:digit:]]+[.-]){1,}[[:digit:]]+$"
    if (grepl(pattern, record))
      record <- paste(package, record, sep = "@")

    # resolve the record
    renv_remotes_resolve(record, latest)

  })

}

recurse <- function(object, callback, ...) {
  renv_recurse_impl(list(), object, callback, ...)
}

renv_recurse_impl <- function(stack, object, callback, ...) {

  # ignore missing values
  if (missing(object) || identical(object, quote(expr = )))
    return(FALSE)

  # push node on to stack
  stack[[length(stack) + 1]] <- object

  # invoke callback
  result <- callback(object, stack, ...)
  if (is.call(result))
    object <- result
  else if (identical(result, FALSE))
    return(FALSE)

  # recurse
  if (is.recursive(object))
    for (i in seq_along(object))
      renv_recurse_impl(stack, object[[i]], callback, ...)

}

#' Refresh the Local Cache of Available Packages
#'
#' Query the active R package repositories for available packages, and
#' update the in-memory cache of those packages.
#'
#' Note that \R also maintains its own on-disk cache of available packages,
#' which is used by `available.packages()`. Calling `refresh()` will force
#' an update of both types of caches. `renv` prefers using an in-memory
#' cache as on occasion the temporary directory can be slow to access (e.g.
#' when it is a mounted network filesystem).
#'
#' @return A list of package databases, invisibly -- one for each repository
#'   currently active in the \R session. Note that this function is normally
#'   called for its side effects.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # check available packages
#' db <- available.packages()
#'
#' # wait some time (suppose packages are uploaded / changed in this time)
#' Sys.sleep(5)
#'
#' # refresh the local available packages database
#' # (the old locally cached db will be removed)
#' db <- renv::refresh()
#'
#' }
refresh <- function() {

  dbs <- list()

  if (!renv_platform_linux())
    dbs[["binary"]] <- renv_available_packages("binary", limit = 0L)

  dbs[["source"]] <- renv_available_packages("source", limit = 0L)

  invisible(dbs)

}

renv_regexps_package_name <- function() {
  paste0("^", .standard_regexps()$valid_package_name, "$")
}

renv_regexps_package_version <- function() {
  paste0("^", .standard_regexps()$valid_package_version, "$")
}

renv_regexps_escape <- function(regexp) {
  pattern <- "([\\-\\[\\]\\{\\}\\(\\)\\*\\+\\?\\.\\,\\\\\\^\\$\\|\\#\\s])"
  gsub(pattern, "\\\\\\1", regexp, perl = TRUE)
}

renv_regexps_join <- function(regexps, capture = TRUE) {
  fmt <- if (capture) "(%s)" else "(?:%s)"
  sprintf(fmt, paste(regexps, collapse = "|"))
}

#' Re-Hash Packages in the renv Cache
#'
#' Re-hash packages in the `renv` cache, ensuring that any previously-cached
#' packages are copied to a new cache location appropriate for this version of
#' `renv`. This can be useful if the cache scheme has changed in a new version
#' of `renv`, but you'd like to preserve your previously-cached packages.
#'
#' Any packages which are re-hashed will retain links to the location of the
#' newly-hashed package, ensuring that prior installations of `renv` can still
#' function as expected.
#'
#' @inheritParams renv-params
#'
#' @export
rehash <- function(prompt = interactive(), ...) {
  renv_scope_error_handler()
  renv_dots_check(...)
  invisible(renv_rehash_impl(prompt))
}

renv_rehash_impl <- function(prompt) {

  # check for cache migration
  oldcache <- renv_paths_cache(version = renv_cache_version_previous())[[1L]]
  newcache <- renv_paths_cache(version = renv_cache_version())[[1L]]
  if (file.exists(oldcache) && !file.exists(newcache))
    renv_rehash_cache(oldcache, prompt, renv_file_copy, "copied")

  # re-cache packages as necessary
  renv_rehash_cache(newcache, prompt, renv_file_move, "moved")

}

renv_rehash_cache <- function(cache, prompt, action, label) {

  # re-compute package hashes
  old <- renv_cache_list(cache = cache)

  vprintf("* Re-computing package hashes ... ")
  new <- map_chr(old, renv_progress_callback(renv_cache_path, length(old)))
  vwritef("Done!")

  changed <- which(old != new & file.exists(old) & !file.exists(new))
  if (empty(changed)) {
    vwritef("* Your cache is already up-to-date -- nothing to do.")
    return(TRUE)
  }

  if (prompt) {

    fmt <- "%s [%s -> %s]"
    packages <- basename(old)[changed]
    oldhash <- renv_path_component(old[changed], 2L)
    newhash <- renv_path_component(new[changed], 2L)
    renv_pretty_print(
      sprintf(fmt, format(packages), format(oldhash), format(newhash)),
      "The following packages will be re-cached:",
      sprintf("Packages will be %s to their new locations in the cache.", label),
      wrap = FALSE
    )

    if (prompt && !proceed()) {
      renv_report_user_cancel()
      return(FALSE)
    }

  }

  sources <- old[changed]
  targets <- new[changed]
  names(sources) <- targets
  names(targets) <- sources

  vprintf("* Re-caching packages ... ")
  enumerate(targets, renv_progress_callback(action, length(targets)))
  vwritef("Done!")

  n <- length(targets)
  fmt <- "Successfully re-cached %i %s."
  vwritef(fmt, n, plural("package", n))

  renv_cache_clean_empty()

  TRUE
}

#' Resolve a Remote
#'
#' Given a remote specification, resolve it into an `renv` package record that
#' can be used for download and installation (e.g. with [install]).
#'
#' @param spec A remote specification. This should be a string, conforming
#'   to the Remotes specification as defined in
#'   <https://remotes.r-lib.org/articles/dependencies.html>.
#'
remote <- function(spec) {
  renv_scope_error_handler()
  renv_remotes_resolve(spec)
}

# take a short-form remotes spec, parse that into a remote,
# and generate a corresponding package record
renv_remotes_resolve <- function(spec, latest = FALSE) {

  # check for already-resolved specs
  if (is.null(spec) || is.list(spec))
    return(spec)

  # check for URLs
  if (grepl("^(?:file|https?)://", spec))
    return(renv_remotes_resolve_url(spec, quiet = TRUE))

  # check for paths to existing local files
  first <- substring(spec, 1L, 1L)
  local <- first %in% c("~", "/", ".") || renv_path_absolute(spec)

  if (local) {
    record <- catch(renv_remotes_resolve_path(spec))
    if (!inherits(record, "error"))
      return(record)
  }

  # define error handler (tag error with extra context when possible)
  error <- function(e) {

    # build error message
    fmt <- "failed to resolve remote '%s'"
    prefix <- sprintf(fmt, spec)
    message <- paste(prefix, e$message, sep = " -- ")

    # if the error occurred while running tests, and the error appears
    # to be due to an HTTP error (unauthorized), then just skip instead
    if (renv_tests_running()) {
      unauth <- any(grepl("403", e$message %||% ""))
      if (unauth)
        testthat::skip("Ignoring transient 403 error")
    }

    # otherwise, propagate the error
    stop(simpleError(message = message, call = e$call))

  }

  # attempt the parse
  withCallingHandlers(
    renv_remotes_resolve_impl(spec, latest),
    error = error
  )

}

renv_remotes_resolve_impl <- function(spec, latest = FALSE) {

  remote <- renv_remotes_parse(spec)

  resolved <- switch(
    remote$type,
    bitbucket  = renv_remotes_resolve_bitbucket(remote),
    gitlab     = renv_remotes_resolve_gitlab(remote),
    github     = renv_remotes_resolve_github(remote),
    repository = renv_remotes_resolve_repository(remote, latest),
    git        = renv_remotes_resolve_git(remote),
    url        = renv_remotes_resolve_url(remote$url, quiet = TRUE),
    stopf("unknown remote type '%s'", remote$type %||% "<NA>")
  )

  reject(resolved, is.null)

}

renv_remotes_parse_impl <- function(spec, pattern, fields, perl = FALSE) {

  matches <- regexec(pattern, spec, perl = perl)
  strings <- regmatches(spec, matches)[[1]]
  if (empty(strings))
    stopf("'%s' is not a valid remote", spec)

  if (length(fields) != length(strings))
    stop("internal error: field length mismatch in renv_remotes_parse_impl")

  names(strings) <- fields
  remote <- as.list(strings)
  lapply(remote, function(item) if (nzchar(item)) item)

}

renv_remotes_parse_repos <- function(spec) {

  pattern <- paste0(
    "^",                               # start
    "(?:([^:]+)::)?",                  # optional repository name
    "([[:alnum:].]+)",                 # package name
    "(?:@([[:digit:]_.-]+))?",         # optional package version
    "$"
  )

  fields <- c("spec", "repository", "package", "version")
  renv_remotes_parse_impl(spec, pattern, fields)

}

renv_remotes_parse_remote <- function(spec) {

  pattern <- paste0(
    "^",
    "(?:([^@:]+)(?:@([^:]+))?::)?",    # optional prefix, providing type + host
    "([^/#@:]+)",                      # a username
    "(?:/([^@#:]+))?",                 # a repository (allow sub-repositories)
    "(?::([^@#:]+))?",                 # optional subdirectory
    "(?:#([^@#:]+))?",                 # optional hash (e.g. pull request)
    "(?:@([^@#:]+))?",                 # optional ref (e.g. branch or commit)
    "$"
  )

  fields <- c("spec", "type", "host", "user", "repo", "subdir", "pull", "ref")
  remote <- renv_remotes_parse_impl(spec, pattern, fields)

  if (!nzchar(remote$repo))
    stopf("'%s' is not a valid remote", spec)

  renv_remotes_parse_finalize(remote)

}

renv_remotes_parse_git <- function(spec) {

  hostpattern <- paste0(
    "(",
      "(?:(?:(?!-))(?:xn--|_{1,1})?[a-z0-9-]{0,61}[a-z0-9]{1,1}\\.)*",
      "(?:xn--)?",
      "(?:[a-z0-9][a-z0-9\\-]{0,60}|[a-z0-9-]{1,30}\\.[a-z]{2,})",
    ")"
  )

  pattern <- paste0(
    "^",
    "(?:(git)::)?",                 # optional git prefix
    "(",                            # URL start
      "(?:(https?|git|ssh)://)?",     # protocol
      "(?:([^@]+)@)?",                # login (probably git)
      hostpattern,                    # host
      "[/:]([\\w_.-]+)",              # a username
      "(?:/([^@#:]+?))?",             # a repository (allow sub-repositories)
      "(?:\\.(git))?",                # optional .git extension
    ")",                            # URL end
    "(?::([^@#:]+))?",              # optional sub-directory
    "(?:#([^@#:]+))?",              # optional hash (e.g. pull request)
    "(?:@([^@#:]+))?",              # optional ref (e.g. branch or commit)
    "$"
  )

  fields <- c(
    "spec",
      "type",
      "url",
        "protocol", "login", "host",
        "user", "repo", "ext",
      "subdir",
      "pull",
      "ref"
  )

  remote <- renv_remotes_parse_impl(spec, pattern, fields, perl = TRUE)
  if (!nzchar(remote$repo))
    stopf("'%s' is not a valid remote", spec)

  # If type has not been found & repo looks like a git repo, set it as git
  # (note that this parser also accepts entries which are not truly git
  # references, so we try to "fix up" after the fact)
  if ("git" %in% c(remote$type, remote$ext, remote$protocol))
    remote$type <- tolower(remote$type %||% "git")

  renv_remotes_parse_finalize(remote)

}

# NOTE: to avoid ambiguity with git remote specs, we require URL
# remotes to begin with a 'url::' prefix
renv_remotes_parse_url <- function(spec) {

  pattern <- paste0(
    "^",
    "(url)::",              # type (required for URL remotes)
    "((https?)://([^:]+))", # url, protocol, path
    "(?::([^@#:]+))?",      # optional subdir
    "$"
  )

  fields <- c("spec", "type", "url", "protocol", "path", "subdir")
  remote <- renv_remotes_parse_impl(spec, pattern, fields, perl = TRUE)
  if (!nzchar(remote$url))
    stopf("'%s' is not a valid remote", spec)

  renv_remotes_parse_finalize(remote)
}

renv_remotes_parse_finalize <- function(remote) {

  # default remote type is github
  remote$type <- tolower(remote$type %||% "github")

  # custom finalization for different remote types
  case(
    remote$type == "github" ~ renv_remotes_parse_finalize_github(remote),
    TRUE                    ~ remote
  )

}

renv_remotes_parse_finalize_github <- function(remote) {

  # split repo spec into pieces
  repo <- remote$repo %||% ""
  parts <- strsplit(repo, "/", fixed = TRUE)[[1]]
  if (length(parts) < 2)
    return(remote)

  # form subdir from tail of repo
  remote$repo   <- paste(head(parts, n = 1L),  collapse = "/")
  remote$subdir <- paste(tail(parts, n = -1L), collapse = "/")

  # return modified remote
  remote

}

renv_remotes_parse <- function(spec) {

  remote <- catch(renv_remotes_parse_repos(spec))
  if (!inherits(remote, "error")) {
    remote$type <- "repository"
    return(remote)
  }

  remote <- catch(renv_remotes_parse_remote(spec))
  if (!inherits(remote, "error")) {
    remote$type <- remote$type %||% "github"
    return(remote)
  }

  remote <- catch(renv_remotes_parse_url(spec))
  if (!inherits(remote, "error")) {
    remote$type <- remote$type %||% "url"
    return(remote)
  }

  remote <- catch(renv_remotes_parse_git(spec))
  if (!inherits(remote, "error")) {
    remote$type <- remote$type %||% "git"
    return(remote)
  }

  stopf("failed to parse remote spec '%s'", spec)

}

renv_remotes_resolve_bitbucket <- function(remote) {

  user   <- remote$user
  repo   <- remote$repo
  subdir <- remote$subdir
  ref    <- remote$ref %||% getOption("renv.bitbucket.default_branch", "master")

  host <- remote$host %||% config$bitbucket.host()

  # scope authentication
  renv_scope_auth(repo)

  # get commit sha for ref
  fmt <- "%s/repositories/%s/%s/commit/%s"
  origin <- renv_retrieve_origin(host)
  url <- sprintf(fmt, origin, user, repo, ref)

  destfile <- renv_scope_tempfile("renv-bitbucket-")
  download(url, destfile = destfile, type = "bitbucket", quiet = TRUE)
  json <- renv_json_read(file = destfile)
  sha <- json$hash

  # get DESCRIPTION file
  fmt <- "%s/repositories/%s/%s/src/%s/DESCRIPTION"
  origin <- renv_retrieve_origin(host)
  url <- sprintf(fmt, origin, user, repo, ref)

  destfile <- renv_scope_tempfile("renv-description-")
  download(url, destfile = destfile, type = "bitbucket", quiet = TRUE)
  desc <- renv_dcf_read(destfile)

  list(
    Package        = desc$Package,
    Version        = desc$Version,
    Source         = "Bitbucket",
    RemoteType     = "bitbucket",
    RemoteHost     = host,
    RemoteUsername = user,
    RemoteRepo     = repo,
    RemoteSubdir   = subdir,
    RemoteRef      = ref,
    RemoteSha      = sha
  )

}

renv_remotes_resolve_repository <- function(remote, latest) {

  package <- remote$package
  if (package %in% renv_packages_base())
    return(renv_remotes_resolve_base(package))

  version <- remote$version
  repository <- remote$repository

  if (latest && is.null(version)) {
    remote <- renv_available_packages_latest(package)
    version <- remote$Version
  }

  list(
    Package    = package,
    Version    = version,
    Source     = "Repository",
    Repository = repository
  )

}

renv_remotes_resolve_base <- function(package) {

  list(
    Package = package,
    Version = renv_package_version(package),
    Source  = "R"
  )

}

renv_remotes_resolve_github_sha_pull <- function(host, user, repo, pull) {

  # scope authentication
  renv_scope_auth(repo)

  # make request
  fmt <- "%s/repos/%s/%s/pulls/%s"
  origin <- renv_retrieve_origin(host)
  url <- sprintf(fmt, origin, user, repo, pull)
  jsonfile <- renv_scope_tempfile("renv-json-")
  download(url, destfile = jsonfile, type = "github", quiet = TRUE)

  # read resulting JSON
  json <- renv_json_read(jsonfile)
  json$head$sha

}

renv_remotes_resolve_github_sha_ref <- function(host, user, repo, ref) {

  # scope authentication
  renv_scope_auth(repo)

  # build url for github commits endpoint
  fmt <- "%s/repos/%s/%s/commits/%s"
  origin <- renv_retrieve_origin(host)
  ref <- ref %||% getOption("renv.github.default_branch", default = "master")
  url <- sprintf(fmt, origin, user, repo, ref %||% "master")

  # prepare headers
  headers <- c(Accept = "application/vnd.github.v2.sha")

  # make request to endpoint
  shafile <- renv_scope_tempfile("renv-sha-")
  download(
    url,
    destfile = shafile,
    type = "github",
    quiet = TRUE,
    headers = headers
  )

  # read downloaded content
  sha <- renv_file_read(shafile)

  # check for JSON response (in case our headers weren't sent)
  if (nchar(sha) > 40L) {
    json <- renv_json_read(text = sha)
    sha <- json$sha
  }

  sha

}

renv_remotes_resolve_github_description <- function(host, user, repo, subdir, sha) {

  # form DESCRIPTION path
  subdir <- subdir %||% ""
  parts <- c(
    if (nzchar(subdir)) URLencode(subdir),
    "DESCRIPTION"
  )

  descpath <- paste(parts, collapse = "/")

  # scope authentication
  renv_scope_auth(repo)

  # get the DESCRIPTION contents
  fmt <- "%s/repos/%s/%s/contents/%s?ref=%s"
  origin <- renv_retrieve_origin(host)
  url <- sprintf(fmt, origin, user, repo, descpath, sha)
  jsonfile <- renv_scope_tempfile("renv-json-")
  download(url, destfile = jsonfile, type = "github", quiet = TRUE)
  json <- renv_json_read(jsonfile)
  contents <- renv_base64_decode(json$content)

  # normalize newlines
  contents <- gsub("\r\n", "\n", contents, fixed = TRUE)

  # read as DCF
  renv_dcf_read(text = contents)

}

renv_remotes_resolve_github_ref <- function(host, user, repo) {

  tryCatch(
    renv_remotes_resolve_github_ref_impl(host, user, repo),
    error = function(e) {
      warning(e)
      getOption("renv.github.default_branch", default = "master")
    }
  )

}

renv_remotes_resolve_github_ref_impl <- function(host, user, repo) {

  # scope authentication
  renv_scope_auth(repo)

  # build url to repos endpoint
  fmt <- "%s/repos/%s/%s"
  origin <- renv_retrieve_origin(host)
  url <- sprintf(fmt, origin, user, repo)

  # download JSON data at endpoint
  jsonfile <- renv_scope_tempfile("renv-github-ref-", fileext = ".json")
  download(url, destfile = jsonfile, type = "github", quiet = TRUE)
  json <- renv_json_read(jsonfile)

  # read default branch
  json$default_branch %||% getOption("renv.github.default_branch", default = "master")

}

renv_remotes_resolve_github <- function(remote) {

  # resolve the reference associated with this repository
  host <- remote$host %||% config$github.host()
  user <- remote$user
  repo <- remote$repo
  spec <- remote$spec
  ref  <- remote$ref %||% renv_remotes_resolve_github_ref(host, user, repo)

  # handle '*release' refs
  if (identical(ref, "*release"))
    ref <- renv_remotes_resolve_github_release(host, user, repo, spec)

  # resolve the sha associated with the ref / pull
  pull   <- remote$pull %||% ""
  sha <- case(
    nzchar(pull) ~ renv_remotes_resolve_github_sha_pull(host, user, repo, pull),
    nzchar(ref)  ~ renv_remotes_resolve_github_sha_ref(host, user, repo, ref)
  )

  # if an abbreviated sha was provided as the ref, expand it here
  if (nzchar(ref) && startswith(sha, ref))
    ref <- sha

  # read DESCRIPTION
  subdir <- remote$subdir
  desc <- renv_remotes_resolve_github_description(host, user, repo, subdir, sha)

  list(
    Package        = desc$Package,
    Version        = desc$Version,
    Source         = "GitHub",
    RemoteType     = "github",
    RemoteHost     = host,
    RemoteUsername = user,
    RemoteRepo     = repo,
    RemoteSubdir   = subdir,
    RemoteRef      = ref,
    RemoteSha      = sha
  )

}

renv_remotes_resolve_github_release <- function(host, user, repo, spec) {

  # scope authentication
  renv_scope_auth(repo)

  # build url for github releases endpoint
  fmt <- "%s/repos/%s/%s/releases?per_page=1"
  origin <- renv_retrieve_origin(host)
  url <- sprintf(fmt, origin, user, repo)

  # prepare headers
  headers <- c(Accept = "application/vnd.github.v3+json")

  # make request to endpoint
  releases <- renv_scope_tempfile("renv-releases-")
  download(
    url      = url,
    destfile = releases,
    type     = "github",
    quiet    = TRUE,
    headers  = headers
  )

  # get reference associated with this tag
  json <- renv_json_read(releases)
  if (empty(json)) {
    fmt <- "could not find any releases associated with remote '%s'"
    stopf(fmt, sub("[*]release$", "", spec))
  }

  json[[1L]][["tag_name"]]

}

renv_remotes_resolve_git <- function(remote) {

  package <- remote$repo
  url     <- remote$url
  subdir  <- remote$subdir

  # handle git ref
  pull <- remote$pull %||% ""
  ref  <- remote$ref %||% ""

  # resolve ref from pull if set
  if (nzchar(pull))
    ref <- renv_remotes_resolve_git_pull(ref)

  record <- list(
    Package        = package,
    Version        = "<unknown>",
    Source         = "git",
    RemoteType     = "git",
    RemoteUrl      = url,
    RemoteSubdir   = subdir,
    RemoteRef      = ref
  )

  desc <- renv_remotes_resolve_git_description(record)

  record$Package <- desc$Package
  record$Version <- desc$Version

  record
}


renv_remotes_resolve_git_sha_ref <- function(record) {

  renv_git_preflight()

  origin <- record$RemoteUrl
  ref <- record$RemoteRef %||% record$RemoteSha
  args <- c("ls-remote", origin, ref)

  output <- local({
    renv_scope_auth(record)
    renv_scope_git_auth()
    renv_system_exec("git", args, "checking git remote")
  })

  if (empty(output))
    return("")

  # format of output is, for example:
  #
  #   $ git ls-remote https://github.com/rstudio/renv refs/tags/0.14.0
  #   20ca74bdcc3c87848e5665effa2fc8ee8b039c69        refs/tags/0.14.0
  #
  # take first line of output, split on tab character, and take leftmost entry
  strsplit(output[[1L]], "\t", fixed = TRUE)[[1L]][[1L]]

}


renv_remotes_resolve_git_description <- function(record) {

  path <- tempfile("renv-git-")
  ensure_directory(path)

  # TODO: is there a cheaper way for us to accomplish this?
  # it'd be nice if we could retrieve the contents of a single
  # file, without needing to pull an entire repository branch
  local({
    renv_scope_options(renv.verbose = FALSE)
    renv_retrieve_git_impl(record, path)
  })

  # subdir may be NULL
  subdir <- record$RemoteSubdir
  desc <- renv_description_read(path, subdir = subdir)

  desc
}

renv_remotes_resolve_git_pull <- function(pr) {
  # to be able to checkout PR 760:
  # git fetch origin pull/760/head:pr-760
  # or:
  # git fetch origin pull/760/head:pull/760

  # so format for ref is:
  # pull/{ref_number}/head:pr-{ref_number}
  fmt <- "pull/%s/head:pull/%s"

  remote_ref <- sprintf(fmt, pr, pr)
  remote_ref
}

renv_remotes_resolve_gitlab_ref <- function(host, user, repo) {

  tryCatch(
    renv_remotes_resolve_gitlab_ref_impl(host, user, repo),
    error = function(e) {
      warning(e)
      getOption("renv.gitlab.default_branch", default = "master")
    }
  )

}

renv_remotes_resolve_gitlab_ref_impl <- function(host, user, repo) {

  # scope authentication
  renv_scope_auth(repo)

  # get list of available branches
  fmt <- "%s/api/v4/projects/%s/repository/branches"
  origin <- renv_retrieve_origin(host)
  id <- URLencode(paste(user, repo, sep = "/"), reserved = TRUE)
  url <- sprintf(fmt, origin, id)

  destfile <- renv_scope_tempfile("renv-gitlab-commits-")
  download(url, destfile = destfile, type = "gitlab", quiet = TRUE)
  json <- renv_json_read(file = destfile)

  # iterate through and find the default
  for (info in json)
    if (identical(info$default, TRUE))
      return(info$name)

  # if no default was found, use master branch
  # (for backwards compatibility with existing projects)
  getOption("renv.gitlab.default_branch", default = "master")

}

renv_remotes_resolve_gitlab <- function(remote) {

  host   <- remote$host %||% config$gitlab.host()
  user   <- remote$user
  repo   <- remote$repo
  subdir <- remote$subdir %||% ""

  ref <- remote$ref %||% renv_remotes_resolve_gitlab_ref(host, user, repo)

  parts <- c(if (nzchar(subdir)) subdir, "DESCRIPTION")
  descpath <- URLencode(paste(parts, collapse = "/"), reserved = TRUE)

  # scope authentication
  renv_scope_auth(repo)

  # retrieve sha associated with this ref
  fmt <- "%s/api/v4/projects/%s/repository/commits/%s"
  origin <- renv_retrieve_origin(host)
  id <- URLencode(paste(user, repo, sep = "/"), reserved = TRUE)
  ref <- URLencode(ref, reserved = TRUE)
  url <- sprintf(fmt, origin, id, ref)

  destfile <- renv_scope_tempfile("renv-gitlab-commits-")
  download(url, destfile = destfile, type = "gitlab", quiet = TRUE)
  json <- renv_json_read(file = destfile)
  sha <- json$id

  # retrieve DESCRIPTION file
  fmt <- "%s/api/v4/projects/%s/repository/files/%s/raw?ref=%s"
  origin <- renv_retrieve_origin(host)
  id <- URLencode(paste(user, repo, sep = "/"), reserved = TRUE)
  url <- sprintf(fmt, origin, id, descpath, ref)

  destfile <- renv_scope_tempfile("renv-description-")
  download(url, destfile = destfile, type = "gitlab", quiet = TRUE)
  desc <- renv_dcf_read(destfile)

  list(
    Package        = desc$Package,
    Version        = desc$Version,
    Source         = "GitLab",
    RemoteType     = "gitlab",
    RemoteHost     = host,
    RemoteUsername = user,
    RemoteRepo     = repo,
    RemoteSubdir   = subdir,
    RemoteRef      = ref,
    RemoteSha      = sha
  )

}

renv_remotes_resolve_url <- function(url, quiet = FALSE) {

  tempfile <- renv_scope_tempfile("renv-url-")
  writeLines(url, con = tempfile)
  hash <- tools::md5sum(tempfile)

  ext <- fileext(url, default = ".tar.gz")
  name <- paste(hash, ext, sep = "")
  path <- renv_paths_source("url", name)

  ensure_parent_directory(path)
  download(url, path, quiet = quiet)

  desc <- renv_description_read(path)

  list(
    Package    = desc$Package,
    Version    = desc$Version,
    Source     = "URL",
    RemoteType = "url",
    RemoteUrl  = url,
    Path       = path
  )

}

renv_remotes_resolve_path <- function(path) {

  # if this package lives within one of the cellar paths,
  # then treat it as a cellar source
  roots <- renv_cellar_roots()
  for (root in roots)
    if (renv_path_within(path, root))
      return(renv_remotes_resolve_path_cellar(path))

  # first, check for a common extension
  if (renv_archive_type(path) %in% c("tar", "zip"))
    return(renv_remotes_resolve_path_impl(path))

  # otherwise, if this is the path to a package project, use the sources as-is
  if (renv_project_type(path) == "package")
    return(renv_remotes_resolve_path_impl(path))

  stopf("there is no package at path '%s'", path)

}

renv_remotes_resolve_path_cellar <- function(path) {

  desc <- renv_description_read(path)
  list(
    Package    = desc$Package,
    Version    = desc$Version,
    Source     = "Cellar",
    Cacheable  = FALSE
  )

}

renv_remotes_resolve_path_impl <- function(path) {

  desc <- renv_description_read(path)
  list(
    Package    = desc$Package,
    Version    = desc$Version,
    Source     = "Local",
    RemoteType = "local",
    RemoteUrl  = path,
    Cacheable  = FALSE
  )

}

#' Remove Packages
#'
#' Remove (uninstall) \R packages.
#'
#' @inherit renv-params
#'
#' @param packages A character vector of \R packages to remove.
#' @param library The library from which packages should be removed. When
#'   `NULL`, the active library (that is, the first entry reported in
#'   `.libPaths()`) is used instead.
#'
#' @return A vector of package records, describing the packages (if any) which
#'   were successfully removed.
#'
#' @export
#'
#' @example examples/examples-init.R
remove <- function(packages,
                   ...,
                   library = NULL,
                   project = NULL)
{
  renv_scope_error_handler()
  renv_dots_check(...)

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  library <- renv_path_normalize(library %||% renv_libpaths_default())

  descpaths <- file.path(library, packages, "DESCRIPTION")
  records <- lapply(descpaths, renv_snapshot_description)
  names(records) <- packages
  records <- Filter(function(record) !inherits(record, "error"), records)

  if (library == renv_paths_library(project = project)) {
    vwritef("* Removing package(s) from project library ...")
  } else {
    fmt <- "* Removing package(s) from library '%s' ..."
    vwritef(fmt, aliased_path(library))
  }

  if (length(packages) == 1) {
    renv_remove_impl(packages, library)
    return(invisible(records))
  }

  count <- 0
  for (package in packages) {
    if (renv_remove_impl(package, library))
      count <- count + 1
  }

  vwritef("* Done! Removed %i %s.", count, plural("package", count))
  invisible(records)
}

renv_remove_impl <- function(package, library) {

  path <- file.path(library, package)
  if (!renv_file_exists(path)) {
    vwritef("* Package '%s' is not installed -- nothing to do.", package)
    return(FALSE)
  }

  recursive <- renv_file_type(path) == "directory"
  vprintf("Removing package '%s' ... ", package)
  unlink(path, recursive = recursive)
  vwritef("Done!")

  TRUE

}

#' Project-local Environments for R
#'
#' Project-local environments for \R.
#'
#' You can use `renv` to construct isolated, project-local \R libraries.
#' Each project using `renv` will share package installations from a global
#' cache of packages, helping to avoid wasting disk space on multiple
#' installations of a package that might otherwise be shared across projects.
#'
"_PACKAGE"

# given a path within a project, read all relevant ignore files
# and generate a pattern that can be used to filter file results
renv_renvignore_pattern <- function(path = getwd(), root = path) {

  if (is.null(root))
    return(NULL)

  stopifnot(
    renv_path_absolute(path),
    renv_path_absolute(root)
  )

  # prepare ignores
  ignores <- stack()

  # read ignore files
  parent <- path
  while (parent != dirname(parent)) {

    # attempt to read either .renvignore or .gitignore
    for (file in c(".renvignore", ".gitignore")) {
      candidate <- file.path(parent, file)
      if (file.exists(candidate)) {
        contents <- readLines(candidate, warn = FALSE)
        parsed <- renv_renvignore_parse(contents, parent)
        if (length(parsed))
          ignores$push(parsed)
        break
      }
    }

    # stop once we've hit the project root
    if (parent == root)
      break

    parent <- dirname(parent)

  }

  # collect patterns read
  patterns <- ignores$data()

  # separate exclusions, exclusions
  include <- unlist(extract(patterns, "include"))
  exclude <- unlist(extract(patterns, "exclude"))

  # allow for inclusion / exclusion via option
  # (primarily intended for internal use with packrat)
  include <- c(include, renv_renvignore_pattern_extra("include", root))
  exclude <- c(exclude, renv_renvignore_pattern_extra("exclude", root))

  # ignore hidden directories by default
  exclude <- c("/[.][^/]*/$", exclude)

  list(include = include, exclude = exclude)

}

# reads a .gitignore / .renvignore file, and translates the associated
# entries into PCREs which can be combined and used during directory traversal
renv_renvignore_parse <- function(contents, prefix = "") {

  # read the ignore entries
  contents <- grep("^\\s*(?:#|$)", contents, value = TRUE, invert = TRUE)
  if (empty(contents))
    return(list())

  # split into inclusion, exclusion patterns
  negate <- substring(contents, 1L, 1L) == "!"
  exclude <- contents[!negate]
  include <- substring(contents[negate], 2L)

  # For include rules, if we're explicitly including a file within
  # a sub-directory, then we need to force all parent directories
  # to also be included. In other words, a rule like:
  #
  #    !a/b/c
  #
  # needs to be implicitly treated like
  #
  #    !/a
  #    !/a/b
  #    !/a/b/c
  #
  # so we perform that transformation here.
  #
  # Note that this isn't perfect; for example, with the .gitignore file
  #
  #    dir
  #    !dir/matched
  #
  # The exclusion of 'dir' will take precedence, and dir/matched won't
  # get a chance to apply.
  include <- sort(unique(unlist(map(include, function(rule) {
    idx <- gregexpr("(?:/|$)", rule, perl = TRUE)[[1L]]
    gsub("^/*", "/", substring(rule, 1L, idx))
  }))))

  # parse patterns separately
  list(
    exclude = renv_renvignore_parse_impl(exclude, prefix),
    include = renv_renvignore_parse_impl(include, prefix)
  )

}

renv_renvignore_parse_impl <- function(entries, prefix = "") {

  # check for empty entries list
  if (empty(entries))
    return(character())

  # remove trailing whitespace
  entries <- gsub("\\s+$", "", entries)

  # entries without a slash (other than a trailing one) should match in tree
  noslash <- grep("/", gsub("/*$", "", entries), fixed = TRUE, invert = TRUE)
  entries[noslash] <- paste("**", entries[noslash], sep = "/")

  # remove a leading slash (avoid double-slashing)
  entries <- gsub("^/+", "", entries)

  # save any '**' entries seen
  entries <- gsub("**/",  "\001", entries, fixed = TRUE)
  entries <- gsub("/**",  "\002", entries, fixed = TRUE)

  # transform '*' and '?'
  entries <- gsub("*", "\\E[^/]*\\Q", entries, fixed = TRUE)
  entries <- gsub("?", "\\E[^/]\\Q",  entries, fixed = TRUE)

  # restore '**' entries
  entries <- gsub("\001", "\\E(?:.*/)?\\Q", entries, fixed = TRUE)
  entries <- gsub("\002", "/\\E.*\\Q",      entries, fixed = TRUE)

  # if we don't have a trailing slash, then we can match both files and dirs
  noslash <- grep("/$", entries, invert = TRUE)
  entries[noslash] <- paste0(entries[noslash], "\\E(?:/)?\\Q")

  # enclose in \\Q \\E to ensure e.g. plain '.' are not treated
  # as regex characters
  entries <- sprintf("\\Q%s\\E$", entries)

  # prepend prefix
  entries <- sprintf("^\\Q%s/\\E%s", prefix, entries)

  # remove \\Q\\E
  entries <- gsub("\\Q\\E", "", entries, fixed = TRUE)

  # all done!
  entries

}

renv_renvignore_exec <- function(path, root, children) {

  # the root directory is always included
  if (identical(root, children))
    return(FALSE)

  # compute exclusion patterns
  patterns <- renv_renvignore_pattern(path, root)

  # if we have no patterns, then we're not excluding anything
  if (empty(patterns) || empty(patterns$exclude))
    return(logical(length(children)))

  # append slashes to files which are directories
  info <- renv_file_info(children)
  dirs <- info$isdir %in% TRUE
  children[dirs] <- paste0(children[dirs], "/")

  # get the entries that need to be excluded
  excludes <- logical(length = length(children))
  for (pattern in patterns$exclude)
    if (nzchar(pattern))
      excludes <- excludes | grepl(pattern, children, perl = TRUE)

  if (length(patterns$include)) {

    # check for entries that should be explicitly included
    # (note that these override any excludes)
    includes <- logical(length = length(children))
    for (pattern in patterns$include)
      if (nzchar(pattern))
        includes <- includes | grepl(pattern, children, perl = TRUE)

    # unset those excludes
    excludes[includes] <- FALSE

  }

  # return vector of excludes
  excludes

}

renv_renvignore_pattern_extra <- function(key, root) {

  # check for value from option
  optname <- paste("renv.renvignore", key, sep = ".")
  patterns <- getOption(optname)
  if (is.null(patterns))
    return(NULL)

  # should we use the pattern as-is?
  asis <- attr(patterns, "asis", exact = TRUE)
  if (identical(asis, TRUE))
    return(patterns)

  # otherwise, process it as an .renvignore-style ignore
  root <- attr(patterns, "root", exact = TRUE) %||% root
  patterns <- renv_renvignore_parse(patterns, root)
  patterns[[key]]

}

#' Repair a Project Library
#'
#' Repair a project library whose cache symlinks have become broken.
#' `renv` will attempt to reinstall the requisite packages.
#'
#' @inheritParams renv-params
#'
#' @param lockfile The path to a lockfile (if any). When available, `renv`
#'   will use the lockfile when attempting to infer the remote associated
#'   with the inaccessible version of each missing package.
#'
#' @export
repair <- function(library  = NULL,
                   lockfile = NULL,
                   project  = NULL)
{
  renv_consent_check()
  renv_scope_error_handler()

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  libpaths <- renv_path_normalize(library %||% renv_libpaths_all())
  library <- libpaths[[1L]]

  # figure out which library paths (junction points?) appear to be broken
  paths <- list.files(library, full.names = TRUE)
  broken <- renv_file_broken(paths)
  packages <- basename(paths[broken])
  if (empty(packages)) {
    fmt <- "* The project library has no broken links -- nothing to do."
    vwritef(fmt)
    return(invisible(packages))
  }

  # try to find records for these packages in the lockfile
  records <- renv_repair_records(packages, lockfile, project)

  # install these records
  install(
    packages = records,
    library  = library,
    project  = project
  )
}

renv_repair_records <- function(packages, lockfile, project) {

  lockfile <- lockfile %||% renv_paths_lockfile(project = project)
  lockfile <- renv_lockfile_resolve(lockfile)
  if (is.null(lockfile))
    return(packages)

  map(packages, function(package) {
    lockfile$Packages[[package]] %||% package
  })

}

renv_report_user_cancel <- function() {
  message("* Operation canceled.")
  renv_snapshot_auto_suppress_next()
}

renv_repos_encode <- function(x) {
  if (length(x) == 1)
    paste(names(x), as.character(x), sep = "=")
  else
    paste(sprintf("\n\t%s=%s", names(x), as.character(x)), collapse = "")
}

renv_repos_decode <- function(x) {
  parts <- strsplit(trimws(x), "(?:,|\\s)+")[[1]]
  idx <- regexpr("=", parts, fixed = TRUE)
  keys <- substring(parts, 1, idx - 1)
  vals <- substring(parts, idx + 1)
  as.list(named(trimws(vals), trimws(keys)))
}

renv_repos_init_callback <- function(...) {

  # bail unless opted in
  config <- renv_config_get("eager.repos", default = FALSE)
  if (!identical(config, TRUE))
    return(FALSE)

  # write required data to file
  file <- tempfile("renv-repos-", fileext = ".rds")
  data <- list(repos = getOption("repos"), type = renv_package_pkgtypes())
  saveRDS(data, file = file, version = 2L)

  # invoke helper script
  script <- system.file("resources/scripts-repos-cache.R", package = "renv")
  args <- c(
    "--vanilla", "-s",
    "-f", renv_shell_path(script),
    "--args", renv_shell_path(file), renv_shell_path(tempdir())
  )

  system2(R(), args, stdout = FALSE, stderr = FALSE, wait = FALSE)
  return(FALSE)

}

renv_repos_normalize <- function(repos = getOption("repos")) {

  # ensure repos are a character vector
  repos <- convert(repos, "character")

  # force a CRAN mirror when needed
  cran <- getOption("renv.repos.cran", "https://cloud.r-project.org")
  repos[repos == "@CRAN@"] <- cran

  # if repos is length 1 but has no names, then assume it's CRAN
  nms <- names(repos) %||% rep.int("", length(repos))
  if (identical(nms, ""))
    nms <- names(repos) <- "CRAN"

  # ensure all values are named
  unnamed <- !nzchar(nms)
  if (any(unnamed)) {
    nms[unnamed] <- paste0("V", seq_len(sum(unnamed)))
    names(repos) <- nms
  }

  # return normalized repository
  repos

}

renv_repos_validate <- function(repos = getOption("repos")) {

  # allow empty repository explicitly
  if (empty(repos))
    return(character())

  # otherwise, ensure it's a named list or character vector
  ok <- is.list(repos) || is.character(repos)
  if (!ok)
    stopf("repos has unexpected type '%s'", typeof(repos))

  # read repository names
  nm <- names(repos) %||% rep.int("", length(repos))
  if (any(nm %in% "")) {

    # if this is a length-one repository, assume it's CRAN
    if (length(repos) == 1L) {
      repos <- c(CRAN = repos)
      return(renv_repos_normalize(repos))
    }

    # otherwise, error
    stopf("all repository entries must be named")

  }

  # normalize the repos option
  renv_repos_normalize(repos)

}

renv_restart_request <- function(project, reason, ...) {

  # if we're running in RStudio, explicitly open the project
  # if it differs from the current project
  if (renv_rstudio_available()) {
    status <- renv_restart_request_rstudio(project, reason, ...)
    return(invisible(status))
  }

  renv_restart_request_default(project, reason, ...)

}

renv_restart_request_default <- function(project, reason, ...) {

  # use 'restart' helper defined by front-end (if any)
  restart <- getOption("restart")
  if (is.function(restart))
    return(invisible(restart()))

  # otherwise, ask the user to restart
  if (interactive()) {
    fmt <- "* %s -- please restart the R session."
    vwritef(fmt, sprintf(reason, ...), con = stderr())
  }

}

renv_restart_request_rstudio <- function(project, reason, ...) {

  # if we're running tests, don't restart
  if (renv_tests_running())
    return(renv_restart_request_default(project, reason, ...))

  # if we don't have a tools env, bail
  tools <- catch(as.environment("tools:rstudio"))
  if (inherits(tools, "error"))
    return(renv_restart_request_default(project, reason, ...))

  # if RStudio is too old, use default restart impl
  old <-
    is.null(tools$.rs.getProjectDirectory) ||
    is.null(tools$.rs.api.openProject)

  if (old)
    return(renv_restart_request_default(project, reason, ...))

  # if the requested project matches the current project, just
  # restart the R session
  projdir <- tools$.rs.getProjectDirectory() %||% ""
  if (renv_file_same(projdir, project)) {
    restart <- getOption("restart")
    if (is.function(restart))
      return(restart())
  }

  # otherwise, explicitly open the new project
  tools$.rs.api.openProject(project, newSession = FALSE)

}

#' Restore a Project
#'
#' Restore a project's dependencies from a lockfile, as previously generated by
#' [snapshot()].
#'
#' @section Package Repositories:
#'
#' By default, the package repositories encoded in the lockfile will be used
#' during restore, as opposed to the repositories that might already
#' be set in the current session (through `getOption("repos")`). If you'd like
#' to override the repositories used by `renv` during restore, you can use,
#' for example:
#'
#' ```
#' renv::restore(repos = c(CRAN = <...>))
#' ```
#'
#' See also the `repos.override` option in [config] for an alternate way to
#' provide a repository override.
#'
#' @inherit renv-params
#'
#' @param library The library paths to be used during restore. See **Library**
#'   for details.
#'
#' @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 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 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`.
#'
#' @section Library:
#'
#' When `renv::restore()` is called, packages from the lockfile are compared
#' against packages currently installed in the library paths specified by
#' `library`. Any packages which have changed will then be installed into the
#' default library. If `clean = TRUE`, then packages that exist within the
#' default library, but aren't recorded in the lockfile, will be removed as
#' well.
#'
#' @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,
                    prompt   = interactive())
{
  renv_consent_check()
  renv_scope_error_handler()
  renv_dots_check(...)

  project  <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  renv_activate_prompt("restore", library, prompt, project)

  if (renv_package_checking())
    renv_patch_repos()

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

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

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

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

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

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

  # set up Bioconductor version + repositories
  biocversion <- lockfile$Bioconductor$Version
  if (!is.null(biocversion)) {
    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
  difflocs <- map_chr(names(diff), function(package) {
    find.package(package, lib.loc = libpaths, quiet = TRUE) %||% ""
  })

  diff <- diff[!(diff == "remove" & dirname(difflocs) != library)]

  # 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"
    vwritef("* The %s is already synchronized with the lockfile.", name)
    return(renv_restore_successful(diff, prompt, project))
  }

  if (!renv_restore_preflight(project, libpaths, diff, current, lockfile, prompt)) {
    renv_report_user_cancel()
    return(FALSE)
  }

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

  if (prompt && !proceed()) {
    renv_report_user_cancel()
    return(invisible(diff))
  }

  # 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_default(),
    records  = renv_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 <- retrieve(packages)
  renv_install_impl(records)

  # detect dependency tree repair
  diff <- renv_lockfile_diff_packages(renv_records(lockfile), records)
  diff <- diff[diff != "remove"]
  if (!empty(diff)) {
    renv_pretty_print_records(
      records[names(diff)],
      "The dependency tree was repaired during package installation:",
      "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_debug <- function() {

  state <- renv_restore_state()
  if (is.null(state)) {
    writeLines("renv_restore_state(): NULL")
    return()
  }

  writeLines("renv_restore_state()")
  data <- renv_envir_unwrap(state)
  data$install <- data$install$data()
  str(data)

}

renv_restore_state <- function(key = NULL) {
  state <- renv_global_get("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)
  )

  state <- renv_global_get("restore.state")
  renv_global_set("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 = packages,

    # an optional handler, to be used during retrieve / restore
    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 = stack(),

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

  ))

  state
}

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

# nocov start

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

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

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

}

# 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 <- function(project, libpaths, actions, current, lockfile, prompt) {
  records <- renv_records(lockfile)
  matching <- keep(records, names(actions))
  renv_install_preflight(project, libpaths, matching, prompt)
}

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) {
  renv_python_restore(project, prompt)
  invisible(records)
}

`_renv_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) {

  # confirm that we have restore state set up
  state <- renv_restore_state()
  if (is.null(state))
    stopf("renv_restore_begin() must be called first")

  # normalize repositories (ensure @CRAN@ is resolved)
  options(repos = renv_repos_normalize())

  # transform repository URLs for RSPM
  if (renv_rspm_enabled()) {
    repos <- getOption("repos")
    renv_scope_options(repos = renv_rspm_transform(repos))
  }

  # ensure HTTPUserAgent is set (required for RSPM binaries)
  agent <- renv_http_useragent()
  if (!grepl("renv", agent)) {
    renv <- sprintf("renv (%s)", renv_package_version("renv"))
    agent <- paste(renv, agent, sep = "; ")
  }
  renv_scope_options(HTTPUserAgent = agent)

  # TODO: parallel?
  handler <- state$handler
  for (package in packages)
    handler(package, renv_retrieve_impl(package))

  state <- renv_restore_state()
  data <- state$install$data()
  names(data) <- extract_chr(data, "Package")
  data

}

renv_retrieve_impl <- function(package) {

  # skip packages with 'base' priority
  if (package %in% renv_packages_base())
    return()

  # if we've already attempted retrieval of this package, skip
  state <- renv_restore_state()
  if (visited(package, envir = state$retrieved))
    return()

  # extract record for package
  records <- state$records
  record <- records[[package]] %||% renv_retrieve_missing_record(package)

  # normalize the record source
  source <- renv_record_source(record, normalize = TRUE)

  # don't install packages from incompatible OS
  ostype <- tolower(record[["OS_type"]] %||% "")

  skip <-
    renv_platform_unix() && identical(ostype, "windows") ||
    renv_platform_windows() && identical(ostype, "unix")

  if (skip)
    return()

  # if this is a package from Bioconductor, activate those repositories now
  if (source %in% c("bioconductor")) {
    project <- renv_restore_state(key = "project")
    renv_scope_bioconductor(project = project)
  }

  # if this is a package from R-Forge, activate its repository
  if (source %in% c("repository")) {
    repository <- record$Repository %||% ""
    if (tolower(repository) %in% c("rforge", "r-forge")) {
      repos <- getOption("repos")
      if (!"R-Forge" %in% names(repos)) {
        repos[["R-Forge"]] <- "https://R-Forge.R-project.org"
        renv_scope_options(repos = repos)
      }
    }
  }

  # if the record doesn't declare the package version,
  # treat it as a request for the latest version on CRAN
  # TODO: should make this behavior configurable
  uselatest <-
    source %in% c("repository", "bioconductor") &&
    is.null(record$Version)

  if (uselatest) {
    record <- renv_available_packages_latest(package)
    if (is.null(record)) {
      stopf("package '%s' is not available", package)
      return()
    }
  }

  # if the requested record is incompatible with the set
  # of requested package versions thus far, request the
  # latest version on the R package repositories
  #
  # TODO: handle more explicit dependency requirements
  # TODO: report to the user if they have explicitly requested
  # installation of this package version despite it being incompatible
  compat <- renv_retrieve_incompatible(package, record)
  if (NROW(compat)) {

    # get the latest available package version
    replacement <- renv_available_packages_latest(package)
    if (is.null(replacement))
      stopf("package '%s' is not available", package)

    # if it's not compatible, then we might need to try again with
    # a source version (assuming type = "both")
    pkgtype <- getOption("pkgType")
    if (identical(pkgtype, "both")) {
      iscompat <- renv_retrieve_incompatible(package, replacement)
      if (NROW(iscompat)) {
        replacement <- renv_available_packages_latest(package, type = "source")
      }
    }

    # report if we couldn't find a compatible package
    renv_retrieve_incompatible_report(package, record, replacement, compat)
    record <- replacement

  }

  if (!renv_restore_rebuild_required(record)) {

    # if we have an installed package matching the requested record, finish early
    path <- renv_restore_find(package, record)
    if (file.exists(path))
      return(renv_retrieve_successful(record, path, install = FALSE))

    # if the requested record already exists in the cache,
    # we'll use that package for install
    cacheable <-
      renv_cache_config_enabled(project = state$project) &&
      renv_record_cacheable(record)

    if (cacheable) {

      # try to find the record in the cache
      path <- renv_cache_find(record)
      if (renv_cache_package_validate(path))
        return(renv_retrieve_successful(record, path))
    }

  }

  # if this is a URL source, then it should already have a local path
  path <- record$Path %||% record$Source %||% ""
  if (grepl("[/\\]", path) && file.exists(path)) {
    path <- normalizePath(path, winslash = "/", mustWork = TRUE)
    return(renv_retrieve_successful(record, path))
  }

  if (!renv_restore_rebuild_required(record)) {

    # try some early shortcut methods
    shortcuts <- c(
      renv_retrieve_explicit,
      renv_retrieve_cellar,
      if (!renv_tests_running() && config$install.shortcuts())
        renv_retrieve_libpaths
    )

    for (shortcut in shortcuts) {
      retrieved <- catch(shortcut(record))
      if (identical(retrieved, TRUE))
        return(TRUE)
    }

  }

  # time to retrieve -- delegate based on previously-determined source
  switch(source,
         bioconductor = renv_retrieve_bioconductor(record),
         bitbucket    = renv_retrieve_bitbucket(record),
         git          = renv_retrieve_git(record),
         github       = renv_retrieve_github(record),
         gitlab       = renv_retrieve_gitlab(record),
         repository   = renv_retrieve_repos(record),
         url          = renv_retrieve_url(record),
         renv_retrieve_unknown_source(record)
  )

}

renv_retrieve_name <- function(record, type = "source", ext = NULL) {
  package <- record$Package
  version <- record$RemoteSha %||% record$Version
  ext <- ext %||% renv_package_ext(type)
  sprintf("%s_%s%s", package, version, ext)
}

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)

  # check for packages from an RSPM binary URL, and
  # update the package type if known
  if (renv_rspm_enabled()) {
    url <- attr(record, "url")
    if (is.character(url) && grepl("/__[^_]+__/", url))
      type <- "binary"
  }

  # form path for package to be downloaded
  if (type == "source")
    renv_paths_source(source, package, name)
  else if (type == "binary")
    renv_paths_binary(source, package, name)
  else
    stopf("unrecognized type '%s'", type)
}

renv_retrieve_bioconductor <- function(record) {

  # try to read the bioconductor version from the record
  version <- renv_retrieve_bioconductor_version(record)

  # activate Bioconductor repositories in this context
  project <- renv_restore_state(key = "project")
  renv_scope_bioconductor(project = project, version = version)

  # retrieve record using updated repositories
  renv_retrieve_repos(record)

}

renv_retrieve_bioconductor_version <- function(record) {

  # read git branch
  branch <- record[["git_branch"]]
  if (is.null(branch))
    return(NULL)

  # try and parse version
  parts <- strsplit(branch, "_", fixed = TRUE)[[1L]]
  ok <-
    length(parts) == 3L &&
    tolower(parts[[1L]]) == "release"

  if (!ok)
    return(NULL)

  # we have a version; use it
  paste(tail(parts, n = -1L), collapse = ".")

}

renv_retrieve_bitbucket <- function(record) {

  # query repositories endpoint to find download URL
  host <- record$RemoteHost %||% config$bitbucket.host()
  origin <- renv_retrieve_origin(host)
  username <- record$RemoteUsername
  repo <- record$RemoteRepo

  # scope authentication
  renv_scope_auth(repo)

  fmt <- "%s/repositories/%s/%s"
  url <- sprintf(fmt, origin, username, repo)

  destfile <- renv_scope_tempfile("renv-bitbucket-")
  download(url, destfile = destfile, quiet = TRUE)
  json <- renv_json_read(destfile)

  # now build URL to tarball
  base <- json$links$html$href
  ref <- record$RemoteSha %||% record$RemoteRef

  fmt <- "%s/get/%s.tar.gz"
  url <- sprintf(fmt, base, ref)

  path <- renv_retrieve_path(record)

  renv_retrieve_package(record, url, path)

}

renv_retrieve_github <- function(record) {

  host <- record$RemoteHost %||% config$github.host()
  origin <- renv_retrieve_origin(host)
  username <- record$RemoteUsername
  repo <- record$RemoteRepo
  ref <- record$RemoteSha %||% record$RemoteRef

  if (is.null(ref)) {
    fmt <- "GitHub record for package '%s' has no recorded 'RemoteSha' / 'RemoteRef'"
    stopf(fmt, record$Package)
  }

  fmt <- "%s/repos/%s/%s/tarball/%s"
  url <- with(record, sprintf(fmt, origin, username, repo, ref))
  path <- renv_retrieve_path(record)
  renv_retrieve_package(record, url, path)

}

renv_retrieve_gitlab <- function(record) {

  host <- record$RemoteHost %||% config$gitlab.host()
  origin <- renv_retrieve_origin(host)

  user <- record$RemoteUsername
  repo <- record$RemoteRepo
  id <- URLencode(paste(user, repo, sep = "/"), reserved = TRUE)

  fmt <- "%s/api/v4/projects/%s/repository/archive.tar.gz"
  url <- sprintf(fmt, origin, id)
  path <- renv_retrieve_path(record)

  sha <- record$RemoteSha %||% record$RemoteRef
  if (!is.null(sha))
    url <- paste(url, paste("sha", sha, sep = "="), sep = "?")

  renv_retrieve_package(record, url, path)

}

renv_retrieve_git <- function(record) {
  path <- tempfile("renv-git-")
  ensure_directory(path)
  renv_retrieve_git_impl(record, path)
  renv_retrieve_successful(record, path)
}

renv_retrieve_git_impl <- function(record, path) {

  renv_git_preflight()

  package <- record$Package
  url     <- record$RemoteUrl
  ref     <- record$RemoteRef
  sha     <- record$RemoteSha

  # figure out the default ref
  gitref <- case(
    nzchar(sha %||% "") ~ sha,
    nzchar(ref %||% "") ~ ref,
    "HEAD"
  )

  # be quiet if requested
  quiet <- getOption("renv.git.quiet", default = TRUE)
  quiet <- if (quiet) "--quiet" else ""

  template <- heredoc('
    cd "${DIR}"
    git init ${QUIET}
    git remote add origin "${ORIGIN}"
    git fetch ${QUIET} --depth=1 origin "${REF}"
    git reset ${QUIET} --hard FETCH_HEAD
  ')

  data <- list(
    DIR    = renv_path_normalize(path),
    ORIGIN = url,
    REF    = gitref,
    QUIET  = quiet
  )

  commands <- renv_template_replace(template, data)
  command <- gsub("\n", " && ", commands, fixed = TRUE)
  if (renv_platform_windows())
    command <- paste(comspec(), "/C", command)

  vwritef("Cloning '%s' ...", url)

  before <- Sys.time()

  status <- local({
    renv_scope_auth(record)
    renv_scope_git_auth()
    system(command)
  })

  after <- Sys.time()

  if (status != 0L) {
    fmt <- "error cloning '%s' from '%s' [status code %i]"
    stopf(fmt, package, url, status)
  }

  fmt <- "\tOK [cloned repository in %s]"
  vwritef(fmt, renv_difftime_format(after - before))

  TRUE

}


renv_retrieve_cellar_find <- function(record, project = NULL) {

  project <- renv_project_resolve(project)

  # packages installed with 'remotes::install_local()' will
  # have a RemoteUrl entry that we can use
  url <- record$RemoteUrl %||% ""
  if (file.exists(url)) {
    path <- renv_path_normalize(url, winslash = "/", mustWork = TRUE)
    type <- if (fileext(path) %in% c(".tgz", ".zip")) "binary" else "source"
    return(named(path, type))
  }

  # otherwise, look in the cellar
  roots <- renv_cellar_roots(project)
  for (type in c("binary", "source")) {

    name <- renv_retrieve_name(record, type = type)
    for (root in roots) {

      package <- record$Package
      paths <- c(
        file.path(root, package, name),
        file.path(root, name)
      )

      for (path in paths)
        if (file.exists(path))
          return(named(path, type))

    }
  }

  fmt <- "%s [%s] is not available locally"
  stopf(fmt, record$Package, record$Version)

}

renv_retrieve_cellar_report <- function(record) {

  source <- renv_record_source(record)
  if (source == "cellar")
    return(record)

  fmt <- "* Package %s [%s] will be installed from the cellar."
  with(record, vwritef(fmt, Package, Version))

  record

}

renv_retrieve_cellar <- function(record) {
  source <- renv_retrieve_cellar_find(record)
  record <- renv_retrieve_cellar_report(record)
  renv_retrieve_successful(record, source)
}

renv_retrieve_libpaths <- function(record) {

  libpaths <- c(renv_libpaths_user(), renv_libpaths_site())
  for (libpath in libpaths)
    if (renv_retrieve_libpaths_impl(record, libpath))
      return(TRUE)

}

renv_retrieve_libpaths_impl <- function(record, libpath) {

  # form path to installed package's DESCRIPTION
  path <- file.path(libpath, record$Package)
  if (!file.exists(path))
    return(FALSE)

  # read DESCRIPTION
  desc <- renv_description_read(path = path)

  # check if it's compatible with the requested record
  fields <- c("Package", "Version", grep("^Remote", names(record), value = TRUE))
  compatible <- identical(record[fields], desc[fields])
  if (!compatible)
    return(FALSE)

  # check that it was built for a compatible version of R
  built <- desc[["Built"]]
  if (is.null(built))
    return(FALSE)

  ok <- catch(renv_description_built_version(desc))
  if (!identical(ok, TRUE))
    return(FALSE)

  # check that this package has a known source
  source <- renv_snapshot_description_source(desc)
  if (identical(source$Source, "unknown"))
    return(FALSE)

  # OK: copy this package as-is
  renv_retrieve_successful(record, path)

}

renv_retrieve_explicit <- function(record) {

  # try parsing as a local remote
  source <- record$Path %||% record$RemoteUrl %||% ""
  resolved <- catch(renv_remotes_resolve_path(source))
  if (inherits(resolved, "error"))
    return(FALSE)

  # treat as 'local' source but extract path
  normalized <- renv_path_normalize(source, winslash = "/", mustWork = TRUE)
  resolved$Source <- "Local"
  renv_retrieve_successful(resolved, normalized)

}

renv_retrieve_repos <- function(record) {

  # if this record is tagged with a type + url, we can
  # use that directly for retrieval
  if (all(c("type", "url") %in% names(attributes(record))))
    return(renv_retrieve_repos_impl(record))

  # figure out what package sources are okay to use here
  pkgtype <- getOption("pkgType", default = "source")

  srcok <- pkgtype %in% c("both", "source")
  binok <- pkgtype %in% c("both") || grepl("binary", pkgtype, fixed = TRUE)

  # collect list of 'methods' for retrieval
  methods <- stack(mode = "list")

  # add binary package methods
  if (binok) {

    # prefer repository binaries if available
    methods$push(renv_retrieve_repos_binary)

    # if MRAN is enabled, check those binaries as well
    if (config$mran.enabled())
      methods$push(renv_retrieve_repos_mran)

  }

  # next, try to retrieve from sources
  if (srcok) {

    # retrieve from source repositories
    methods$push(renv_retrieve_repos_source)

    # if this is a package from r-universe, try restoring from github
    # (currently inferred from presence for RemoteUrl field)
    unifields <- c("RemoteUrl", "RemoteRef", "RemoteSha")
    if (all(unifields %in% names(record)))
      methods$push(renv_retrieve_git)
    else
      methods$push(renv_retrieve_repos_archive)

  }

  # capture errors for reporting
  errors <- stack()

  for (method in methods$data()) {

    status <- catch(
      withCallingHandlers(
        method(record),
        renv.retrieve.error = function(error) {
          errors$push(error$data)
        }
      )
    )

    if (inherits(status, "error")) {
      warning(status)
      next
    }

    if (identical(status, TRUE))
      return(TRUE)

    if (!is.logical(status)) {
      fmt <- "internal error: unexpected status code '%s'"
      warningf(fmt, renv_deparse(status))
    }

  }

  # if we couldn't download the package, report the errors we saw
  local({
    renv_scope_options(warn = 1)
    for (error in errors$data())
      warning(error)
  })

  stopf("failed to retrieve package '%s'", renv_record_format_remote(record))

}

renv_retrieve_repos_error_report <- function(record, errors) {

  if (empty(errors))
    return()

  messages <- extract(errors, "message")
  if (empty(messages))
    return()

  messages <- unlist(messages, recursive = TRUE, use.names = FALSE)
  if (empty(messages))
    return()

  fmt <- "The following error(s) occurred while retrieving '%s':"
  preamble <- sprintf(fmt, record$Package)

  renv_pretty_print(
    values   = paste("-", messages),
    preamble = preamble,
    wrap     = FALSE
  )

  if (renv_tests_running() && renv_tests_verbose())
    str(errors)

}

renv_retrieve_url <- function(record) {

  if (is.null(record$RemoteUrl)) {
    fmt <- "package '%s' has no recorded RemoteUrl"
    stopf(fmt, record$Package)
  }

  resolved <- renv_remotes_resolve_url(record$RemoteUrl, quiet = FALSE)
  renv_retrieve_successful(record, resolved$Path)

}

renv_retrieve_repos_archive_name <- function(record, type = "source") {
  record$File %||% {
    ext <- renv_package_ext(type)
    paste0(record$Package, "_", record$Version, ext)
  }
}

renv_retrieve_repos_mran <- function(record) {

  # MRAN does not make binaries available on Linux
  if (renv_platform_linux())
    return(FALSE)

  # ensure local MRAN database is up-to-date
  renv_mran_database_refresh(explicit = FALSE)

  # check that we have an available database
  path <- renv_mran_database_path()
  if (!file.exists(path))
    return(FALSE)

  # attempt to read it
  database <- catch(renv_mran_database_load())
  if (inherits(database, "error")) {
    warning(database)
    return(FALSE)
  }

  # get entry for this version of R + platform
  suffix <- contrib.url("", type = "binary")
  entry <- database[[suffix]]
  if (is.null(entry))
    return(FALSE)

  # check for known entry for this package + version
  key <- paste(record$Package, record$Version)
  idate <- entry[[key]]
  if (is.null(idate))
    return(FALSE)

  # convert from integer to date
  date <- as.Date(idate, origin = "1970-01-01")

  # form url to binary package
  base <- renv_mran_url(date, suffix)
  name <- renv_retrieve_name(record, type = "binary")
  url <- file.path(base, name)

  # form path to saved file
  path <- renv_retrieve_path(record, "binary")

  # attempt to retrieve
  renv_retrieve_package(record, url, path)

}

renv_retrieve_repos_binary <- function(record) {
  renv_retrieve_repos_impl(record, "binary")
}

renv_retrieve_repos_source <- function(record) {
  renv_retrieve_repos_impl(record, "source")
}

renv_retrieve_repos_archive <- function(record) {

  for (repo in getOption("repos")) {

    # try to determine path to package in archive
    url <- renv_retrieve_repos_archive_path(repo, record)
    if (is.null(url))
      next

    # attempt download
    name <- renv_retrieve_repos_archive_name(record, type = "source")
    status <- catch(renv_retrieve_repos_impl(record, "source", name, url))
    if (identical(status, TRUE))
      return(TRUE)

  }

  return(FALSE)

}

renv_retrieve_repos_archive_path <- function(repo, record) {

  # allow users to provide a custom archive path for a record,
  # in case they're using a repository that happens to archive
  # packages with a different format than regular CRAN network
  # https://github.com/rstudio/renv/issues/602
  override <- getOption("renv.retrieve.repos.archive.path")
  if (is.function(override)) {
    result <- override(repo, record)
    if (!is.null(result))
      return(result)
  }

  # if we already know the format of the repository, use that
  if (exists(repo, envir = `_renv_repos_archive`)) {
    formatter <- get(repo, envir = `_renv_repos_archive`)
    root <- formatter(repo, record)
    return(root)
  }

  # otherwise, try determining the archive paths with a couple
  # custom locations, and cache the version that works for the
  # associated repository
  formatters <- list(

    # default CRAN format
    function(repo, record) {
      with(record, file.path(repo, "src/contrib/Archive", Package))
    },

    # format used by Artifactory
    # https://github.com/rstudio/renv/issues/602
    function(repo, record) {
      with(record, file.path(repo, "src/contrib/Archive", Package, Version))
    },

    # format used by Nexus
    # https://github.com/rstudio/renv/issues/595
    function(repo, record) {
      with(record, file.path(repo, "src/contrib"))
    }

  )

  name <- renv_retrieve_repos_archive_name(record, "source")
  for (formatter in formatters) {
    root <- formatter(repo, record)
    url <- file.path(root, name)
    if (renv_download_available(url)) {
      assign(repo, formatter, envir = `_renv_repos_archive`)
      return(root)
    }
  }

}

renv_retrieve_repos_impl <- function(record,
                                     type = NULL,
                                     name = NULL,
                                     repo = NULL)
{
  package <- record$Package
  version <- record$Version

  type <- type %||% attr(record, "type", exact = TRUE)
  name <- name %||% renv_retrieve_repos_archive_name(record, type)
  repo <- repo %||% attr(record, "url", exact = TRUE)

  # if we weren't provided a repository for this package, try to find it
  if (is.null(repo)) {

    entry <- catch(
      renv_available_packages_entry(
        package = package,
        type    = type,
        filter  = version,
        prefer  = record[["Repository"]]
      )
    )

    if (inherits(entry, "error")) {
      attr(entry, "record") <- record
      renv_condition_signal("renv.retrieve.error", entry)
      return(FALSE)
    }

    # add in the path if available
    repo <- entry$Repository
    if (!is.null(entry$Path) && !is.na(entry$Path))
      repo <- file.path(repo, entry$Path)

    # update the tarball name if it was declared
    file <- entry$File
    if (!is.null(file))
      name <- file

  }

  url <- file.path(repo, name)
  path <- renv_retrieve_path(record, type)

  renv_retrieve_package(record, url, path)

}


renv_retrieve_package <- function(record, url, path) {

  ensure_parent_directory(path)
  type <- renv_record_source(record)
  status <- local({
    renv_scope_auth(record)
    catch(download(url, destfile = path, type = type))
  })

  # report error for logging upstream
  if (inherits(status, "error")) {
    attr(status, "record") <- record
    renv_condition_signal("renv.retrieve.error", status)
  }

  # handle FALSE returns (shouldn't normally happen?)
  if (identical(status, FALSE)) {
    fmt <- "an unknown error occurred installing '%s' (%s)"
    msg <- sprintf(fmt, record$Package, renv_record_format_remote(record))
    status <- simpleError(msg)
  }

  # handle errors
  if (inherits(status, "error"))
    stop(status)

  # handle success
  renv_retrieve_successful(record, path)

}

renv_retrieve_successful_subdir <- function(record, path) {

  # if it's a file, assume RemoteSubdir needs to be honored
  info <- file.info(path, extra_cols = FALSE)
  if (identical(info$isdir, FALSE))
    return(record$RemoteSubdir)

  # otherwise, respect RemoteSubdir only if it seems to
  # point at a valid DESCRPITION file
  if (!is.null(record$RemoteSubdir)) {
    parts <- c(path, record$RemoteSubdir, "DESCRIPTION")
    descpath <- paste(parts, collapse = "/")
    if (file.exists(descpath))
      return(record$RemoteSubdir)
  }

}

renv_retrieve_successful <- function(record, path, install = TRUE) {

  # the handling of 'subdir' here is a little awkward, as this function
  # can receive:
  #
  # - archives, whose package might live within a sub-directory;
  # - folders, whose package might live within a sub-directory;
  # - cache paths, for which the subdir is no longer relevant
  #
  # this warrants a proper cleanup, but for now we we use a hack
  subdir <- renv_retrieve_successful_subdir(record, path)

  # augment record with information from DESCRIPTION file
  desc <- renv_description_read(path, subdir = subdir)

  # update the record's package name, version
  # TODO: should we warn if they didn't match for some reason?
  record$Package <- desc$Package
  record$Version <- desc$Version

  # add in path information to record (used later during install)
  record$Path <- path

  # record this package's requirements
  state <- renv_restore_state()
  requirements <- state$requirements
  deps <- renv_dependencies_discover_description(path, subdir = subdir)
  if (length(deps$Source))
    deps$Source <- record$Package

  rowapply(deps, function(dep) {
    package <- dep$Package
    requirements[[package]] <- requirements[[package]] %||% stack()
    requirements[[package]]$push(dep)
  })

  # read and handle remotes declared by this package
  renv_retrieve_handle_remotes(record, subdir = subdir)

  # ensure its dependencies are retrieved as well
  if (state$recursive)
    for (package in unique(deps$Package))
      retrieve(package)

  # mark package as requiring install if needed
  if (install)
    state$install$push(record)

  TRUE

}

renv_retrieve_unknown_source <- function(record) {

  # try to find a matching local package
  status <- catch(renv_retrieve_cellar(record))
  if (!inherits(status, "error"))
    return(status)

  # failed; parse as though from R package repository
  record$Source <- "Repository"
  renv_retrieve_repos(record)

}

renv_retrieve_handle_remotes <- function(record, subdir) {

  # TODO: what should we do if we detect incompatible remotes?
  # e.g. if pkg A requests 'r-lib/rlang@0.3' but pkg B requests
  # 'r-lib/rlang@0.2'.

  # check and see if this package declares Remotes -- if so,
  # use those to fill in any missing records
  path <- record$Path
  desc <- renv_description_read(path = path, subdir = subdir)
  if (is.null(desc$Remotes))
    return(NULL)

  fields <- strsplit(desc$Remotes, "\\s*,\\s*")[[1]]
  for (field in fields) {

    # TODO: allow customization of behavior when remote parsing fails?
    remote <- catch(renv_remotes_resolve(field))
    if (inherits(remote, "error")) {
      fmt <- "failed to resolve remote '%s' declared by package '%s'; skipping"
      warningf(fmt, field, record$Package)
      next
    }


    # if installation of this package was not specifically requested by
    # the user (ie: it's been requested as it's a dependency of this package)
    # then update the record. note that we don't want to update in explicit
    # installs as we don't want to override what was reported / requested
    # in e.g. `renv::restore()`.
    #
    # allow override if a non-specific version of the package was requested
    package <- remote$Package
    state <- renv_restore_state()
    if (package %in% state$packages) {
      record <- state$records[[package]]
      if (!identical(record, list(Package = package, Source = "Repository")))
        next
    }

    # only update the record if we don't have an existing instance
    # of the record. the intention here is that remotes specified in,
    # say, the project DESCRIPTION file should take precedence over
    # remotes defined by packages themselves. there is some obvious
    # potential for breakage here though
    state$records[[package]] <- state$records[[package]] %||% remote

  }

}

renv_retrieve_missing_record <- function(package) {

  # TODO: allow users to configure the action to take here, e.g.
  #
  #   1. retrieve latest from R repositories (the default),
  #   2. request a package + version to be retrieved,
  #   3. hard error
  #
  record <- renv_available_packages_latest(package)
  if (!is.null(record))
    return(record)

  fmt <- heredoc("
    renv was unable to find a compatible version of package '%1$s'.

    The latest-available version %1$s is '%2$s', but that version
    does not appear to be compatible with this version of R.

    You may need to manually re-install a different version of '%1$s'.
  ")

  entry <- renv_available_packages_entry(package, type = "source")
  version <- entry$Version %||% "<unknown>"

  msg <- sprintf(fmt, package, version)
  writeLines(msg)

  stopf("failed to find a compatible version of the '%s' package", package)

}

# check to see if this requested record is incompatible
# with the set of required dependencies recorded thus far
# during the package retrieval process
renv_retrieve_incompatible <- function(package, record) {

  state <- renv_restore_state()
  record <- renv_record_validate(package, record)

  # check and see if the installed version satisfies all requirements
  requirements <- state$requirements[[package]]
  if (is.null(requirements))
    return(NULL)

  data <- bind(requirements$data())
  explicit <- data[nzchar(data$Require) & nzchar(data$Version), ]
  if (nrow(explicit) == 0)
    return(NULL)

  # drop 'Dev' column
  explicit$Dev <- NULL

  # retrieve record version
  version <- record$Version
  if (is.null(version))
    return(NULL)

  # for each row, compute whether we're compatible
  rversion <- numeric_version(version)
  compatible <- map_lgl(seq_len(nrow(explicit)), function(i) {
    expr <- call(explicit$Require[[i]], rversion, explicit$Version[[i]])
    eval(expr, envir = baseenv())
  })

  # keep whatever wasn't compatible
  explicit[!compatible, ]

}

renv_retrieve_incompatible_report <- function(package, record, replacement, compat) {

  # only report if the user explicitly requesting installation of a particular
  # version of a package, but that package isn't actually compatible
  state <- renv_restore_state()
  if (!package %in% state$packages)
    return()

  fmt <- "%s (requires %s %s %s)"
  values <- with(compat, sprintf(fmt, Source, Package, Require, Version))

  fmt <- "Installation of '%s %s' was requested, but the following constraints are not met:"
  preamble <- with(record, sprintf(fmt, Package, Version))

  fmt <- "renv will try to install '%s %s' instead."
  postamble <- with(replacement, sprintf(fmt, Package, Version))

  if (!renv_tests_running()) {
    renv_pretty_print(
      values = values,
      preamble = preamble,
      postamble = postamble,
      wrap = FALSE
    )
  }

}

renv_retrieve_origin <- function(host) {

  # NOTE: some host URLs may come with a protocol already formed;
  # if we find a protocol, use it as-is
  if (grepl("://", host, fixed = TRUE))
    return(host)

  # otherwise, prepend protocol (assume https)
  paste("https", host, sep = "://")

}

renv_robocopy_exec <- function(source, target, flags = NULL) {

  source <- path.expand(source)
  target <- path.expand(target)

  # add other flags
  flags <- c(flags, "/E", "/Z", "/R:5", "/W:10")

  # https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/robocopy
  # > Any value greater than 8 indicates that there was at least one failure
  # > during the copy operation.
  renv_system_exec(
    command = "robocopy",
    args    = c(flags, renv_shell_path(source), renv_shell_path(target)),
    action  = "copying directory",
    success = 0:8,
    quiet   = TRUE
  )

}

renv_robocopy_copy <- function(source, target) {
  renv_robocopy_exec(source, target)
}

renv_robocopy_move <- function(source, target) {
  renv_robocopy_exec(source, target, "/MOVE")
}

#' @param project The project directory. If `NULL`, then the active project will
#'   be used. If no project is currently active, then the current working
#'   directory is used instead.
#'
#' @param type The type of package to install ("source" or "binary"). Defaults
#'   to the value of `getOption("pkgType")`.
#'
#' @param library The \R library to be used. When `NULL`, the active project
#'  library will be used instead.
#'
#' @param prompt Boolean; prompt the user before taking any action? For backwards
#'   compatibility, `confirm` is accepted as an alias for `prompt`.
#'
#' @param ... Unused arguments, reserved for future expansion. If any arguments
#'   are matched to `...`, `renv` will signal an error.
#'
#' @param clean Boolean; remove packages not recorded in the lockfile from
#'   the target library? Use `clean = TRUE` if you'd like the library state
#'   to exactly reflect the lockfile contents after `restore()`.
#'
#' @param rebuild Force packages to be rebuilt, thereby bypassing any installed
#'   versions of the package available in the cache? This can either be a
#'   boolean (indicating that all installed packages should be rebuilt), or a
#'   vector of package names indicating which packages should be rebuilt.
#'
#' @param repos The repositories to use during restore, for packages installed
#'   from CRAN or another similar R package repository. When set, this will
#'   override any repositories declared in the lockfile. See also the
#'   `repos.override` option in [config] for an alternate way to provide a
#'   repository override.
#'
#' @param profile The profile to be activated. When `NULL`, the default
#'   profile is activated instead. See `vignette("profiles", package = "renv")`
#'   for more information.
#'
#' @return The project directory, invisibly. Note that this function is normally
#'   called for its side effects.
#'
#' @name renv-params
NULL

#' @param library The library into which packages should be installed.
#'
#' @param packages A character vector of \R packages to install. Required
#'   package dependencies (`Depends`, `Imports`, `LinkingTo`) will be installed
#'   as required.
#'
#' @name install-params
NULL

renv_roxygen_config_section <- function() {

  # read config
  config <- yaml::read_yaml("inst/config.yml")

  # generate items
  items <- map_chr(config, function(entry) {

    # extract fields
    name <- entry$name
    type <- entry$type
    default <- entry$default
    description <- entry$description

    # deparse default value
    default <- case(
      identical(default, list()) ~ "NULL",
      TRUE                       ~ deparse(default)
    )

    # generate table row
    fmt <- "\\subsection{renv.config.%s}{%s Defaults to \\code{%s}.}"
    sprintf(fmt, name, description, default)

  })

  c(
    "@section Configuration:",
    "",
    "The following `renv` configuration options are available:",
    "",
    items,
    ""
  )

}

`_renv_rspm_status` <- new.env(parent = emptyenv())

renv_rspm_transform <- function(repos) {
  map_chr(repos, function(url) {
    tryCatch(
      renv_rspm_transform_impl(url),
      error = function(e) url
    )
  })
}

renv_rspm_transform_impl <- function(url) {

  # repository URL transformation is only necessary on Linux
  os <- renv_rspm_os()
  if (!identical(os, "__linux__"))
    return(url)

  # check for a known platform
  platform <- renv_rspm_platform()
  if (is.null(platform))
    return(url)

  # don't transform non-https URLs
  if (!grepl("^https?://", url))
    return(url)

  # if this already appears to be a binary URL, then avoid
  # transforming it
  if (grepl("/__[^_]+__/", url))
    return(url)

  # only attempt to transform URLs that are formatted like
  # RSPM urls -- for example:
  #
  #   https://rspm.company.org/cran/checkpoint/id
  #
  # in particular, there should be at least two trailing
  # alphanumeric path components
  pattern <- "/[^/]+/[^/]+/"
  if (!grepl(pattern, url))
    return(url)

  # begin building list of URLs
  urls <- character()

  # ignore some known CRAN mirrors
  # (note that getCRANmirrors can fail if R is not installed with
  # any local knowledge of available CRAN repositories)
  mirrors <- catch(getCRANmirrors(local.only = TRUE))
  urls <- c(urls, mirrors$URL)

  # also ignore some RStudio URLs
  rstudio <- c(
    "http://cran.rstudio.com",
    "http://cran.rstudio.org",
    "https://cran.rstudio.com",
    "https://cran.rstudio.org"
  )
  urls <- c(urls, rstudio)

  if (sub("/+$", "", url) %in% sub("/+$", "", urls))
    return(url)

  # try to query the status endpoint
  # TODO: this could fail if the URL is a proxy back to RSPM
  base <- dirname(dirname(url))
  status <- catch(renv_rspm_status(base))
  if (inherits(status, "error"))
    return(url)

  # iterate through distros and check for a match
  for (distro in status$distros) {

    ok <-
      identical(distro$binaryURL, platform) &&
      identical(distro$binaries, TRUE)

    if (ok) {
      parts <- c(dirname(url), "__linux__", platform, basename(url))
      binurl <- paste(parts, collapse = "/")
      return(binurl)
    }

  }

  # no match; return url as-is
  url

}

renv_rspm_status <- function(base) {
  memoize(
    key   = base,
    expr  = catch(renv_rspm_status_impl(base)),
    envir = `_renv_rspm_status`
  )
}

renv_rspm_status_impl <- function(base) {

  # use a shorter delay to avoid hanging a session
  renv_scope_options(
    renv.config.connect.timeout = 10L,
    renv.config.connect.retry   = 1L
  )

  # attempt the download
  endpoint <- file.path(base, "__api__/status")
  destfile <- renv_scope_tempfile("renv-rspm-status-", fileext = ".json")
  quietly(download(endpoint, destfile))

  # read the downloaded JSON
  renv_json_read(destfile)

}

renv_rspm_platform <- function(file = "/etc/os-release") {

  platform <- Sys.getenv("RENV_RSPM_PLATFORM", unset = NA)
  if (!is.na(platform))
    return(platform)

  if (renv_platform_windows())
    return("windows")

  if (renv_platform_macos())
    return("macos")

  renv_rspm_platform_impl(file)

}

renv_rspm_platform_impl <- function(file = "/etc/os-release") {

  if (file.exists(file)) {

    properties <- renv_properties_read(
      path      = file,
      delimiter = "=",
      dequote   = TRUE
    )

    id <- properties$ID %||% ""

    case(
      identical(id, "ubuntu") ~ renv_rspm_platform_ubuntu(properties),
      identical(id, "centos") ~ renv_rspm_platform_centos(properties),
      identical(id, "rhel")   ~ renv_rspm_platform_rhel(properties),
      grepl("\\bsuse\\b", id) ~ renv_rspm_platform_suse(properties)
    )

  }

}

renv_rspm_platform_ubuntu <- function(properties) {

  codename <- properties$VERSION_CODENAME
  if (is.null(codename))
    return(NULL)

  codename

}

renv_rspm_platform_centos <- function(properties) {

  id <- properties$VERSION_ID
  if (is.null(id))
    return(NULL)

  paste0("centos", substring(id, 1L, 1L))

}

renv_rspm_platform_rhel <- function(properties) {

  id <- properties$VERSION_ID
  if (is.null(id))
    return(NULL)

  paste0("centos", substring(id, 1L, 1L))

}


renv_rspm_platform_suse <- function(properties) {

  id <- properties$VERSION_ID
  if (is.null(id))
    return(NULL)

  parts <- strsplit(id, ".", fixed = TRUE)[[1L]]
  paste0("opensuse", parts[[1L]])

}

renv_rspm_os <- function() {

  os <- Sys.getenv("RENV_RSPM_OS", unset = NA)
  if (!is.na(os))
    return(os)

  if (renv_platform_windows())
    "__windows__"
  else if (renv_platform_macos())
    "__macos__"
  else if (renv_platform_linux())
    "__linux__"

}


renv_rspm_enabled <- function() {
  config$rspm.enabled()
}

renv_rstudio_available <- function() {

  # NOTE: detecting whether we're running within RStudio is a bit
  # tricky because not all of the expected RStudio bits have been
  # initialized when the R session is being initialized (e.g.
  # when the .Rprofile is being executed)
  args <- commandArgs(trailingOnly = FALSE)
  args[[1L]] == "RStudio" || .Platform$GUI == "RStudio"

}

renv_rstudio_initialize <- function(project) {

  tools <- catch(as.environment("tools:rstudio"))
  if (inherits(tools, "error"))
    return(FALSE)

  if (is.null(tools$.rs.api.initializeProject))
    return(FALSE)

  tools$.rs.api.initializeProject(project)
  TRUE

}

renv_rstudio_loading <- function() {
  renv_rstudio_available() && !identical(.Platform$GUI, "RStudio")
}

renv_rstudio_fixup <- function() {

  # if RStudio's tools are on the search path, we should try
  # to fix them up so that renv's own routines don't get seen
  tools <- catch(as.environment("tools:rstudio"))
  if (inherits(tools, "error"))
    return(FALSE)

  helper <- tools[[".rs.clearVar"]]
  if (is.null(helper))
    return(FALSE)

  # if the helper environment has been fixed up (as e.g. by
  # newer versions of RStudio) then nothing to do
  if (identical(tools, environment(helper)))
    return(FALSE)

  # put common tools from base into the environment
  envir <- environment(helper)
  for (var in c("assign", "exists", "get", "remove", "paste"))
    envir[[var]] <- get(var, envir = baseenv())

  TRUE

}

renv_rtools_list <- function() {

  drive <- Sys.getenv("SYSTEMDRIVE", unset = "C:")

  roots <- c(

    renv_rtools_registry(),

    Sys.getenv("RTOOLS42_HOME", unset = file.path(drive, "rtools42")),
    Sys.getenv("RTOOLS40_HOME", unset = file.path(drive, "rtools40")),
    file.path(drive, "Rtools"),
    list.files(file.path(drive, "RBuildTools"), full.names = TRUE),

    "~/Rtools",
    list.files("~/RBuildTools", full.names = TRUE)

  )

  roots <- unique(roots[file.exists(roots)])
  lapply(roots, renv_rtools_read)

}

renv_rtools_find <- function() {

  for (spec in renv_rtools_list())
    if (renv_rtools_compatible(spec))
      return(spec)

  NULL

}

renv_rtools_read <- function(root) {

  list(
    root    = root,
    version = renv_rtools_version(root)
  )

}

renv_rtools_version <- function(root) {

  # detect Rtools40
  files <- c("mirrorlist.rtools", "rtools.mingw32", "rtools.mingw64")
  for (file in files) {
    path <- file.path(root, "etc/pacman.d", file)
    if (file.exists(path))
      return(numeric_version("4.0"))
  }

  # detect Rtools42
  mirrors <- file.path(root, "etc/pacman.d/mirrorlist.clang64")
  if (file.exists(mirrors))
    return(numeric_version("4.2"))

  # detect older Rtools installations
  path <- file.path(root, "VERSION.txt")
  if (!file.exists(path))
    return(NULL)

  contents <- readLines(path, warn = FALSE)
  version <- gsub("[^[:digit:].]", "", contents)

  numeric_version(version)

}

renv_rtools_compatible <- function(spec) {

  if (is.null(spec$version))
    return(FALSE)

  ranges <- list(
    "4.2" = c("4.2.0", "9.9.9"),
    "4.0" = c("4.0.0", "4.2.0"),
    "3.5" = c("3.3.0", "4.0.0"),
    "3.4" = c("3.3.0", "4.0.0"),
    "3.3" = c("3.2.0", "3.3.0"),
    "3.2" = c("3.1.0", "3.2.0"),
    "3.1" = c("3.0.0", "3.1.0")
  )

  version <- numeric_version(spec$version)[1, 1:2]
  range <- ranges[[format(version)]]
  if (is.null(range))
    return(FALSE)

  rversion <- getRversion()
  range[[1]] <= rversion && rversion < range[[2]]

}

renv_rtools_registry <- function() {

  status <- tryCatch(
    utils::readRegistry(
      key = "SOFTWARE\\R-Core\\Rtools",
      hive = "HLM"
    ),
    error = function(e) list()
  )

  path <- status$InstallPath %||% ""
  if (file.exists(path))
    return(normalizePath(path, winslash = "/"))

}

renv_rtools_envvars <- function(root) {

  version <- renv_rtools_version(root)

  if (version < "4.0")
    renv_rtools_envvars_default(root)
  else if (version < "4.2")
    renv_rtools_envvars_rtools40(root)
  else
    renv_rtools_envvars_rtools42(root)

}

renv_rtools_envvars_default <- function(root) {

  # add Rtools utilities to path
  bin <- normalizePath(
    file.path(root, "bin"),
    winslash = "\\",
    mustWork = FALSE
  )

  path <- paste(bin, Sys.getenv("PATH"), sep = .Platform$path.sep)

  # set BINPREF (note: trailing slash is required)
  binpref <- paste(
    normalizePath(root, winslash = "/", mustWork = FALSE),
    "mingw_$(WIN)/bin/",
    sep = "/"
  )

  list(PATH = path, BINPREF = binpref)

}

renv_rtools_envvars_rtools42 <- function(root) {

  # add Rtools utilities to path
  bin <- normalizePath(
    file.path(root, "usr/bin"),
    winslash = "\\",
    mustWork = FALSE
  )

  path <- paste(bin, Sys.getenv("PATH"), sep = .Platform$path.sep)

  # set BINPREF
  binpref <- ""

  list(PATH = path, BINPREF = binpref)

}

renv_rtools_envvars_rtools40 <- function(root) {

  # add Rtools utilities to path
  bin <- normalizePath(
    file.path(root, "usr/bin"),
    winslash = "\\",
    mustWork = FALSE
  )

  path <- paste(bin, Sys.getenv("PATH"), sep = .Platform$path.sep)

  # set BINPREF
  binpref <- "/mingw$(WIN)/bin/"

  list(PATH = path, BINPREF = binpref)

}

#' Run a Script
#'
#' Run an \R script, in the context of a project using `renv`. The script will
#' be run within an \R sub-process.
#'
#' @inherit renv-params
#'
#' @param script The path to an \R script.
#'
#' @param job Run the requested script as an RStudio job? Requires a recent
#'   version of both RStudio and the `rstudioapi` packages. When `NULL`, the
#'   script will be run as a job if possible, and as a regular \R process
#'   launched by [system2()] if not.
#'
#' @param name The name to associate with the job, for scripts run as a job.
#'
#' @param project The path to the `renv` project. This project will be loaded
#'   before the requested script is executed. When `NULL` (the default), `renv`
#'   will automatically determine the project root for the associated script
#'   if possible.
#'
#' @export
run <- function(script, ..., job = NULL, name = NULL, project = NULL) {

  renv_scope_error_handler()
  renv_dots_check(...)

  script <- renv_path_normalize(script, winslash = "/", mustWork = TRUE)

  # find the project directory
  project <- project %||% renv_file_find(script, function(path) {
    paths <- file.path(path, c("renv", "renv.lock"))
    if (any(file.exists(paths)))
      return(path)
  })

  if (is.null(project)) {
    fmt <- "could not determine project root for script '%s'"
    stopf(fmt, aliased_path(script))
  }

  # ensure that it has an activate script
  activate <- renv_paths_activate(project = project)
  if (!file.exists(activate)) {
    fmt <- "project '%s' does not have an renv activate script"
    stopf(fmt, aliased_path(project))
  }

  # run as a job when possible in RStudio
  jobbable <-
    !identical(job, FALSE) &&
    renv_rstudio_available() &&
    renv_package_installed("rstudioapi") &&
    renv_package_version("rstudioapi") >= "0.10" &&
    rstudioapi::verifyAvailable("1.2.1335")

  if (identical(job, TRUE) && identical(jobbable, FALSE))
    stopf("cannot run script as job: required versions of RStudio + rstudioapi not available")

  if (jobbable)
    renv_run_job(script = script, name = name, project = project)
  else
    renv_run_impl(script = script, name = name, project = project)

}

renv_run_job <- function(script, name, project) {

  activate <- renv_paths_activate(project = project)
  jobscript <- tempfile("renv-job-", fileext = ".R")

  exprs <- substitute(local({
    on.exit(unlink(jobscript), add = TRUE)
    source(activate)
    source(script)
  }), list(activate = activate, script = script, jobscript = jobscript))

  code <- deparse(exprs)
  writeLines(code, con = jobscript)

  rstudioapi::jobRunScript(
    path       = jobscript,
    workingDir = project,
    name       = name
  )

}

renv_run_impl <- function(script, name, project) {
  owd <- setwd(project)
  on.exit(setwd(owd), add = TRUE)
  system2(R(), c("-s", "-f", renv_shell_path(script)))
}

renv_sandbox_activate <- function(project = NULL) {

  # record start time
  before <- Sys.time()

  # attempt the activation
  status <- catch(renv_sandbox_activate_impl(project))
  if (inherits(status, "error"))
    warning(status)

  # record end time
  after <- Sys.time()

  # check for long elapsed time
  elapsed <- difftime(after, before, units = "secs")

  # if it took too long to activate the sandbox, warn the user
  if (elapsed > 10) {

    fmt <- heredoc("
    renv took longer than expected (%s) to activate the sandbox.

    The sandbox can be disabled by setting:

        RENV_CONFIG_SANDBOX_ENABLED = FALSE

    within an appropriate start-up .Renviron file. See `?renv::config` for more details.
    ")


    warningf(fmt, renv_difftime_format(elapsed))

  }

  # return status
  status

}

renv_sandbox_activate_impl <- function(project) {

  # get current library paths
  oldlibs <- .libPaths()
  syslibs <- c(renv_libpaths_site(), renv_libpaths_system())
  syslibs <- renv_path_normalize(syslibs, winslash = "/", mustWork = FALSE)

  # override .Library.site
  base <- .BaseNamespaceEnv
  renv_binding_replace(".Library.site", NULL, envir = base)

  if (config$sandbox.enabled()) {

    # generate the sandbox
    default <- file.path(tempdir(), "renv-system-library")
    sandbox <- Sys.getenv("RENV_PATHS_SANDBOX", unset = default)
    ensure_directory(sandbox)
    renv_sandbox_generate(sandbox)

    # override .Library
    renv_binding_replace(".Library", sandbox, envir = base)

  }

  # update library paths
  newlibs <- renv_vector_diff(oldlibs, syslibs)
  renv_libpaths_set(newlibs)

  if (config$sandbox.enabled()) {

    # protect against user profiles that might try
    # to update the library paths
    renv_sandbox_activate_check(newlibs)

    # add a callback that double-checks the sandbox is active
    # and working as intended
    addTaskCallback(renv_sandbox_task)

  }

  # return new library paths
  renv_libpaths_all()

}

renv_sandbox_activate_check <- function(libs) {

  envir <- globalenv()

  danger <-
    exists(".First", envir = envir, inherits = FALSE) &&
    identical(getOption("renv.autoloader.running"), TRUE)

  if (!danger)
    return(FALSE)

  .First <- get(".First", envir = envir, inherits = FALSE)
  wrapper <- function() {

    # scope the library paths as currently defined
    renv_scope_libpaths()

    # call the user-defined .First function
    status <- tryCatch(.First(), error = warning)

    # double-check if we should restore .First (this is extra
    # paranoid but in theory .First could remove itself)
    if (identical(wrapper, get(".First", envir = envir)))
      assign(".First", .First, envir = envir)

    # return result of .First
    invisible(status)

  }

  assign(".First", wrapper, envir = envir)
  return(TRUE)

}

renv_sandbox_generate <- function(sandbox) {

  # find system packages in the system library
  syspkgs <- renv_installed_packages(
    lib.loc = renv_libpaths_system(),
    priority = c("base", "recommended")
  )

  # link into temporary library
  sources <- with(syspkgs, file.path(LibPath, Package))
  targets <- with(syspkgs, file.path(sandbox, Package))
  names(targets) <- sources
  enumerate(targets, function(source, target) {
    renv_file_link(source, target)
  })

  # return sandbox path
  sandbox

}

renv_sandbox_deactivate <- function() {

  # get library paths sans .Library, .Library.site
  old <- renv_libpaths_all()
  syslibs <- renv_path_normalize(c(.Library, .Library.site), winslash = "/", mustWork = FALSE)

  # restore old bindings
  base <- .BaseNamespaceEnv
  renv_binding_replace(".Library",      renv_libpaths_system(), envir = base)
  renv_binding_replace(".Library.site", renv_libpaths_site(),   envir = base)

  # update library paths
  new <- renv_vector_diff(old, syslibs)
  renv_libpaths_set(new)

  renv_libpaths_all()

}

renv_sandbox_task <- function(...) {

  enabled <- config$sandbox.enabled()
  if (!enabled)
    return(FALSE)

  sandbox <- tail(.libPaths(), n = 1L)
  if (!file.exists(sandbox)) {
    warning("the renv sandbox was deleted; it will be re-generated", call. = FALSE)
    renv_sandbox_generate(sandbox)
  }

  TRUE

}
#' Generate renv Project Infrastructure
#'
#' Write the `renv` project infrastructure for a project.
#'
#' Invoking `renv::scaffold()` will:
#'
#' - Install `renv` into the project library,
#'
#' - Update the project `.Rprofile` so that `renv` is automatically loaded
#'   for new \R sessions launched in this project, and
#'
#' - Write a bare lockfile `renv.lock`.
#'
#' @inheritParams renv-params
#'
#' @param version The version of `renv` to associate with this project. By
#'   default, the version of `renv` currently installed is used.
#'
#' @param repos The \R repositories to associate with this project.
#'
#' @param settings A list of `renv` settings, to be applied to the project
#'   after creation. These should map setting names to the desired values.
#'   See [settings] for more details.
#'
#' @examples
#'
#' \dontrun{
#' # create scaffolding with 'devtools' ignored
#' renv::scaffold(settings = list(ignored.packages = "devtools"))
#' }
#'
#' @export
scaffold <- function(project  = NULL,
                     version  = NULL,
                     repos    = getOption("repos"),
                     settings = NULL)
{
  renv_scope_error_handler()
  renv_scope_options(repos = repos)

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  # install renv into project library
  renv_imbue_impl(project, version)

  # write out project infrastructure
  renv_infrastructure_write(project, version)

  # update project settings
  if (is.list(settings))
    renv_settings_persist(project, settings)

  # generate a lockfile
  lockfile <- renv_lockfile_create(
    project  = project,
    libpaths = renv_paths_library(project = project),
    type     = "implicit",
    packages = NULL
  )

  renv_lockfile_write(lockfile, file = renv_lockfile_path(project))

  # notify user
  fmt <- "* renv infrastructure has been generated for project %s."
  vwritef(fmt, renv_path_pretty(project))

  # return project invisibly
  invisible(project)
}

renv_scope_tempdir <- function(pattern = "renv-tempdir-",
                               tmpdir = tempdir(),
                               .envir = NULL)
{
  dir <- tempfile(pattern = pattern, tmpdir = tmpdir)
  ensure_directory(dir)
  owd <- setwd(dir)

  .envir <- .envir %||% parent.frame()

  defer({
    setwd(owd)
    unlink(dir, recursive = TRUE)
  }, envir = .envir)

}

renv_scope_auth <- function(record, .envir = NULL) {

  package <- if (is.list(record)) record$Package else record
  auth <- renv_options_override("renv.auth", package)

  if (empty(auth))
    return(FALSE)

  envvars <- catch({
    if (is.function(auth))
      auth(record)
    else
      auth
  })

  # warn user if auth appears invalid
  if (inherits(envvars, "error")) {
    warning(envvars)
    return(FALSE)
  }

  if (empty(envvars))
    return(FALSE)

  .envir <- .envir %||% parent.frame()
  renv_scope_envvars(.list = as.list(envvars), .envir = .envir)
  return(TRUE)

}

renv_scope_libpaths <- function(new = .libPaths(), .envir = NULL) {
  .envir <- .envir %||% parent.frame()
  old <- renv_libpaths_set(new)
  defer(renv_libpaths_set(old), envir = .envir)
}

renv_scope_options <- function(..., .envir = NULL) {

  .envir <- .envir %||% parent.frame()

  new <- list(...)
  old <- lapply(names(new), getOption)
  names(old) <- names(new)

  do.call(base::options, new)
  defer(do.call(base::options, old), envir = .envir)

}

renv_scope_locale <- function(category = "LC_ALL", locale = "", .envir = NULL) {
  .envir <- .envir %||% parent.frame()
  saved <- Sys.getlocale(category)
  Sys.setlocale(category, locale)
  defer(Sys.setlocale(category, saved), envir = .envir)
}

renv_scope_envvars <- function(..., .list = NULL, .envir = NULL) {

  .envir <- .envir %||% parent.frame()

  dots <- .list %||% list(...)
  old <- as.list(Sys.getenv(names(dots), unset = NA))
  names(old) <- names(dots)

  unset <- map_lgl(dots, is.null)
  Sys.unsetenv(names(dots[unset]))
  if (length(dots[!unset]))
    do.call(Sys.setenv, dots[!unset])

  defer({
    na <- is.na(old)
    Sys.unsetenv(names(old[na]))
    if (length(old[!na]))
      do.call(Sys.setenv, old[!na])
  }, envir = .envir)

}

renv_scope_sink <- function(file = nullfile(), ..., .envir = NULL) {

  .envir <- .envir %||% parent.frame()

  # redirect stdout to file, and redirect stderr back to stdout
  # this ensures that both stdout, stderr are redirected to the same place
  sink(file = file,     type = "output")
  sink(file = stdout(), type = "message")

  defer({
    sink(type = "output")
    sink(type = "message")
  }, envir = .envir)

}

renv_scope_error_handler <- function(.envir = NULL) {

  error <- getOption("error")
  if (!is.null(error))
    return(FALSE)

  call <- renv_error_handler_call()
  options(error = call)

  .envir <- .envir %||% parent.frame()
  defer({
    if (identical(getOption("error"), call))
      options(error = error)
  }, envir = .envir)

  TRUE

}

# used to enforce usage of curl 7.64.1 within the
# renv_paths_extsoft folder when available on Windows

# nocov start
renv_scope_downloader <- function(.envir = NULL) {

  if (!renv_platform_windows())
    return(FALSE)

  if (nzchar(Sys.which("curl")))
    return(FALSE)

  curlroot <- sprintf("curl-%s-win32-mingw", renv_extsoft_curl_version())
  curl <- renv_paths_extsoft(curlroot, "bin/curl.exe")
  if (!file.exists(curl))
    return(FALSE)

  old <- Sys.getenv("PATH", unset = NA)
  if (is.na(old))
    return(FALSE)

  new <- paste(renv_path_normalize(dirname(curl)), old, sep = .Platform$path.sep)

  .envir <- .envir %||% parent.frame()
  renv_scope_envvars(PATH = new, .envir = .envir)

}
# nocov end

# nocov start
renv_scope_rtools <- function(.envir = NULL) {

  if (!renv_platform_windows())
    return(FALSE)

  # check for Rtools
  root <- renv_paths_rtools()
  if (!file.exists(root))
    return(FALSE)

  # get environment variables appropriate for version of Rtools
  vars <- renv_rtools_envvars(root)

  # scope envvars in parent
  .envir <- .envir %||% parent.frame()
  renv_scope_envvars(.list = vars, .envir = .envir)

}
# nocov end

# nocov start
renv_scope_install <- function(.envir = NULL) {

  .envir <- .envir %||% parent.frame()

  if (renv_platform_macos())
    renv_scope_install_macos(.envir)

  if (renv_platform_wsl())
    renv_scope_install_wsl(.envir)

}

renv_scope_install_macos <- function(.envir = NULL) {

  .envir <- .envir %||% parent.frame()

  # check that we have command line tools available before invoking
  # R CMD config, as this might fail otherwise
  if (once()) {
    if (!renv_xcode_available()) {
      message("* macOS is reporting that command line tools (CLT) are not installed.")
      message("* Run 'xcode-select --install' to install command line tools.")
      message("* Without CLT, attempts to install packages from sources may fail.")
    }
  }

  # get the current compiler
  args <- c("CMD", "config", "CC")
  cc <- system2(R(), args, stdout = TRUE, stderr = TRUE)

  # check to see if we're using the system toolchain
  # (need to be careful since users might put e.g. ccache or other flags
  # into the CC variable)

  # helper for creating regex matching compiler bits
  matches <- function(pattern) {
    regex <- paste("(?:[[:space:]]|^)", pattern, "(?:[[:space:]]|$)", sep = "")
    grepl(regex, cc)
  }

  sysclang <- case(
    matches("/usr/bin/clang") ~ TRUE,
    matches("clang")          ~ Sys.which("clang") == "/usr/bin/clang",
    FALSE
  )

  # check for an appropriate LLVM toolchain -- if it exists, use it
  spec <- renv_equip_macos_spec()
  if (sysclang && !is.null(spec) && file.exists(spec$dst)) {
    path <- paste(file.path(spec$dst, "bin"), Sys.getenv("PATH"), sep = ":")
    renv_scope_envvars(PATH = path, .envir = .envir)
  }

  # generate a custom makevars that should better handle compilation
  # with the system toolchain (or other toolchains)
  makevars <- stack()

  # if we don't have an LLVM toolchain available, then try to generate
  # a Makeconf that shields compilation from usages of '-fopenmp'
  if (sysclang) {

    makeconf <- readLines(file.path(R.home("etc"), "Makeconf"), warn = FALSE)
    mplines <- grep(" -fopenmp", makeconf, fixed = TRUE, value = TRUE)

    # read a user makevars (if any)
    contents <- character()
    mvsite <- Sys.getenv(
      "R_MAKEVARS_SITE",
      unset = file.path(R.home("etc"), "Makevars.site")
    )

    if (file.exists(mvsite))
      contents <- readLines(mvsite, warn = FALSE)

    # override usages of '-fopenmp'
    replaced <- gsub(" -fopenmp", "", mplines, fixed = TRUE)
    amended <- unique(c(contents, replaced))
    makevars$push(amended)

  }

  # write makevars to file
  path <- tempfile("Makevars-")
  contents <- unlist(makevars$data(), recursive = TRUE, use.names = FALSE)
  if (length(contents)) {
    writeLines(contents, con = path)
    renv_scope_envvars(R_MAKEVARS_SITE = path, .envir = .envir)
  }

  TRUE

}

renv_scope_install_wsl <- function(.envir = NULL) {
  .envir <- .envir %||% parent.frame()
  renv_scope_envvars(R_INSTALL_STAGED = "FALSE")
}
# nocov end

renv_scope_restore <- function(..., .envir = NULL) {
  .envir <- .envir %||% parent.frame()
  state <- renv_restore_begin(...)
  defer(renv_restore_end(state), envir = .envir)
}

renv_scope_git_auth <- function(.envir = NULL) {

  .envir <- .envir %||% parent.frame()

  # try and tell git to be non-interactive by default
  if (renv_platform_windows()) {
    renv_scope_envvars(
      GIT_TERMINAL_PROMPT = "0",
      .envir              = .envir
    )
  } else {
    renv_scope_envvars(
      GIT_TERMINAL_PROMPT = "0",
      GIT_ASKPASS         = "/bin/echo",
      .envir              = .envir
    )
  }

  # use GIT_PAT when provided
  pat <- Sys.getenv("GIT_PAT", unset = NA)
  if (!is.na(pat)) {
    renv_scope_envvars(
      GIT_USERNAME = pat,
      GIT_PASSWORD = "x-oauth-basic",
      .envir = .envir
    )
  }

  # only set askpass when GIT_USERNAME + GIT_PASSWORD are set
  user <-
    Sys.getenv("GIT_USERNAME", unset = NA) %NA%
    Sys.getenv("GIT_USER",     unset = NA)

  pass <-
    Sys.getenv("GIT_PASSWORD", unset = NA) %NA%
    Sys.getenv("GIT_PASS",     unset = NA)

  if (is.na(user) || is.na(pass))
    return(FALSE)

  askpass <- if (renv_platform_windows())
    system.file("resources/scripts-git-askpass.cmd", package = "renv")
  else
    system.file("resources/scripts-git-askpass.sh", package = "renv")

  renv_scope_envvars(GIT_ASKPASS = askpass, .envir = .envir)
  return(TRUE)

}

renv_scope_bioconductor <- function(project = NULL,
                                    version = NULL,
                                    .envir = NULL)
{
  .envir <- .envir %||% parent.frame()

  # ensure bioconductor support infrastructure initialized
  renv_bioconductor_init()

  # get current repository
  repos <- getOption("repos")

  # remove old / stale bioc repositories
  stale <- grepl("Bioc", names(repos))
  repos <- repos[!stale]

  # retrieve bioconductor repositories appropriate for this record
  biocrepos <- renv_bioconductor_repos(project = project, version = version)

  # put it all together
  allrepos <- c(repos, biocrepos)

  # activate repositories in this context
  renv_scope_options(repos = renv_vector_unique(allrepos), .envir = .envir)
}

renv_scope_lock <- function(path = NULL,
                            ...,
                            project = NULL) {

  if (!config$locking.enabled())
    return(TRUE)

  path <- path %||% renv_lock_path(project)
  ensure_parent_directory(path)

  callback <- renv_lock_create(path)
  defer(callback(), envir = parent.frame())

}

renv_scope_trace <- function(what, tracer, ..., .envir = NULL) {

  .envir <- .envir %||% parent.frame()

  call <- sys.call()
  call[[1L]] <- base::trace
  call[["print"]] <- FALSE
  eval(call, envir = parent.frame())

  defer(untrace(substitute(what)), envir = .envir)

}

renv_scope_var <- function(key, value, envir, ..., .envir = NULL) {

  .envir <- .envir %||% parent.frame()

  if (exists(key, envir = envir, inherits = FALSE)) {
    saved <- get(key, envir = envir, inherits = FALSE)
    assign(key, value, envir = envir, inherits = FALSE)
    defer(assign(key, saved, envir = envir, inherits = FALSE), envir = .envir)
  } else {
    assign(key, value, envir = envir, inherits = FALSE)
    defer(rm(list = key, envir = envir, inherits = FALSE), envir = .envir)
  }

}

renv_scope_tempfile <- function(pattern = "renv-tempfile-",
                                tmpdir  = tempdir(),
                                fileext = "",
                                .envir  = NULL)
{
  filepath <- tempfile(pattern, tmpdir, fileext)

  .envir <- .envir %||% parent.frame()
  defer(unlink(filepath, recursive = TRUE, force = TRUE), envir = .envir)

  invisible(filepath)
}

renv_session_quiet <- function() {

  args <- commandArgs(trailingOnly = FALSE)

  index <- match("--args", args)
  if (!is.na(index))
    args <- head(args, n = index - 1L)

  quiet <- c("-s", "--slave", "--no-echo")
  any(quiet %in% args)

}

`_renv_settings` <- new.env(parent = emptyenv())

renv_settings_default <- function(name) {
  default <- `_renv_settings`[[name]]$default
  renv_options_override("renv.settings", name, default)
}

renv_settings_defaults <- function() {

  keys <- ls(envir = `_renv_settings`, all.names = TRUE)
  vals <- lapply(keys, renv_settings_default)
  names(vals) <- keys
  vals[order(names(vals))]

}

renv_settings_validate <- function(name, value) {

  # NULL implies restore default value
  if (is.null(value))
    return(renv_settings_default(name))

  # otherwise, validate the user-provided value
  validate <- `_renv_settings`[[name]]$validate
  ok <- case(
    is.character(validate) ~ value %in% validate,
    is.function(validate)  ~ validate(value),
    TRUE
  )

  if (identical(ok, TRUE))
    return(value)

  # validation failed; warn the user and use default
  fmt <- "%s is an invalid value for setting '%s'; using default %s instead"
  default <- renv_settings_default(name)
  warningf(fmt, deparsed(value), name, deparsed(default))
  default

}

renv_settings_decode <- function(name, value) {

  # TODO: consider custom decoders per-setting
  decoded <- case(
    value == "NULL"  ~ NULL,
    value == "NA"    ~ NA,
    value == "NaN"   ~ NaN,
    value == "TRUE"  ~ TRUE,
    value == "FALSE" ~ FALSE,
    ~ strsplit(value, "\\s*,\\s*")[[1]]
  )

  renv_settings_validate(name, decoded)

}

renv_settings_read <- function(path) {
  filebacked("settings", path, renv_settings_read_impl)
}

renv_settings_read_impl <- function(path) {

  # check that file exists
  if (!file.exists(path))
    return(NULL)

  # try to read it
  dcf <- catch(renv_dcf_read(path))
  if (inherits(dcf, "error")) {
    warning(dcf)
    return(NULL)
  }

  # keep only known settings
  known <- ls(envir = `_renv_settings`, all.names = TRUE)
  dcf <- keep(dcf, known)

  # decode encoded values
  settings <- enumerate(dcf, renv_settings_decode)

  # merge in defaults
  defaults <- renv_settings_defaults()
  missing <- renv_vector_diff(names(defaults), names(settings))
  settings[missing] <- defaults[missing]

  # and return
  settings

}

renv_settings_get <- function(project, name = NULL) {

  # when 'name' is NULL, return all settings
  if (is.null(name)) {
    names <- ls(envir = `_renv_settings`, all.names = TRUE)
    settings <- lapply(names, renv_settings_get, project = project)
    names(settings) <- names
    return(settings[order(names(settings))])
  }

  # check for an override via option
  override <- renv_options_override("renv.settings", name)
  if (!is.null(override))
    return(override)

  # try to read settings file
  path <- renv_settings_path(project)
  settings <- renv_settings_read(path)
  if (!is.null(settings))
    return(settings[[name]])

  # no value recorded; use default
  renv_settings_default(name)

}

renv_settings_set <- function(project, name, value, persist = TRUE) {

  # read old settings
  settings <- renv_settings_get(project)

  # update setting value
  old <- settings[[name]] %||% renv_settings_default(name)
  new <- renv_settings_validate(name, value)
  settings[[name]] <- new

  # persist if requested
  if (persist)
    renv_settings_persist(project, settings)

  # save session-cached value
  path <- renv_settings_path(project)
  value <- renv_filebacked_set("settings", path, settings)

  # invoke update callback if value changed
  if (!identical(old, new))
    renv_settings_updated(project, name, old, new)

  # return value
  invisible(value)

}

renv_settings_updated <- function(project, name, old, new) {
  update <- `_renv_settings`[[name]]$update %||% function(...) {}
  update(project, old, new)
}

renv_settings_persist <- function(project, settings) {

  path <- renv_settings_path(project)
  settings <- settings[order(names(settings))]
  settings <- lapply(settings, paste, collapse = ", ")

  ensure_parent_directory(path)
  dcf <- as.data.frame(settings, stringsAsFactors = FALSE)
  renv_dcf_write(dcf, path)

}

renv_settings_merge <- function(settings, merge) {
  settings[names(merge)] <- merge
  settings
}

renv_settings_path <- function(project) {
  renv_paths_settings(project = project)
}


# nocov start

renv_settings_updated_cache <- function(project, old, new) {

  # if the cache is being disabled, then copy packages from their
  # symlinks back into the library. note that we don't use symlinks
  # on windows (we use hard links) so in that case there's nothing
  # to be done
  if (renv_platform_windows())
    return(FALSE)

  library <- renv_paths_library(project = project)
  pkgpaths <- list.files(library, full.names = TRUE)
  cachepaths <- map_chr(pkgpaths, renv_cache_path)
  names(pkgpaths) <- cachepaths

  if (empty(pkgpaths)) {
    fmt <- "* The cache has been %s for this project."
    vwritef(fmt, if (new) "enabled" else "disabled")
    return(TRUE)
  }

  vprintf("* Synchronizing project library with the cache ... ")

  if (new) {

    # enabling the cache: for any package in the project library, replace
    # that copy with a symlink into the cache, moving the associated package
    # into the cache if appropriate

    # ignore existing symlinks; only copy 'real' packages into the cache
    pkgtypes <- renv_file_type(pkgpaths)
    cachepaths <- cachepaths[pkgtypes != "symlink"]

    # move packages from project library into cache
    callback <- renv_progress_callback(renv_cache_move, length(cachepaths))
    enumerate(cachepaths, callback, overwrite = FALSE)

  } else {

    # disabling the cache: for any package which is a symlink into the cache,
    # replace that symlink with a copy of the cached package

    # figure out which package directories are symlinks
    pkgtypes <- renv_file_type(pkgpaths)
    pkgpaths <- pkgpaths[pkgtypes == "symlink"]

    # remove the existing symlinks
    unlink(pkgpaths)

    # overwrite these symlinks with packages from the cache
    callback <- renv_progress_callback(renv_file_copy, length(pkgpaths))
    enumerate(pkgpaths, callback, overwrite = TRUE)

  }

  vwritef("Done!")

  fmt <- "* The cache has been %s for this project."
  vwritef(fmt, if (new) "enabled" else "disabled")

}

renv_settings_updated_ignore <- function(project, old, new) {
  renv_infrastructure_write_gitignore(project = project)
}



renv_settings_impl <- function(name, validate, default, update) {

  force(name)

  `_renv_settings`[[name]] <- list(
    validate = validate,
    default = default,
    update = update
  )

  function(value, project = NULL, persist = TRUE) {
    project <- renv_project_resolve(project)
    if (missing(value))
      renv_settings_get(project, name)
    else
      renv_settings_set(project, name, value, persist)
  }

}

# nocov end

#' Project Settings
#'
#' Define project-local settings that can be used to adjust the behavior of
#' `renv` with your particular project.
#'
#' @section Settings:
#'
#' \describe{
#'
#' \item{\code{bioconductor.version}}{
#'
#'   The Bioconductor version to be used with this project. Use this if you'd
#'   like to lock the version of Bioconductor used on a per-project basis.
#'   When unset, `renv` will try to infer the appropriate Bioconductor release
#'   using the `BiocVersion` package if installed; if not, `renv` uses
#'   `BiocManager::version()` to infer the appropriate Bioconductor version.
#'
#' }
#'
#' \item{\code{external.libraries}}{
#'
#'   A vector of library paths, to be used in addition to the project's own
#'   private library. This can be useful if you have a package available for use
#'   in some global library, but for some reason `renv` is not able to install
#'   that package (e.g. sources or binaries for that package are not publicly
#'   available, or you have been unable to orchestrate the pre-requisites for
#'   installing some packages from source on your machine).
#'
#' }
#'
#' \item{\code{ignored.packages}}{
#'
#'   A vector of packages, which should be ignored when attempting to snapshot
#'   the project's private library. Note that if a package has already been
#'   added to the lockfile, that entry in the lockfile will not be ignored.
#'
#' }
#'
#' \item{\code{package.dependency.fields}}{
#'
#'   During dependency discovery, `renv` uses the fields of an installed
#'   package's `DESCRIPTION` file to determine that package's recursive
#'   dependencies. By default, the `Imports`, `Depends` and `LinkingTo` fields
#'   are used. If you'd prefer that `renv` also captures the `Suggests`
#'   dependencies for a package, you can set this to
#'   `c("Imports", "Depends", "LinkingTo", "Suggests")`.
#'
#' }
#'
#' \item{\code{r.version}}{
#'
#'   The version of \R to encode within the lockfile. This can be set as a
#'   project-specific option if you'd like to allow multiple users to use
#'   the same \code{renv} project with different versions of \R. `renv` will
#'   still warn the user if the major + minor version of \R used in a project
#'   does not match what is encoded in the lockfile.
#'
#' }
#'
#' \item{\code{snapshot.type}}{
#'
#'   The type of snapshot to perform by default. See [snapshot] for more
#'   details.
#'
#' }
#'
#' \item{\code{use.cache}}{
#'
#'   Enable the `renv` package cache with this project. When active, `renv` will
#'   install packages into a global cache, and link packages from the cache into
#'   your `renv` projects as appropriate. This can greatly save on disk space
#'   and install time when for \R packages which are used across multiple
#'   projects in the same environment.
#'
#' }
#'
#' \item{\code{vcs.ignore.cellar}}{
#'
#'   Set whether packages within a project-local package cellar are excluded
#'   from version control. See `vignette("cellar", package = "renv")` for
#'   more information.
#'
#' }
#'
#' \item{\code{vcs.ignore.library}}{
#'
#'   Set whether the `renv` project library is excluded from version control.
#'
#' }
#'
#' \item{\code{vcs.ignore.local}}{
#'
#'   Set whether `renv` project-specific local sources are excluded from version
#'   control.
#'
#' }
#'
#' }
#'
#' @section Defaults:
#'
#' You can change the default values of these settings for newly-created `renv`
#' projects by setting \R options for `renv.settings` or `renv.settings.<name>`.
#' For example:
#'
#' \preformatted{
#' options(renv.settings = list(snapshot.type = "all"))
#' options(renv.settings.snapshot.type = "all")
#' }
#'
#' If both of the `renv.settings` and `renv.settings.<name>` options are set
#' for a particular key, the option associated with `renv.settings.<name>` is
#' used instead. We recommend setting these in an appropriate startup profile,
#' e.g. `~/.Rprofile` or similar.
#'
#' @export
#'
#' @examples
#'
#' \dontrun{
#'
#' # view currently-ignored packaged
#' renv::settings$ignored.packages()
#'
#' # ignore a set of packages
#' renv::settings$ignored.packages("devtools", persist = FALSE)
#'
#' }
settings <- list(

  bioconductor.version = renv_settings_impl(
    name     = "bioconductor.version",
    validate = is.character,
    default  = character(),
    update   = NULL
  ),

  ignored.packages = renv_settings_impl(
    name     = "ignored.packages",
    validate = is.character,
    default  = character(),
    update   = NULL
  ),

  external.libraries = renv_settings_impl(
    name     = "external.libraries",
    validate = is.character,
    default  = character(),
    update   = NULL
  ),

  package.dependency.fields = renv_settings_impl(
    name     = "package.dependency.fields",
    validate = is.character,
    default  = c("Imports", "Depends", "LinkingTo"),
    update   = NULL
  ),

  r.version = renv_settings_impl(
    name     = "r.version",
    validate = is.character,
    default  = character(),
    update   = NULL
  ),

  snapshot.type = renv_settings_impl(
    name     = "snapshot.type",
    validate = c("all", "custom", "implicit", "explicit", "packrat", "simple"),
    default  = "implicit",
    update   = NULL
  ),

  use.cache = renv_settings_impl(
    name     = "use.cache",
    validate = is.logical,
    default  = TRUE,
    update   = renv_settings_updated_cache
  ),

  vcs.ignore.cellar = renv_settings_impl(
    name     = "vcs.ignore.cellar",
    validate = is.logical,
    default  = TRUE,
    update   = renv_settings_updated_ignore
  ),

  vcs.ignore.library = renv_settings_impl(
    name     = "vcs.ignore.library",
    validate = is.logical,
    default  = TRUE,
    update   = renv_settings_updated_ignore
  ),

  vcs.ignore.local = renv_settings_impl(
    name     = "vcs.ignore.local",
    validate = is.logical,
    default  = TRUE,
    update   = renv_settings_updated_ignore
  )

)

renv_shell_quote <- function(x) {
  if (length(x))
    shQuote(x)
}

renv_shell_path <- function(x) {
  if (length(x))
    shQuote(path.expand(x))
}

`_renv_shims` <- new.env(parent = emptyenv())

renv_shim_install_packages <- function(pkgs, ...) {

  # place Rtools on PATH
  renv_scope_rtools()

  # currently we only handle the case where only 'pkgs' was specified
  if (missing(pkgs) || nargs() != 1) {
    call <- sys.call()
    call[[1L]] <- quote(utils::install.packages)
    return(eval(call, envir = parent.frame()))
  }

  # otherwise, we get to handle it
  install(pkgs)

}

renv_shim_update_packages <- function(lib.loc = NULL, ...) {

  # handle only 0-argument case
  if (nargs() != 0) {
    call <- sys.call()
    call[[1L]] <- quote(utils::update.packages)
    return(eval(call, envir = parent.frame()))
  }

  update(library = lib.loc)

}

renv_shim_remove_packages <- function(pkgs, lib) {

  # handle single-argument case
  if (nargs() != 1) {
    call <- sys.call()
    call[[1L]] <- quote(utils::remove.packages)
    return(eval(call, envir = parent.frame()))
  }

  remove(pkgs)

}

renv_shim_create <- function(shim, sham) {
  formals(shim) <- formals(sham)
  shim
}

renv_shims_enabled <- function(project) {
  config$shims.enabled()
}

renv_shims_activate <- function() {

  renv_shims_deactivate()

  install_shim <- renv_shim_create(renv_shim_install_packages, utils::install.packages)
  assign("install.packages", install_shim, envir = `_renv_shims`)

  update_shim <- renv_shim_create(renv_shim_update_packages, utils::update.packages)
  assign("update.packages", update_shim, envir = `_renv_shims`)

  remove_shim <- renv_shim_create(renv_shim_remove_packages, utils::remove.packages)
  assign("remove.packages", remove_shim, envir = `_renv_shims`)

  args <- list(`_renv_shims`, name = "renv:shims", warn.conflicts = FALSE)
  do.call(base::attach, args)

}

renv_shims_deactivate <- function() {
  while ("renv:shims" %in% search())
    detach("renv:shims")
}

skip_if_no_python <- function(python = NULL) {

  python <- python %||% "python3"
  key <- paste("tests", python, "installed", sep = ".")
  installed <- renv_global(key, {
    python <- Sys.which(python)
    nzchar(python)
  })

  if (installed)
    return(TRUE)

  testthat::skip("python is not installed")

}

skip_if_no_virtualenv <- function(python = NULL) {

  skip_if_no_python(python)

  key <- paste("tests", python, "virtualenv.installed", sep = ".")
  installed <- renv_global(key, {
    version <- renv_python_version(python)
    module <- if (numeric_version(version) >= "3.2") "venv" else "virtualenv"
    renv_python_module_available(python, module)
  })

  if (!installed)
    testthat::skip("virtualenv module not installed")

  TRUE

}

skip_if_no_miniconda <- function(python) {

  skip_if_no_python(python)
  testthat::skip_if_not_installed("reticulate", "1.13.0.9002")

  # gymnastics for CRAN checks before next release of reticulate
  if (requireNamespace("reticulate", quietly = TRUE)) {
    reticulate <- asNamespace("reticulate")
    if (is.function(reticulate$miniconda_path)) {
      path <- reticulate$miniconda_path()
      if (!file.exists(path))
        testthat::skip("miniconda is not installed")
    }
  }

  TRUE

}

skip_sometimes <- function(freq = 0.80) {
  threshold <- sample.int(100L, size = 1L)
  testthat::skip_if(freq * 100 >= threshold)
}

`_renv_snapshot_auto` <- new.env(parent = emptyenv())
`_renv_library_state` <- new.env(parent = emptyenv())

# nocov start
renv_snapshot_auto <- function(project) {

  # set some state so we know we're running
  renv_scope_var("running", TRUE, envir = `_renv_snapshot_auto`)

  # passed pre-flight checks; snapshot the library
  # validation messages can be noisy; turn off for auto snapshot
  status <- catch(renv_snapshot_auto_impl(project))
  if (inherits(status, "error"))
    return(FALSE)

  lockfile <- renv_lockfile_path(project = project)
  vwritef("* Automatic snapshot has updated '%s'.", aliased_path(lockfile))
  TRUE

}

renv_snapshot_auto_impl <- function(project) {

  # be quiet during auto snapshot
  renv_scope_options(
    renv.config.snapshot.validate = FALSE,
    renv.verbose = FALSE
  )

  # perform snapshot without prompting
  snapshot(project = project, prompt = FALSE)

}

renv_snapshot_auto_enabled <- function(project) {

  # don't auto-snapshot if disabled by user
  enabled <- config$auto.snapshot()
  if (!enabled)
    return(FALSE)

  # only automatically snapshot the current project
  if (!identical(project, renv_project(default = NULL)))
    return(FALSE)

  # don't auto-snapshot if the project hasn't been initialized
  if (!renv_project_initialized(project = project))
    return(FALSE)

  # don't auto-snapshot if we don't have a library
  library <- renv_paths_library(project = project)
  if (!file.exists(library))
    return(FALSE)

  # don't auto-snapshot unless the active library is the project library
  if (!renv_file_same(renv_libpaths_default(), library))
    return(FALSE)

  TRUE

}

renv_snapshot_auto_update <- function(project) {

  # check for enabled
  if (!renv_snapshot_auto_enabled(project = project))
    return(FALSE)

  # get path to project library
  libpath <- renv_paths_library(project = project)
  if (!file.exists(libpath))
    return(FALSE)

  # list files + get file info for files in project library
  info <- renv_file_info(libpath)

  # only keep relevant fields
  fields <- c("size", "mtime", "ctime")
  new <- c(info[fields])

  # update our cached info
  old <- `_renv_library_state`[["info"]]
  `_renv_library_state`[["info"]] <- new

  # if we've suppressed the next automatic snapshot, bail here
  suppressed <- `_renv_snapshot_auto`[["suppressed"]] %||% FALSE
  if (suppressed) {
    `_renv_snapshot_auto`[["suppressed"]] <- FALSE
    return(FALSE)
  }

  # report if things have changed
  !is.null(old) && !identical(old, new)

}

renv_snapshot_auto_callback <- function(...) {
  renv_snapshot_auto_callback_impl()
  TRUE
}

renv_snapshot_auto_callback_impl <- function() {

  # check for active renv project
  project <- Sys.getenv("RENV_PROJECT", unset = NA)
  if (is.na(project))
    return(FALSE)

  # see if library state has updated
  updated <- renv_snapshot_auto_update(project = project)
  if (!updated)
    return(FALSE)

  # library has updated; perform auto snapshot
  renv_snapshot_auto(project = project)
  TRUE

}

renv_snapshot_auto_suppress_next <- function() {

  # if we're currently running an automatic snapshot, then nothing to do
  running <- `_renv_snapshot_auto`[["running"]]
  if (identical(running, TRUE))
    return()

  # otherwise, set the suppressed flag
  `_renv_snapshot_auto`[["suppressed"]] <- TRUE

}

# nocov end

#' Snapshot a Project
#'
#' Call `snapshot()` to create a **lockfile** capturing the state of a project's
#' \R package dependencies. The lockfile can be used to later restore these
#' project's dependencies as required.
#'
#' See the [lockfile] documentation for more details on the structure of a
#' lockfile.
#'
#' @section Snapshot Type:
#'
#' Depending on how you prefer to manage dependencies, you might prefer
#' selecting a different snapshot mode. The modes available are as follows:
#'
#' \describe{
#'
#' \item{`"all"`}{
#' Capture all packages within the active \R libraries in the lockfile.
#' This is the quickest and simplest method, but may lead to undesired
#' packages (e.g. development dependencies) entering the lockfile.
#' }
#'
#' \item{`"implicit"`}{
#' Only capture packages which appear to be used in your project in the
#' lockfile. The intersection of packages installed in your \R libraries,
#' alongside those used in your \R code as inferred by `renv::dependencies()`,
#' will enter the lockfile. This helps ensure that only the packages your
#' project requires will enter the lockfile, but may be slower if your project
#' contains a large number of files. If this becomes an issue, you might
#' consider using `.renvignore` files to limit which files `renv` uses for
#' dependency discovery, or explicitly declaring your required dependencies in a
#' `DESCRIPTION` file. You can also force a dependency on a particular package
#' by writing e.g. `library(<package>)` into a file called `dependencies.R`.
#' }
#'
#' \item{`"explicit"`}{
#' Only capture packages which are explicitly listed in the project
#' `DESCRIPTION` file. This workflow is recommended for users who wish to
#' manage their project's \R package dependencies directly.
#' }
#'
#' \item{`"custom"`}{
#' Like `"implicit"`, but use a custom user-defined filter instead. The filter
#' should be specified by the \R option `renv.snapshot.filter`, and should
#' either be a character vector naming a function (e.g. `"package::method"`),
#' or be a function itself. The function should only accept one argument (the
#' project directory), and should return a vector of package names to include
#' in the lockfile.
#' }
#'
#' }
#'
#' By default, `"implicit"`-style snapshots are used. The snapshot type can be
#' configured on a project-specific basis using the `renv` project [settings]
#' mechanism. For example, to use `"explicit"` snapshots in a project:
#'
#' ```
#' renv::settings$snapshot.type("explicit")
#' ````
#'
#' When the `packages` argument is set, `type` is ignored, and instead only the
#' requested set of packages, and their recursive dependencies, will be written
#' to the lockfile.
#'
#' @inherit renv-params
#'
#' @param library The \R libraries to snapshot. When `NULL`, the active \R
#'   libraries (as reported by `.libPaths()`) are used.
#'
#' @param lockfile The location where the generated lockfile should be written.
#'   By default, the lockfile is written to a file called `renv.lock` in the
#'   project directory. When `NULL`, the lockfile (as an \R object) is returned
#'   directly instead.
#'
#' @param type The type of snapshot to perform. See **Snapshot Type** for
#'   more details.
#'
#' @param repos The \R repositories to be recorded in the lockfile. Defaults
#'   to the currently active package repositories, as retrieved by
#'   `getOption("repos")`.
#'
#' @param packages A vector of packages to be included in the lockfile. When
#'   `NULL` (the default), all packages relevant for the type of snapshot being
#'   performed will be included. When set, the `type` argument is ignored.
#'   Recursive dependencies of the specified packages will be added to the
#'   lockfile as well.
#'
#' @param update Boolean; if the lockfile already exists, then attempt to update
#'   that lockfile without removing any prior package records.
#'
#' @param force Boolean; force generation of a lockfile even when pre-flight
#'   validation checks have failed?
#'
#' @param reprex Boolean; generate output appropriate for embedding the lockfile
#'   as part of a [reprex](https://www.tidyverse.org/help/#reprex)?
#'
#' @return The generated lockfile, as an \R object (invisibly). Note that
#'   this function is normally called for its side effects.
#'
#' @family reproducibility
#'
#' @export
#'
#' @example examples/examples-init.R
snapshot <- function(project  = NULL,
                     ...,
                     library  = NULL,
                     lockfile = paths$lockfile(project = project),
                     type     = settings$snapshot.type(project = project),
                     repos    = getOption("repos"),
                     packages = NULL,
                     prompt   = interactive(),
                     update   = FALSE,
                     force    = FALSE,
                     reprex   = FALSE)
{
  renv_consent_check()
  renv_scope_error_handler()
  renv_dots_check(...)

  renv_snapshot_auto_suppress_next()

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  repos <- renv_repos_validate(repos)
  renv_scope_options(repos = repos)

  if (!is.null(lockfile))
    renv_activate_prompt("snapshot", library, prompt, project)

  libpaths <- library %||% renv_libpaths_all()
  if (config$snapshot.validate())
    renv_snapshot_preflight(project, libpaths)

  # when packages is set, we treat this as an 'all' type snapshot, but
  # with explicit package filters turned on
  if (!is.null(packages)) {

    if (!missing(type)) {
      fmt <- "packages argument is set; type argument %s will be ignored"
      warningf(fmt, renv_deparse(type))
    }

    type <- "packages"

  }

  alt <- new <- renv_lockfile_create(project, libpaths, type, packages)
  if (is.null(lockfile))
    return(new)

  # if running as part of 'reprex', then render output inline
  if (reprex)
    return(renv_snapshot_reprex(new))

  # get prior lockfile state
  old <- list()
  if (file.exists(lockfile)) {

    # read a pre-existing lockfile (if any)
    old <- renv_lockfile_read(lockfile)

    # preserve records from alternate OSes in lockfile
    alt <- renv_snapshot_preserve(old, new)

    # check if there are any changes in the lockfile
    diff <- renv_lockfile_diff(old, alt)
    if (empty(diff)) {
      vwritef("* The lockfile is already up to date.")
      return(renv_snapshot_successful(alt, prompt, project))
    }

  }

  # check for missing dependencies and warn if any are discovered
  # (note: use 'new' rather than 'alt' here as we don't want to attempt
  # validation on uninstalled packages)
  validated <- renv_snapshot_validate(project, new, libpaths)
  if (!validated && !force) {
    if (prompt && !proceed()) {
      renv_report_user_cancel()
      return(invisible(alt))
    } else if (!interactive()) {
      stop("aborting snapshot due to pre-flight validation failure")
    }
  }

  # update new reference
  new <- alt

  # if we're only updating the lockfile, then merge any missing records
  # from 'old' back into 'new'
  if (update)
    for (package in names(old$Packages))
      new$Packages[[package]] <- new$Packages[[package]] %||% old$Packages[[package]]

  # report actions to the user
  actions <- renv_lockfile_diff_packages(old, new)
  if (prompt || renv_verbose())
    renv_snapshot_report_actions(actions, old, new)

  # request user confirmation

  # nocov start
  if (length(actions) && prompt && !proceed()) {
    renv_report_user_cancel()
    return(invisible(new))
  }
  # nocov end

  # write it out
  ensure_parent_directory(lockfile)
  renv_lockfile_write(new, file = lockfile)
  vwritef("* Lockfile written to '%s'.", aliased_path(lockfile))

  # ensure the lockfile is .Rbuildignore-d
  renv_infrastructure_write_rbuildignore(project)

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

  # return new records
  renv_snapshot_successful(new, prompt, project)
}

renv_snapshot_preserve <- function(old, new) {
  records <- filter(old$Packages, renv_snapshot_preserve_impl)
  if (length(records))
    new$Packages[names(records)] <- records
  new
}

renv_snapshot_preserve_impl <- function(record) {

  ostype <- tolower(record[["OS_type"]] %||% "")
  if (!nzchar(ostype))
    return(FALSE)

  altos <- if (renv_platform_unix()) "windows" else "unix"
  identical(ostype, altos)

}

renv_snapshot_preflight <- function(project, libpaths) {
  lapply(libpaths, renv_snapshot_preflight_impl, project = project)
}

renv_snapshot_preflight_impl <- function(project, library) {
  renv_snapshot_preflight_library_exists(project, library)
}

renv_snapshot_preflight_library_exists <- function(project, library) {

  # check that we have a directory
  type <- renv_file_type(library, symlinks = FALSE)
  if (type == "directory")
    return(TRUE)

  # if the file exists but isn't a directory, fail
  if (nzchar(type)) {
    fmt <- "library '%s' exists but is not a directory"
    stopf(fmt, aliased_path(library))
  }

  # the directory doesn't exist; perhaps the user hasn't called init
  if (identical(library, renv_paths_library(project = project))) {
    fmt <- "project '%s' has no private library -- have you called `renv::init()`?"
    stopf(fmt, aliased_path(project))
  }

  # user tried to snapshot arbitrary but missing path
  fmt <- "library '%s' does not exist; cannot proceed"
  stopf(fmt, aliased_path(library))

}

renv_snapshot_validate <- function(project, lockfile, libpaths) {

  # allow user to disable snapshot validation, just in case
  enabled <- config$snapshot.validate()
  if (!enabled)
    return(TRUE)

  methods <- list(
    renv_snapshot_validate_bioconductor,
    renv_snapshot_validate_dependencies_available,
    renv_snapshot_validate_dependencies_compatible,
    renv_snapshot_validate_sources
  )

  ok <- map_lgl(methods, function(method) {
    tryCatch(
      method(project, lockfile, libpaths),
      error = function(e) { warning(e); FALSE }
    )
  })

  all(ok)

}

# nocov start
renv_snapshot_validate_bioconductor <- function(project, lockfile, libpaths) {

  ok <- TRUE

  # check whether any packages are installed from Bioconductor
  records <- renv_records(lockfile)
  sources <- extract_chr(records, "Source")
  if (!"Bioconductor" %in% sources)
    return(ok)

  # check for BiocManager or BiocInstaller
  package <- if (getRversion() >= "3.5.0") "BiocManager" else "BiocInstaller"
  if (!package %in% names(records)) {

    text <- c(
      "One or more Bioconductor packages are used in your project,",
      "but the %s package is not available.",
      "",
      "Consider installing %s before snapshot.",
      ""
    )

    if (!renv_tests_running())
      writeLines(sprintf(text, package))

    ok <- FALSE
  }

  # check that Bioconductor packages are from correct release
  version <-
    lockfile$Bioconductor$Version %||%
    renv_bioconductor_version(project = project)

  biocrepos <- renv_bioconductor_repos(version = version)
  renv_scope_options(repos = biocrepos)

  # collect Bioconductor records
  bioc <- records %>%
    filter(function(record) renv_record_source(record) == "bioconductor") %>%
    map(function(record) record[c("Package", "Version")]) %>%
    bind()

  # collect latest versions of these packages
  bioc$Latest <- vapply(bioc$Package, function(package) {
    entry <- catch(renv_available_packages_latest(package))
    if (inherits(entry, "error"))
      return("<NA>")
    entry$Version
  }, FUN.VALUE = character(1))

  # check for version mismatches (allow mismatch in minor version)
  bioc$Mismatch <- mapply(function(current, latest) {

    if (identical(latest, "<NA>"))
      return(TRUE)

    current <- unclass(package_version(current))[[1]]
    latest <- unclass(package_version(latest))[[1]]
    current[[1]] != latest[[1]] || current[[2]] != latest[[2]]

  }, bioc$Version, bioc$Latest)

  bad <- bioc[bioc$Mismatch, ]
  if (nrow(bad)) {

    fmt <- "%s [installed %s != latest %s]"
    msg <- sprintf(fmt, format(bad$Package), format(bad$Version), bad$Latest)

    if (!renv_tests_running()) {
      renv_pretty_print(
        msg,
        "The following Bioconductor packages appear to be from a separate Bioconductor release:",
        c(
          "renv may be unable to restore these packages.",
          paste("Bioconductor version:", version)
        ),
        wrap = FALSE
      )
    }

    ok <- FALSE
  }

  ok

}
# nocov end

renv_snapshot_validate_dependencies_available <- function(project, lockfile, libpaths) {

  # use library to collect package dependency versions
  records <- renv_records(lockfile)
  packages <- extract_chr(records, "Package")
  locs <- find.package(packages, lib.loc = libpaths, quiet = TRUE)
  deps <- bapply(locs, renv_dependencies_discover_description)
  if (empty(deps))
    return(TRUE)

  splat <- split(deps, deps$Package)

  # exclude base R packages
  splat <- splat[renv_vector_diff(names(splat), renv_packages_base())]

  # check for required packages not currently installed
  requested <- names(splat)
  missing <- renv_vector_diff(requested, packages)
  if (empty(missing))
    return(TRUE)

  # exclude ignored packages
  missing <- renv_vector_diff(missing, settings$ignored.packages(project = project))
  if (empty(missing))
    return(TRUE)

  usedby <- map_chr(missing, function(package) {

    revdeps <- sort(unique(basename(deps$Source)[deps$Package == package]))

    items <- revdeps; limit <- 3
    if (length(revdeps) > limit) {
      rest <- length(revdeps) - limit
      suffix <- paste("and", length(revdeps) - 3, plural("other", rest))
      items <- c(revdeps[seq_len(limit)], suffix)
    }

    paste(items, collapse = ", ")

  })

  if (!renv_tests_running()) {
    renv_pretty_print(
      sprintf("%s  [required by %s]", format(missing), usedby),
      "The following required packages are not installed:",
      "Consider reinstalling these packages before snapshotting the lockfile.",
      wrap = FALSE
    )
  }

  FALSE

}

renv_snapshot_validate_dependencies_compatible <- function(project, lockfile, libpaths) {

  # use library to collect package dependency versions
  records <- renv_records(lockfile)
  packages <- extract_chr(records, "Package")
  locs <- find.package(packages, lib.loc = libpaths, quiet = TRUE)
  deps <- bapply(locs, renv_dependencies_discover_description)
  if (empty(deps))
    return(TRUE)

  splat <- split(deps, deps$Package)

  # exclude base R packages
  splat <- splat[renv_vector_diff(names(splat), renv_packages_base())]

  # collapse requirements for each package
  bad <- enumerate(splat, function(package, requirements) {

    # skip NULL records (should be handled above)
    record <- records[[package]]
    if (is.null(record))
      return(NULL)

    version <- record$Version

    # drop packages without explicit version requirement
    requirements <- requirements[nzchar(requirements$Require), ]
    if (nrow(requirements) == 0)
      return(NULL)

    # add in requested version
    requirements$Requested <- version

    # generate expressions to evaluate
    fmt <- "package_version('%s') %s package_version('%s')"
    code <- with(requirements, sprintf(fmt, Requested, Require, Version))
    parsed <- parse(text = code)
    ok <- map_lgl(parsed, eval, envir = baseenv())

    # return requirements that weren't satisfied
    requirements[!ok, ]

  })

  bad <- bind(bad)
  if (empty(bad))
    return(TRUE)

  package  <- basename(bad$Source)
  requires <- sprintf("%s (%s %s)", bad$Package, bad$Require, bad$Version)
  request  <- bad$Requested

  fmt <- "%s requires %s, but version %s is installed"
  txt <- sprintf(fmt, format(package), format(requires), format(request))

  if (!renv_tests_running()) {
    renv_pretty_print(
      txt,
      "The following package(s) have unsatisfied dependencies:",
      "Consider updating the required dependencies as appropriate.",
      wrap = FALSE
    )
  }

  renv_condition_signal("renv.snapshot.unsatisfied_dependencies")
  FALSE

}

renv_snapshot_validate_sources <- function(project, lockfile, libpaths) {
  records <- renv_records(lockfile)
  renv_check_unknown_source(records, project)
}

# NOTE: if packages are found in multiple libraries,
# then the first package found in the library paths is
# kept and others are discarded
renv_snapshot_r_packages <- function(libpaths = NULL,
                                     project  = NULL)
{
  records <- uapply(
    libpaths,
    renv_snapshot_r_packages_impl,
    project = project
  )

  dupes <- duplicated(names(records))
  records[!dupes]
}

renv_snapshot_r_packages_impl <- function(library = NULL,
                                          project = NULL)
{
  # list packages in the library
  library <- renv_path_normalize(library %||% renv_libpaths_default())
  paths <- list.files(library, full.names = TRUE)

  # remove 'base' packages
  paths <- paths[!basename(paths) %in% renv_packages_base()]

  # remove ignored packages
  ignored <- renv_project_ignored_packages(project = project)
  paths <- paths[!basename(paths) %in% ignored]

  # remove paths that are not valid package names
  pattern <- sprintf("^%s$", .standard_regexps()$valid_package_name)
  paths <- paths[grep(pattern, basename(paths))]

  # validate the remaining set of packages
  valid <- renv_snapshot_r_library_diagnose(library, paths)

  # remove duplicates (so only first package entry discovered in library wins)
  duplicated <- duplicated(basename(valid))
  packages <- valid[!duplicated]

  # snapshot description files
  descriptions <- file.path(packages, "DESCRIPTION")
  records <- lapply(descriptions, renv_snapshot_description)
  names(records) <- basename(packages)

  # report any snapshot failures
  broken <- Filter(function(record) inherits(record, "error"), records)
  if (length(broken)) {

    messages <- map_chr(broken, conditionMessage)
    text <- sprintf("'%s': %s", names(broken), messages)

    renv_pretty_print(
      text,
      "renv was unable to snapshot the following packages:",
      "These packages will likely need to be repaired and / or reinstalled."
    )

    stopf("snapshot of library %s failed", renv_path_pretty(library))

  }

  # name results and return
  names(records) <- map_chr(records, `[[`, "Package")
  records

}

renv_snapshot_r_library_diagnose <- function(library, pkgs) {

  pkgs <- grep("00LOCK", pkgs, invert = TRUE, value = TRUE)
  pkgs <- renv_snapshot_r_library_diagnose_broken_link(library, pkgs)
  pkgs <- renv_snapshot_r_library_diagnose_tempfile(library, pkgs)
  pkgs <- renv_snapshot_r_library_diagnose_missing_description(library, pkgs)
  pkgs

}

renv_snapshot_r_library_diagnose_broken_link <- function(library, pkgs) {

  broken <- !file.exists(pkgs)
  if (!any(broken))
    return(pkgs)

  renv_pretty_print(
    basename(pkgs)[broken],
    "The following package(s) have broken symlinks into the cache:",
    "Use `renv::repair()` to try and reinstall these packages."
  )

  pkgs[!broken]

}

renv_snapshot_r_library_diagnose_tempfile <- function(library, pkgs) {

  names <- basename(pkgs)
  missing <- grepl("^file(?:\\w){12}", names)
  if (!any(missing))
    return(pkgs)

  renv_pretty_print(
    basename(pkgs)[missing],
    "The following folder(s) appear to be left-over temporary directories:",
    "Consider removing these folders from your library."
  )

  pkgs[!missing]

}

renv_snapshot_r_library_diagnose_missing_description <- function(library, pkgs) {

  desc <- file.path(pkgs, "DESCRIPTION")
  missing <- !file.exists(desc)
  if (!any(missing))
    return(pkgs)

  renv_pretty_print(
    sprintf("%s [%s]", format(basename(pkgs[missing])), pkgs[missing]),
    "The following package(s) are missing their DESCRIPTION files:",
    c(
      "These may be left over from a prior, failed installation attempt.",
      "Consider removing or reinstalling these packages."
    ),
    wrap = FALSE
  )

  pkgs[!missing]

}

renv_snapshot_description <- function(path = NULL, package = NULL) {

  # read DESCRIPTION file
  path <- path %||% renv_package_find(package)
  dcf <- catch(renv_description_read(path, package))
  if (inherits(dcf, "error"))
    return(dcf)

  renv_snapshot_description_impl(dcf, path)

}

renv_snapshot_description_impl <- function(dcf, path = NULL) {

  # figure out the package source
  source <- renv_snapshot_description_source(dcf)
  dcf[names(source)] <- source

  # check for required fields
  required <- c("Package", "Version", "Source")
  missing <- renv_vector_diff(required, names(dcf))
  if (length(missing)) {
    fmt <- "required fields %s missing from DESCRIPTION at path '%s'"
    msg <- sprintf(fmt, paste(shQuote(missing), collapse = ", "), path %||% "<unknown>")
    return(simpleError(msg))
  }

  # generate a hash if we can
  dcf[["Hash"]] <- if (is.null(path))
    renv_hash_description_impl(dcf)
  else
    renv_hash_description(path)

  # normalize whitespace in some dependency fields
  fields <- c("Depends", "Imports", "LinkingTo")
  for (field in fields) {
    if (!is.null(dcf[[field]])) {
      parts <- strsplit(dcf[[field]], "\\s*,\\s*", perl = TRUE)[[1L]]
      parts <- gsub("\\s+", " ", parts, perl = TRUE)
      dcf[[field]] <- parts[nzchar(parts)]
    }
  }

  # only keep relevant fields
  git <- grep("^git", names(dcf), value = TRUE)
  remotes <- grep("^Remote", names(dcf), value = TRUE)
  extra <- c("Repository", "OS_type")
  all <- c(required, fields, extra, remotes, git, "Hash")
  keep <- renv_vector_intersect(all, names(dcf))

  # return as list
  as.list(dcf[keep])

}

renv_snapshot_description_source <- function(dcf) {

  # first, check for a declared remote type
  # treat 'standard' remotes as packages installed from a repository
  # https://github.com/rstudio/renv/issues/998
  type <- dcf[["RemoteType"]]
  if (identical(type, "standard"))
    return(list(Source = "Repository", Repository = dcf[["Repository"]]))
  else if (!is.null(type))
    return(list(Source = alias(type)))

  # next, check for a declared repository
  if (!is.null(dcf[["Repository"]]))
    return(list(Source = "Repository", Repository = dcf[["Repository"]]))

  # packages from Bioconductor are normally tagged with a 'biocViews' entry;
  # use that to infer a Bioconductor source
  if (!is.null(dcf[["biocViews"]]))
    return(list(Source = "Bioconductor"))

  # check for a valid package name
  package <- dcf[["Package"]]
  if (is.null(package))
    return(list(Source = "unknown"))

  # NOTE: this is sort of a hack that allows renv to declare packages which
  # appear to be installed from sources, but are actually available on the
  # active R package repositories, as though they were retrieved from that
  # repository. however, this is often what users intend, especially if
  # they haven't configured their repository to tag the packages it makes
  # available with the 'Repository:' field in the DESCRIPTION file.
  #
  # still, this has the awkward side-effect of a package's source potentially
  # depending on what repositories happen to be active at the time of snapshot,
  # so it'd be nice to tighten up the logic here if possible
  #
  # NOTE: local sources are also searched here as part of finding the 'latest'
  # available package, so we need to handle local packages discovered here
  entry <- local({
    renv_scope_options(renv.verbose = FALSE)
    catch(renv_available_packages_latest(package))
  })

  if (!inherits(entry, "error")) {

    # check for entry in cellar
    source <- entry[["Source"]]
    if (identical(source, "Cellar"))
      return(list(Source = "Cellar"))

    # otherwise, treat as regular entry
    repository <- entry[["Repository"]]
    return(list(Source = "Repository", Repository = repository))

  }

  # last chance; try to see if this package lives in the cellar
  location <- catch(renv_retrieve_cellar_find(dcf))
  if (!inherits(location, "error"))
    return(list(Source = "Cellar"))

  list(Source = "unknown")

}

# nocov start
renv_snapshot_report_actions <- function(actions, old, new) {

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

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

}
# nocov end

renv_snapshot_dependencies <- function(project, source) {

  message <- "snapshot aborted"
  errors <- config$dependency.errors()

  withCallingHandlers(

    dependencies(
      path = source,
      root = project,
      progress = FALSE,
      errors = errors
    ),

    renv.dependencies.error = renv_dependencies_error_handler(message, errors)

  )

}

renv_snapshot_filter <- function(project, records, type, packages) {

  start <- Sys.time()

  type <- type %||% settings$snapshot.type(project = project)

  aliases <- list(packrat = "implicit", simple = "all")
  type <- aliases[[type]] %||% type

  result <- switch(type,
    all      = renv_snapshot_filter_all(project, records),
    custom   = renv_snapshot_filter_custom(project, records),
    explicit = renv_snapshot_filter_explicit(project, records),
    implicit = renv_snapshot_filter_implicit(project, records),
    packages = renv_snapshot_filter_packages(project, records, packages),
    stopf("unknown snapshot type '%s'", type)
  )

  if (type %in% c("all", "explicit"))
    return(result)

  end <- Sys.time()

  # report if dependency discovery took a long time
  limit <- getOption("renv.snapshot.filter.timelimit", default = 10L)
  diff <- difftime(end, start, units = "secs")

  if (diff > limit) {

    lines <- c(
      "NOTE: Dependency discovery took %s %s during snapshot.",
      "Consider using .renvignore to ignore files -- see `?dependencies` for more information.",
      "Use `renv::settings$snapshot.type(\"all\")` to disable dependency discovery during snapshot."
    )

    time <- difftime(end, start, units = "auto")
    elapsed <- format(unclass(signif(time, digits = 2L)))
    units <- switch(
      attr(time, "units"),
      secs  = "seconds",
      mins  = "minutes",
      hours = "hours",
      days  = "days",
      weeks = "weeks"
    )

    vwritef(lines, elapsed, units)

  }

  result

}

renv_snapshot_filter_all <- function(project, records) {
  records
}

renv_snapshot_filter_impl <- function(project, records, source) {

  deps <- renv_snapshot_dependencies(project, source)
  packages <- unique(c(deps$Package, "renv"))

  # ignore packages as defined by project
  ignored <- renv_project_ignored_packages(project = project)
  used <- setdiff(packages, ignored)

  # include transitive dependencies
  paths <- renv_package_dependencies(used, project = project)
  all <- as.character(names(paths))
  kept <- keep(records, all)

  # add in bioconductor infrastructure packages
  # if any other bioconductor packages detected
  sources <- extract_chr(kept, "Source")
  if ("Bioconductor" %in% sources) {
    packages <- c("BiocManager", "BiocInstaller", "BiocVersion")
    for (package in packages)
      kept[[package]] <- records[[package]]
  }

  kept

}

renv_snapshot_filter_implicit <- function(project, records) {
  renv_snapshot_filter_impl(project, records, project)
}

renv_snapshot_filter_explicit <- function(project, records) {

  # keep only packages mentioned in the project DESCRIPTION file
  descpath <- file.path(project, "DESCRIPTION")
  if (!file.exists(descpath)) {
    fmt <- "%s does not exist; cannot perform explicit snapshot"
    stopf(fmt, renv_path_pretty(descpath))
  }

  renv_snapshot_filter_impl(project, records, descpath)

}

renv_snapshot_filter_packages <- function(project, records, packages) {

  # include transitive dependencies
  paths <- renv_package_dependencies(packages, project = project)
  all <- as.character(names(paths))
  kept <- keep(records, all)

  # add in bioconductor infrastructure packages
  # if any other bioconductor packages detected
  sources <- extract_chr(kept, "Source")
  if ("Bioconductor" %in% sources) {
    packages <- c("BiocManager", "BiocInstaller", "BiocVersion")
    for (package in packages)
      kept[[package]] <- records[[package]]
  }

  kept

}

renv_snapshot_filter_custom <- function(project, records) {

  option <- "renv.snapshot.filter"
  filter <- getOption(option, default = NULL)

  # allow for filter naming a function to use
  if (is.character(filter))
    filter <- eval(parse(text = filter), envir = baseenv())

  # check we got a function
  if (!is.function(filter)) {
    fmt <- "snapshot of type '%s' requested, but '%s' is not a function"
    stopf(fmt, "custom", option)
  }

  # invoke the filter to get package list
  packages <- filter(project)

  if (empty(packages))
    return(records)

  if (!is.character(packages))
    stop("custom snapshot filter did not return a character vector")

  keep(records, packages)

}

renv_snapshot_fixup <- function(records) {

  records <- renv_snapshot_fixup_renv(records)
  records

}

renv_snapshot_fixup_renv <- function(records) {

  if (renv_tests_running())
    return(records)

  # nocov start
  record <- records$renv
  if (is.null(record))
    return(records)

  source <- renv_record_source(record)
  if (source != "unknown")
    return(records)

  remote <- paste("rstudio/renv", record$Version, sep = "@")
  records$renv <- renv_remotes_resolve(remote)
  records
  # nocov end

}

renv_snapshot_reprex <- function(lockfile) {

  fmt <- "<sup>Lockfile generated by renv %s.</sup>"
  version <- sprintf(fmt, renv_package_version("renv"))

  text <- c(
    "<details style=\"margin-bottom: 10px;\">",
    "<summary>Lockfile</summary>",
    "```",
    renv_lockfile_write(lockfile, file = NULL),
    "```",
    version,
    "</details>"
  )

  output <- paste(text, collapse = "\n")
  class(output) <- "knit_asis"
  attr(output, "knit_cacheable") <- NA

  output

}

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

  # perform python snapshot on success
  renv_python_snapshot(project, prompt)

  # return generated records
  invisible(records)

}

stack <- function(mode = "list") {

  .data <- list()
  storage.mode(.data) <- mode

  object <- list(

    push = function(...) {
      dots <- list(...)
      for (data in dots) {
        if (is.null(data))
          .data[length(.data) + 1] <<- list(NULL)
        else
          .data[[length(.data) + 1]] <<- data
      }
    },

    pop = function() {
      item <- .data[[length(.data)]]
      length(.data) <<- length(.data) - 1
      item
    },

    peek = function() {
      .data[[length(.data)]]
    },

    contains = function(data) {
      data %in% .data
    },

    empty = function() {
      length(.data) == 0
    },

    get = function(index) {
      if (index <= length(.data)) .data[[index]]
    },

    set = function(index, value) {
      .data[[index]] <<- value
    },

    clear = function() {
      .data <<- list()
    },

    data = function() {
      .data
    }

  )

  object

}

#' Status
#'
#' Report differences between the project's lockfile and the current state of
#' the project's library (if any).
#'
#' @inherit renv-params
#'
#' @param library The library paths. By default, the library paths associated
#'   with the requested project are used.
#'
#' @param lockfile The path to a lockfile. By default, the project lockfile
#'   (called `renv.lock`) is used.
#'
#' @param cache Boolean; perform diagnostics on the global package cache?
#'   When `TRUE`, `renv` will validate that the packages installed into the
#'   cache are installed at the expected + proper locations, and validate the
#'   hashes used for those storage locations.
#'
#' @return This function is normally called for its side effects.
#'
#' @export
#'
#' @example examples/examples-init.R
status <- function(project = NULL,
                   ...,
                   library = NULL,
                   lockfile = NULL,
                   cache = FALSE)
{
  renv_scope_error_handler()
  renv_dots_check(...)

  renv_snapshot_auto_suppress_next()

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  libpaths <- renv_libpaths_resolve(library)
  lockpath <- lockfile %||% renv_lockfile_path(project)

  invisible(renv_status_impl(project, libpaths, lockpath, cache))
}

renv_status_impl <- function(project, libpaths, lockpath, cache) {

  # check to see if we've initialized this project
  if (!renv_project_initialized(project)) {
    vwritef("* This project has not yet been initialized.")
    return(list(library = list(), lockfile = list(), synchronized = FALSE))
  }

  libstate <- renv_status_check_missing_library(project, libpaths)
  lockfile <- renv_status_check_missing_lockfile(project, lockpath)

  synchronized <- renv_status_check_synchronized(
    project  = project,
    lockfile = lockfile,
    libpaths = libpaths,
    libstate = libstate
  )

  renv_status_check_unknown_sources(project, lockfile)
  renv_status_check_used_packages(project, lockfile, libstate)

  if (cache)
    renv_status_check_cache(project)

  list(
    library      = libstate,
    lockfile     = lockfile,
    synchronized = synchronized
  )

}

renv_status_check_missing_lockfile <- function(project, lockpath) {

  if (file.exists(lockpath))
    return(renv_lockfile_read(lockpath))

  if (identical(lockpath, renv_lockfile_path(project))) {
    text <- "* This project has not yet been snapshotted -- 'renv.lock' does not exist."
    vwritef(text)
  } else {
    fmt <- "* Lockfile %s does not exist."
    vwritef(fmt, renv_path_pretty(lockpath))
  }

  list()

}

renv_status_check_missing_library <- function(project, libpaths) {

  projlib <- nth(libpaths, 1L)
  if (file.exists(projlib)) {
    renv_scope_options(renv.verbose = FALSE)
    snapshotted <- snapshot(project  = project,
                            library  = libpaths,
                            lockfile = NULL,
                            force    = TRUE)
    return(snapshotted)
  }

  if (identical(projlib, renv_paths_library(project = project))) {
    text <- "* This project's private library is empty or does not exist."
    vwritef(text)
  } else {
    fmt <- "* Library %s is empty or does not exist."
    vwritef(fmt, renv_paths_project(projlib))
  }

  list()

}

renv_status_check_used_packages <- function(project, lockfile, libstate) {

  # only done when using implicit snapshots in a project
  type <- settings$snapshot.type(project = project)
  if (!type %in% c("implicit", "packrat"))
    return(FALSE)

  deps <- dependencies(project, progress = FALSE)
  used <- sort(unique(deps$Package))

  ignored <- c(
    renv_packages_base(),
    renv_project_ignored_packages(project),
    names(renv_records(lockfile)),
    names(renv_records(libstate))
  )

  missing <- setdiff(used, ignored)
  if (empty(missing))
    return(TRUE)

  renv_pretty_print(
    missing,
    "The following package(s) are used in the project, but are not installed:",
    c(
      "Consider installing these packages, and then using `renv::snapshot()`",
      "to record these packages in the lockfile."
    ),
    wrap = FALSE
  )

  if (renv_tests_running())
    renv_condition_signal("renv.status.used_but_not_installed", missing)

  FALSE

}

renv_status_check_unknown_sources <- function(project, lockfile) {
  records <- renv_records(lockfile)
  renv_check_unknown_source(records, project)
}

renv_status_check_synchronized <- function(project,
                                           lockfile,
                                           libpaths,
                                           libstate)
{
  # diff packages
  actions <- renv_lockfile_diff_packages(lockfile, libstate)
  if (empty(actions)) {
    vwritef("* The project is already synchronized with the lockfile.")
    return(TRUE)
  }

  if ("install" %in% actions) {

    records <- renv_records_select(libstate, actions, "install")

    if (renv_tests_running()) {
      condition <- "renv.status.installed_but_not_recorded"
      renv_condition_signal(condition, records)
    }

    renv_pretty_print_records(
      records,
      "The following package(s) are installed but not recorded in the lockfile:",
      "Use `renv::snapshot()` to add these packages to your lockfile."
    )

  }

  if ("remove" %in% actions) {

    # we need to differentiate between packages that are 'removed' because they
    # are no longer used in the project, versus packages which are simply not
    # installed in the project library anymore
    records <- renv_records_select(lockfile, actions, "remove")

    if (settings$snapshot.type() %in% c("implicit", "packrat")) {

      deps <- dependencies(project, progress = FALSE)
      pkgpaths <- renv_package_dependencies(
        packages = unique(deps$Package),
        project  = project,
        libpaths = libpaths
      )

      used <- intersect(names(records), names(pkgpaths))
      unused <- setdiff(names(records), used)

      if (renv_tests_running()) {
        condition <- "renv.status.recorded_but_no_longer_used"
        renv_condition_signal(condition, records[unused])
      }

      renv_pretty_print_records(
        records[unused],
        "The following package(s) are no longer used in this project:",
        "Use `renv::snapshot()` to remove them from the lockfile."
      )

      records <- records[used]

    }

    if (renv_tests_running()) {
      condition <- "renv.status.recorded_but_not_installed"
      renv_condition_signal(condition, records)
    }

    if (settings$snapshot.type() %in% c("all", "implicit", "packrat")) {

      renv_pretty_print_records(
        records,
        "The following package(s) are recorded in the lockfile, but not installed:",
        "Use `renv::restore()` to install these packages."
      )

    } else if (settings$snapshot.type() %in% c("explicit")) {

      renv_pretty_print_records(
        records,
        "The following unused package(s) are recorded in the lockfile:",
        "Use `renv::snapshot()` to remove these packages from the lockfile."
      )

    } else {

      renv_pretty_print_records(

        records = records,

        preamble = c(
          "The following package(s) are recorded in the lockfile, ",
          "but do not appear to be required by the project:"
        ),

        postamble = c(
          "Use `renv::restore()` to install these packages.",
          "Use `renv::snapshot()` to remove these packages from the lockfile."
        )

      )

    }

  }

  rest <- c("upgrade", "downgrade", "crossgrade")
  if (any(rest %in% actions)) {

    matches <- actions[actions %in% rest]

    rlock <- renv_records(lockfile)[names(matches)]
    rlibs <- renv_records(libstate)[names(matches)]

    data <- data.frame(
      "  Package"          = names(matches),
      "  Lockfile Version" = extract_chr(rlock, "Version"),
      "  Library Version"  = extract_chr(rlibs, "Version"),
      row.names            = NULL,
      stringsAsFactors     = FALSE,
      check.names          = FALSE
    )

    writeLines("The following package(s) are out of sync:")
    writeLines("")
    print(data, row.names = FALSE)
    writeLines("")
    writeLines("Use `renv::snapshot()` to save the state of your library to the lockfile.")
    writeLines("Use `renv::restore()` to restore your library from the lockfile.")
    writeLines("")
  }

  FALSE
}

renv_status_check_cache <- function(project) {

  if (renv_cache_config_enabled(project = project))
    renv_cache_diagnose()

}

renv_system_exec <- function(command,
                             args    = NULL,
                             action  = "executing command",
                             success = 0L,
                             stream  = FALSE,
                             quiet   = FALSE)
{
  # be quiet when running tests by default
  if (!interactive() && renv_tests_running())
    quiet <- TRUE

  # handle 'stream' specially
  if (stream) {

    # form stdout, stderr
    stdout <- stderr <- if (quiet) FALSE else ""

    # execute command
    status <- suppressWarnings(
      if (is.null(args))
        system(command, ignore.stdout = quiet, ignore.stderr = quiet)
      else
        system2(command, args, stdout = stdout, stderr = stderr)
    )

    # check for error
    status <- status %||% 0L
    if (!is.null(success) && !status %in% success) {
      fmt <- "error %s [error code %i]"
      stopf(fmt, action, status)
    }

    # return status code
    return(status)

  }

  # suppress warnings as some successful commands may return a non-zero exit
  # code, whereas R will always warn on such error codes
  output <- suppressWarnings(
    if (is.null(args))
      system(command, intern = TRUE)
    else
      system2(command, args, stdout = TRUE, stderr = TRUE)
  )

  # extract status code from result
  status <- attr(output, "status") %||% 0L

  # if this status matches an expected 'success' code, return output
  if (is.null(success) || status %in% success)
    return(output)

  # otherwise, notify the user that things went wrong
  if (!quiet) {

    cmdline <- paste(command, paste(args, collapse = " "))
    underline <- paste(rep.int("=", min(80L, nchar(cmdline))), collapse = "")
    header <- c(cmdline, underline)

    # truncate output (avoid overwhelming console)
    body <- if (length(output) > 200L)
      c(head(output, n = 100L), "< ... >", tail(output, n = 100L))
    else
      output

    # write to stderr
    writeLines(c(header, "", body), con = stderr())

  }

  # throw error
  fmt <- "error %s [error code %i]"
  stopf(fmt, action, status)
}


renv_tar_exe <- function() {

  # allow override
  tar <- getOption("renv.tar.exe")
  if (!is.null(tar))
    return(tar)

  # on unix, just use default
  if (renv_platform_unix())
    return(Sys.which("tar"))

  # on Windows, use system tar.exe if available
  root <- Sys.getenv("SystemRoot", unset = NA)
  if (is.na(root))
    root <- "C:/Windows"

  # use tar if it exists
  tarpath <- file.path(root, "System32/tar.exe")
  if (file.exists(tarpath))
    return(tarpath)

  # otherwise, give up (don't trust the arbitrary tar on PATH)
  ""

}

renv_tar_decompress <- function(tar, archive, files = NULL, exdir = ".", ...) {

  # build argument list
  args <- c(
    "xf", renv_shell_path(archive),
    if (!identical(exdir, "."))
      c("-C", renv_shell_path(exdir)),
    if (length(files))
      renv_shell_path(files)
  )

  # make sure exdir exists
  ensure_directory(exdir)

  # perform decompress
  return(renv_system_exec(tar, args, action = "decompressing archive"))

}

renv_template_create <- function(template) {
  gsub("^\\n+|\\n+$", "", template)
}

renv_template_replace <- function(text, replacements) {

  enumerate(replacements, function(key, value) {
    key <- sprintf("${%s}", key)
    text <<- gsub(key, value, text, fixed = TRUE)
  })

  text

}

test <- function() {

  # ensure tools loaded
  devtools::load_all()

  # run tests
  testthat::test_dir(
    path     = renv_tests_root(),
    reporter = renv_tests_reporter()
  )

}

renv_tests_scope <- function(packages = character(), project = NULL) {

  renv_tests_init()

  # ensure that attempts to restart are a no-op
  options(restart = function(...) TRUE)

  # save local repositories
  Sys.setenv(RENV_PATHS_LOCAL = file.path(renv_tests_root(), "local"))

  # move to own test directory
  dir <- project %||% tempfile("renv-test-")
  ensure_directory(dir)
  dir <- renv_path_normalize(dir, winslash = "/")
  owd <- setwd(dir)

  # set as active project
  Sys.setenv(RENV_PROJECT = dir)

  # create empty renv directory
  dir.create(file.path(dir, "renv"))

  # create file with dependencies
  code <- sprintf("library(%s)", packages)
  writeLines(code, "dependencies.R")

  # use temporary library
  lib <- tempfile("renv-library-")
  ensure_directory(lib)
  libpaths <- .libPaths()
  .libPaths(lib)

  defer(envir = parent.frame(), {
    setwd(owd)
    unlink(lib, recursive = TRUE)
    .libPaths(libpaths)
  })

  invisible(dir)

}

renv_tests_root <- function(path = getwd()) {
  renv_global("tests.root", renv_tests_root_impl(path))
}

renv_tests_root_impl <- function(path = getwd()) {

  # if we're working in an RStudio project, we can cheat
  if (exists(".rs.getProjectDirectory")) {
    projroot <- get(".rs.getProjectDirectory")
    return(file.path(projroot(), "tests/testthat"))
  }

  # construct set of paths we'll hunt through
  slashes <- gregexpr("(?:/|$)", path, perl = TRUE)[[1]]
  parts <- substring(path, 1, slashes - 1)

  # begin the search
  for (part in rev(parts)) {

    # required to find test directory during R CMD check
    if (file.exists(file.path(part, "testthat.R")))
      return(file.path(part, "testthat"))

    # required for other general testing
    anchor <- file.path(part, "DESCRIPTION")
    if (file.exists(anchor))
      return(file.path(part, "tests/testthat"))

  }

  stop("could not determine root directory for test files")

}

renv_tests_init_envvars <- function() {

  Sys.unsetenv("RENV_PROFILE")
  Sys.unsetenv("RENV_PROJECT")
  Sys.unsetenv("RENV_PATHS_ROOT")
  Sys.unsetenv("RENV_PATHS_LIBRARY")
  Sys.unsetenv("RENV_PATHS_LIBRARY_ROOT")
  Sys.unsetenv("RENV_PATHS_LOCAL")
  Sys.unsetenv("RENV_PATHS_LOCKFILE")
  Sys.unsetenv("RENV_PATHS_RENV")

  Sys.unsetenv("RENV_PYTHON")
  Sys.unsetenv("RETICULATE_PYTHON")
  Sys.unsetenv("RETICULATE_PYTHON_ENV")
  Sys.unsetenv("RETICULATE_PYTHON_FALLBACK")

  Sys.setenv(RENV_AUTOLOAD_ENABLED = "FALSE")

  envvars <- Sys.getenv()
  configvars <- grep("^RENV_CONFIG_", names(envvars), value = TRUE)
  Sys.unsetenv(configvars)

}

renv_tests_init_workarounds <- function() {

  if (renv_platform_macos()) {

    if (!nzchar(Sys.getenv("TZ")))
      Sys.setenv(TZ = "America/Los_Angeles")

  }

}

renv_tests_init_working_dir <- function() {
  if (exists(".rs.getProjectDirectory")) {
    home <- get(".rs.getProjectDirectory")
    setwd(home())
  }
}

renv_tests_init_options <- function() {
  options(
    renv.config.user.library = FALSE,
    renv.config.sandbox.enabled = TRUE,
    restart = NULL,
    warn = 2
  )
}

renv_tests_init_repos <- function(repopath = NULL) {

  # find root directory
  root <- renv_tests_root()

  # generate our dummy repository
  repopath <- repopath %||% tempfile("renv-tests-repos-")
  contrib <- file.path(repopath, "src/contrib")
  ensure_directory(contrib)

  # save current directory
  owd <- getwd()
  on.exit(setwd(owd), add = TRUE)

  # copy package stuff to tempdir (because we'll mutate them a bit)
  source <- file.path(root, "packages")
  target <- tempfile("renv-packages-")
  renv_file_copy(source, target)
  setwd(target)

  # helper function for 'uploading' a package to our test repo
  upload <- function(path, root, subdir = FALSE) {

    # create package tarball
    desc <- renv_description_read(path)
    package <- basename(path)
    tarball <- sprintf("%s_%s.tar.gz", package, desc$Version)
    tar(tarball, package, compression = "gzip")

    # copy into repository tree
    components <- c(root, if (subdir) package, tarball)
    target <- paste(components, collapse = "/")
    ensure_parent_directory(target)
    renv_file_move(tarball, target)

  }

  # just in case?
  renv_scope_options(renv.config.filebacked.cache = FALSE)

  # copy in packages
  paths <- list.files(getwd(), full.names = TRUE)
  subdirs <- file.path(getRversion(), "Recommended")
  for (path in paths) {

    # upload the 'regular' package
    upload(path, contrib, subdir = FALSE)

    # upload a subdir (mocking what R does during upgrades)
    upload(path, file.path(contrib, subdirs), subdir = FALSE)

    # generate an 'old' version of the packages
    descpath <- file.path(path, "DESCRIPTION")
    desc <- renv_description_read(descpath)
    desc$Version <- "0.0.1"
    write.dcf(desc, file = descpath)

    # place packages at top level (simulating packages with multiple
    # versions at the top level of the repository)
    upload(path, contrib, subdir = FALSE)

    # generate an 'old' version of the packages
    descpath <- file.path(path, "DESCRIPTION")
    desc <- renv_description_read(descpath)
    desc$Version <- "0.1.0"
    write.dcf(desc, file = descpath)

    # place these packages into the archive
    upload(path, file.path(contrib, "Archive"), subdir = TRUE)

  }

  # update PACKAGES metadata
  tools::write_PACKAGES(
    dir = contrib,
    subdirs = subdirs,
    type = "source",
    latestOnly = FALSE
  )

  # update our repos option
  fmt <- if (renv_platform_windows()) "file:///%s" else "file://%s"
  repos <- c(CRAN = sprintf(fmt, repopath))

  options(
    pkgType             = "source",
    repos               = repos,
    renv.tests.repos    = repos,
    renv.tests.repopath = repopath
  )

}

renv_tests_init_packages <- function() {

  # don't treat warnings as errors in this scope
  renv_scope_options(warn = 1)

  # find packages to load
  packages <- renv_tests_init_packages_find()

  # load those packages
  envir <- new.env(parent = emptyenv())
  renv_tests_init_packages_load(packages, envir)

}

renv_tests_init_packages_find <- function() {
  fields <- c("Depends", "Imports", "Suggests", "LinkingTo")
  descpath <- system.file("DESCRIPTION", package = "renv")
  deps <- renv_dependencies_discover_description(descpath, fields)
  deps[["Package"]]
}

renv_tests_init_packages_load <- function(packages, envir) {
  for (package in packages) {
    tryCatch(
      renv_tests_init_packages_load_impl(package, envir),
      error = warning
    )
  }
}

renv_tests_init_packages_load_impl <- function(package, envir) {

  # skip the 'R' package
  if (identical(package, "R"))
    return()

  # if we've already tried to load this package, skip it
  if (visited(package, envir = envir))
    return()

  # try to load the package
  if (!package %in% loadedNamespaces()) {
    if (!requireNamespace(package, quietly = TRUE)) {
      fmt <- "Failed to load package '%s' (required for testing)"
      writef(fmt, package)
      return()
    }
  }

  # try to find this package
  pkgpath <- renv_package_find(package)
  if (!file.exists(pkgpath))
    return()

  # try to read the package DESCRIPTION and load its dependencies
  descpath <- file.path(pkgpath, "DESCRIPTION")
  deps <- renv_dependencies_discover_description(
    path   = descpath,
    fields = c("Depends", "Imports", "LinkingTo")
  )

  map(
    deps$Package,
    renv_tests_init_packages_load,
    envir = envir
  )

}

renv_tests_init_sandbox <- function() {

  # eagerly load packages that we'll need during tests
  # (as the sandbox will otherwise 'hide' these packages)
  testthat <- find.package("testthat")
  descpath <- file.path(testthat, "DESCRIPTION")
  deps <- renv_dependencies_discover_description(descpath)
  for (package in deps$Package)
    requireNamespace(package, quietly = TRUE)

  # set up a dummy library path
  dummy <- tempfile("renv-library-")
  dir.create(dummy)
  .libPaths(dummy)

  # now sandbox the libpaths
  renv_sandbox_activate()

}

renv_tests_init_finish <- function() {

  # remove any leftover renv-test- directories in the userdir
  userdir <- renv_bootstrap_user_dir()
  libdir <- file.path(userdir, "library")
  testdirs <- list.files(
    path = libdir,
    pattern = "^renv-test-",
    full.names = TRUE
  )
  unlink(testdirs, recursive = TRUE)

  # don't perform transactional installs by default for now
  # (causes strange CI failures, especially on Windows?)
  options(renv.config.install.transactional = FALSE)

  # mark tests as running
  options(renv.tests.running = TRUE)

}

renv_tests_init <- function() {

  if (renv_tests_running())
    return()

  renv_tests_init_envvars()
  renv_tests_init_workarounds()
  renv_tests_init_working_dir()
  renv_tests_init_options()
  renv_tests_init_repos()
  renv_tests_init_packages()
  renv_tests_init_sandbox()
  renv_tests_init_finish()

}

renv_tests_running <- function() {
  getOption("renv.tests.running", default = FALSE)
}

renv_tests_verbose <- function() {

  # if we're not running tests, mark as true
  if (!renv_tests_running())
    return(TRUE)

  # otherwise, respect option
  # (we might set this to FALSE to silence output from expected errors)
  getOption("renv.tests.verbose", default = TRUE)

}

renv_test_code <- function(code, fileext = ".R") {

  file <- tempfile("renv-code-", fileext = fileext)
  writeLines(deparse(substitute(code)), con = file)
  file

}

renv_test_retrieve <- function(record) {

  renv_scope_error_handler()

  # avoid using cache
  renv_scope_envvars(RENV_PATHS_CACHE = tempfile())

  # construct records
  package <- record$Package
  records <- list(record)
  names(records) <- package

  # prepare dummy library
  templib <- renv_scope_tempfile("renv-library-")
  ensure_directory(templib)
  renv_scope_libpaths(c(templib, .libPaths()))

  # attempt a restore into that library
  renv_scope_restore(
    project = getwd(),
    library = templib,
    records = records,
    packages = package,
    recursive = FALSE
  )

  records <- retrieve(record$Package)
  renv_install_impl(records)

  descpath <- file.path(templib, package)
  if (!file.exists(descpath))
    stopf("failed to retrieve package '%s'", package)

  desc <- renv_description_read(descpath)
  fields <- grep("^Remote", names(record), value = TRUE)

  testthat::expect_identical(
    as.list(desc[fields]),
    as.list(record[fields])
  )

}

renv_tests_diagnostics <- function() {

  # print library paths
  renv_pretty_print(
    paste("-", .libPaths()),
    "The following R libraries are set:",
    wrap = FALSE
  )

  # print repositories
  repos <- getOption("repos")
  renv_pretty_print(
    paste(names(repos), repos, sep = ": "),
    "The following repositories are set:",
    wrap = FALSE
  )

  # print renv root
  renv_pretty_print(
    paste("-", paths$root()),
    "The following renv root directory is being used:",
    wrap = FALSE
  )

  # print cache root
  renv_pretty_print(
    paste("-", paths$cache()),
    "The following renv cache directory is being used:",
    wrap = FALSE
  )

  writeLines("The following packages are available in the test repositories:")

  dbs <-
    renv_available_packages(type = "source", quiet = TRUE) %>%
    map(function(db) {
      rownames(db) <- NULL
      db[c("Package", "Version", "Path")]
    })

  print(dbs)

  path <- Sys.getenv("PATH")
  splat <- strsplit(path, .Platform$path.sep, fixed = TRUE)[[1]]

  renv_pretty_print(
    paste("-", splat),
    "The following PATH is set:",
    wrap = FALSE
  )

  envvars <- c(
    grep("^_R_", names(Sys.getenv()), value = TRUE),
    "HOME",
    "R_ARCH", "R_HOME",
    "R_LIBS", "R_LIBS_SITE", "R_LIBS_USER", "R_USER",
    "R_ZIPCMD",
    "TAR", "TEMP", "TMP", "TMPDIR"
  )

  keys <- format(envvars)
  vals <- Sys.getenv(envvars, unset = "<NA>")
  vals[vals != "<NA>"] <- renv_json_quote(vals[vals != "<NA>"])

  renv_pretty_print(
    paste(keys, vals, sep = " : "),
    "The following environment variables of interest are set:",
    wrap = FALSE
  )

}

renv_tests_report <- function(test, elapsed, expectations) {

  # figure out overall test result
  status <- "PASS"
  for (expectation in expectations) {

    errors <- c("expectation_error", "expectation_failure")
    if (inherits(expectation, errors)) {
      status <- "FAIL"
      break
    }

    if (inherits(expectation, "expectation_skip")) {
      status <- "SKIP"
      break
    }

  }

  # get console width
  width <- max(getOption("width"), 78L)

  # write out text with line
  left <- trunc(test, width - 23L)

  # figure out how long tests took to run
  time <- if (elapsed < 0.1)
    "<0.1s"
  else
    format(renv_difftime_format_short(elapsed), width = 5L, justify = "right")

  # write formatted
  fmt <- "[%s / %s]"
  right <- sprintf(fmt, status, time)

  # fill space between with dots
  dots <- rep.int(".", max(0L, width - nchar(left) - nchar(right) - 4L))
  all <- paste(left, paste(dots, collapse = ""), right)

  # write it out
  cli::cat_bullet(all)

}

renv_tests_path <- function(path) {
  root <- renv_tests_root()
  file.path(root, path)
}

renv_tests_supported <- function() {

  # supported when running locally + on CI
  for (envvar in c("NOT_CRAN", "CI"))
    if (!is.na(Sys.getenv(envvar, unset = NA)))
      return(TRUE)

  # disabled on older macOS releases (credentials fails to load)
  if (renv_platform_macos() && getRversion() < "4.0.0")
    return(FALSE)

  # disabled on Windows
  if (renv_platform_windows())
    return(FALSE)

  # true otherwise
  TRUE

}

expect_same_elements <- function(lhs, rhs) {

  if (!requireNamespace("testthat", quietly = TRUE))
    stop("testthat not available for testing")

  if (is.list(lhs) && is.list(rhs)) {
    lhs <- lhs[order(names(lhs))]
    rhs <- rhs[order(names(rhs))]
    return(testthat::expect_equal(!!lhs, !!rhs))
  }

  if (packageVersion("testthat") > "2.2.0")
    testthat::expect_setequal(!!lhs, !!rhs)
  else
    testthat::expect_setequal(lhs, rhs)

}

expect_signal <- function(expr, class) {

  conditions <- stack()
  withCallingHandlers(expr, condition = function(c) conditions$push(c))

  ok <- FALSE
  for (c in conditions$data()) {
    if (inherits(c, class)) {
      ok <- TRUE
      break
    }
  }

  message <- sprintf("did not signal condition of class '%s'", class)
  testthat::expect(ok, message)

}

skip_if_local <- function() {
  ci <- Sys.getenv("CI", unset = NA)
  testthat::skip_if(is.na(ci), "Running tests locally")
}

skip_on_windows <- function() {
  testthat::skip_on_os("windows")
}

renv_tests_reporter <- function() {

  # if we're running on CI, use the default reporter
  if (!is.na(Sys.getenv("CI", unset = NA)))
    return(testthat::default_reporter())

  # if we can't load R6, use the default reporter
  if (!requireNamespace("R6", quietly = TRUE))
    return(testthat::default_reporter())

  # silence R CMD check
  self <- super <- NULL

  # otherwise, define and return instance of our reporter
  R6::R6Class(

    classname = "RenvReporter",
    inherit   = testthat::CheckReporter,

    lock_class   = FALSE,
    lock_objects = FALSE,

    public = list(

      .time = NULL,
      .expectations = list(),

      start_file = function(filename) {
        cli::cat_rule(filename)
        super$start_file(filename)
      },

      end_file = function() {

        if (empty(self$.expectations))
          cli::cat_line("[no test results to report]")

        cli::cat_line()
        super$end_file()

      },

      add_result = function(context, test, result) {

        # store our expectation result
        self$.expectations[[length(self$.expectations) + 1]] <- result

        # record skips but don't print when they occur
        if (inherits(result, "expectation_skip")) {
          message <- sprintf("[%s]: %s", test, result$message)
          self$n_skip <- self$n_skip + 1
          self$skips$push(message)
        } else {
          super$add_result(context, test, result)
        }

      },

      start_test = function(context, test) {
        self$.time <- Sys.time()
        self$.expectations <- list()
        super$start_test(context, test)
      },

      end_test = function(context, test) {
        elapsed <- difftime(Sys.time(), self$.time)
        renv_tests_report(test, elapsed, self$.expectations)
        super$end_test(context, test)
      }

    )

  )

}

# tools for caching a value that should expire after
# some period of time
`_renv_timecache` <- stack(mode = "list")

timecache <- function(key, value, limit = 3600, timeout = NULL) {

  # allow override
  enabled <- getOption("renv.timecache.enabled")
  if (identical(enabled, FALSE))
    return(value)

  # read cached time entry
  entry <- renv_timecache_get(key)

  # if the entry is null, this is our first time setting the cache
  if (is.null(entry)) {
    entry <- renv_timecache_entry(key, value)
    renv_timecache_set(entry)
    return(entry$value)
  }

  # if it hasn't yet expired, we'll re-use the cached value
  if (!renv_timecache_expired(entry, limit))
    return(entry$value)

  # cache entry has expired -- run timeout hook if provided
  if (is.function(timeout))
    tryCatch(timeout(key), error = warning)

  # update the cache
  entry <- renv_timecache_entry(key, value)
  renv_timecache_set(entry)

  # return entry value
  entry$value

}

# returns the index of an existing cache entry (if any),
# or an index at which a new element could be inserted
renv_timecache_index <- function(key) {

  data <- `_renv_timecache`$data()

  for (index in seq_along(data)) {
    entry <- data[[index]]
    if (identical(key, entry$key))
      return(index)
  }

  length(data) + 1L

}

renv_timecache_get <- function(key) {
  index <- renv_timecache_index(key)
  `_renv_timecache`$get(index)
}

renv_timecache_set <- function(entry) {
  index <- renv_timecache_index(entry$key)
  `_renv_timecache`$set(index, entry)
}

renv_timecache_entry <- function(key, value) {
  list(time = Sys.time(), key = key, value = value)
}

renv_timecache_expired <- function(entry, limit) {

  diff <- catch(difftime(Sys.time(), entry$time, units = "secs"))
  if (inherits(diff, "error") || diff > limit)
    return(TRUE)

  FALSE

}

renv_truthy_impl <- function(value, values, default) {

  if (is.call(value)) {
    value <- catch(renv_dependencies_eval(value))
    if (inherits(value, "error"))
      return(default)
  }

  case(
    is.null(value)      ~ default,
    is.symbol(value)    ~ as.character(value) %in% values,
    is.na(value)        ~ default,
    is.logical(value)   ~ value,
    is.character(value) ~ value %in% values,
    is.numeric(value)   ~ value != 0,
    ~ tryCatch(as.logical(value), error = function(e) default)
  )

}

truthy <- function(value, default) {
  values <- c("TRUE", "True", "true", "T", "1")
  renv_truthy_impl(value, values, default)
}

falsy <- function(value, default) {
  values <- c("FALSE", "False", "false", "F", "0")
  renv_truthy_impl(value, values, default)
}

renv_type_check <- function(value, type) {

  # quietly convert NAs to requested type
  if (is.null(value) || is.na(value))
    return(convert(value, type))

  # if the value already matches the expected type, return success
  if (inherits(value, type))
    return(value)

  # create error object
  fmt <- "parameter '%s' is not of expected type '%s'"
  msg <- sprintf(fmt, deparse(substitute(value)), type)
  error <- simpleError(msg, sys.call(sys.parent()))

  # report error
  stop(error)

}

renv_type_unexpected <- function(value) {
  fmt <- "parameter '%s' has unexpected type '%s'"
  msg <- sprintf(fmt, deparse(substitute(value)), typeof(value))
  error <- simpleError(msg, sys.call(sys.parent()))
  stop(error)
}

unload <- function(project = NULL, quiet = FALSE) {

  project <- renv_project_resolve(project)
  renv_scope_error_handler()

  if (renv_tests_running())
    return()

  if (quiet)
    renv_scope_options(renv.verbose = FALSE)

  renv_envvars_restore()

  renv_unload_shims(project)
  renv_unload_project(project)
  renv_unload_profile(project)
  renv_unload_envvars(project)
  renv_unload_sandbox(project)
  renv_unload_libpaths(project)
  renv_unload_profile(project)

}

renv_unload_shims <- function(project) {
  renv_shims_deactivate()
}

renv_unload_project <- function(project) {
  Sys.unsetenv("RENV_PROJECT")
}

renv_unload_profile <- function(project) {
  Sys.unsetenv("RENV_PROFILE")
}

renv_unload_envvars <- function(project) {
  renv_envvars_restore()
}

renv_unload_sandbox <- function(project) {
  renv_sandbox_deactivate()
}

renv_unload_libpaths <- function(project) {
  renv_libpaths_restore()
}

renv_unload_profile <- function(project) {
  options(renv.project.path = NULL)
  Sys.unsetenv("RENV_PROFILE")
}

`_renv_update_errors` <- new.env(parent = emptyenv())

renv_update_find_repos <- function(records) {

  results <- lapply(records, function(record) {
    catch(renv_update_find_repos_impl(record))
  })

  failed <- map_lgl(results, inherits, "error")
  if (any(failed))
    renv_update_errors_set("repos", results[failed])

  results[!failed]

}

renv_update_find_repos_impl <- function(record) {

  # retrieve latest-available package
  package <- record$Package
  latest <- catch(renv_available_packages_latest(package))
  if (inherits(latest, "error"))
    return(NULL)

  # validate our versions
  if (empty(latest$Version) || empty(record$Version))
    return(NULL)

  # compare the versions; return NULL if the 'latest' version
  # is older
  compare <- renv_version_compare(latest$Version, record$Version)
  if (compare != 1L)
    return(NULL)

  latest

}

renv_update_find_git <- function(records) {
  renv_parallel_exec(records, renv_update_find_git_impl)
}

renv_update_find_git_impl <- function(record) {

  sha <- renv_remotes_resolve_git_sha_ref(record)

  # if sha is empty:
  # `git remote-ls origin ref` expects ref to be a reference, not a sha
  # it is empty if ref isn't a reference on the repo
  # this may be due to record$RemoteRef actually being a sha
  # or it may be because record$RemoteRef is not a real ref
  # but we can't check, so we will try to fetch the ref & see what we get
  oldsha <- record$RemoteSha %||% ""
  if (nzchar(oldsha) && identical(sha, oldsha))
    return(NULL)

  current <- record
  current$RemoteSha <- sha

  desc <- renv_remotes_resolve_git_description(current)

  current$Version <- desc$Version
  current$Package <- desc$Package

  updated <- renv_version_ge(current$Version, record$Version)
  if (updated)
    return(current)

}

renv_update_find_github <- function(records) {

  # check for GITHUB_PAT
  if (is.na(Sys.getenv("GITHUB_PAT", unset = NA))) {

    msg <- paste(
      "GITHUB_PAT is unset. Updates may fail due to GitHub's API rate limit.",
      "",
      "To increase your GitHub API rate limit:",
      "- Use `usethis::browse_github_pat()` to create a Personal Access Token (PAT).",
      "- Use `usethis::edit_r_environ()` and add the token as `GITHUB_PAT`.",
      sep = "\n"
    )

    warning(msg, call. = FALSE)

  }

  names(records) <- map_chr(records, `[[`, "Package")
  results <- renv_parallel_exec(records, function(record) {
    catch(renv_update_find_github_impl(record))
  })

  failed <- map_lgl(results, inherits, "error")
  if (any(failed))
    renv_update_errors_set("github", results[failed])

  results[!failed]

}

renv_update_find_github_impl <- function(record) {

  # construct and parse record entry
  host   <- record$RemoteHost %||% config$github.host()
  user   <- record$RemoteUsername
  repo   <- record$RemoteRepo
  subdir <- record$RemoteSubdir
  ref    <- record$RemoteRef

  # check for changed sha
  sha <- renv_remotes_resolve_github_sha_ref(host, user, repo, ref)
  if (sha == record$RemoteSha)
    return(NULL)

  # get updated record
  desc <- renv_remotes_resolve_github_description(host, user, repo, subdir, sha)
  current <- list(
    Package        = desc$Package,
    Version        = desc$Version,
    Source         = "GitHub",
    RemoteUsername = user,
    RemoteRepo     = repo,
    RemoteSubdir   = subdir,
    RemoteRef      = ref,
    RemoteSha      = sha,
    RemoteHost     = host
  )

  # check that the version has actually updated
  updated <-
    current$RemoteSha != record$RemoteSha &&
    numeric_version(current$Version) >= numeric_version(record$Version)

  if (updated)
    return(current)

}

renv_update_find <- function(records) {

  sources <- extract_chr(records, "Source")
  grouped <- split(records, sources)

  # retrieve updates
  results <- enumerate(grouped, function(source, records) {
    case(
      source == "Bioconductor" ~ renv_update_find_repos(records),
      source == "Repository"   ~ renv_update_find_repos(records),
      source == "GitHub"       ~ renv_update_find_github(records),
      source == "Git"          ~ renv_update_find_git(records)
    )
  })

  # remove groupings
  ungrouped <- unlist(results, recursive = FALSE, use.names = FALSE)
  if (empty(ungrouped))
    return(list())

  # keep non-null results
  updates <- Filter(Negate(is.null), ungrouped)
  if (empty(updates))
    return(list())

  names(updates) <- extract_chr(updates, "Package")
  renv_records_sort(updates)

}



#' Update Packages
#'
#' Update packages which are currently out-of-date. Currently, only
#' CRAN and GitHub package sources are supported.
#'
#' Updates will only be checked from the same source -- for example,
#' if a package was installed from GitHub, but a newer version is
#' available on CRAN, that updated version will not be seen.
#'
#' You can call `renv::update()` with no arguments to update all packages within
#' the project, excluding any packages ignored via the `ignored.packages`
#' project setting. Use the `exclude` argument to further refine the exclusion
#' criteria if desired.
#'
#' @inherit renv-params
#' @inheritParams install-params
#'
#' @param packages A character vector of \R packages to update. When `NULL`
#'   (the default), all packages will be updated.
#'
#' @param check Boolean; check for package updates without actually
#'   installing available updates? This is useful when you'd like to determine
#'   what updates are available, without actually installing those updates.
#'
#' @param exclude A set of packages to explicitly exclude from updating.
#'   Use `renv::update(exclude = <...>)` to update all packages except for
#'   a specific set of excluded packages.
#'
#' @return A named list of package records which were installed by `renv`.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # update the 'dplyr' package
#' renv::update("dplyr")
#'
#' }
update <- function(packages = NULL,
                   ...,
                   exclude = NULL,
                   library = NULL,
                   rebuild = FALSE,
                   check   = FALSE,
                   prompt  = interactive(),
                   project = NULL)
{
  renv_consent_check()
  renv_scope_error_handler()
  renv_dots_check(...)

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  # get package records
  libpaths <- renv_libpaths_resolve(library)
  library <- nth(libpaths, 1L)
  records <- renv_snapshot_r_packages(libpaths = libpaths, project = project)
  packages <- packages %||% setdiff(names(records), settings$ignored.packages(project = project))

  # apply exclusions
  packages <- setdiff(packages, exclude)

  # if users have requested the use of pak, delegate there
  if (config$pak.enabled() && !recursing()) {
    renv_pak_init()
    return(renv_pak_install(packages, libpaths))
  }

  # check if the user has requested update for packages not installed
  missing <- renv_vector_diff(packages, names(records))
  if (!empty(missing)) {

    if (prompt || renv_verbose()) {
      renv_pretty_print(
        missing,
        "The following package(s) are not currently installed:",
        "The latest available versions of these packages will be installed instead.",
        wrap = FALSE
      )
    }

    if (prompt && !proceed()) {
      renv_report_user_cancel()
      return(invisible(FALSE))
    }

  }

  # select records
  selected <- c(
    records[renv_vector_intersect(packages, names(records))],
    named(lapply(missing, renv_available_packages_latest), missing)
  )

  # check for usage of cran, bioc
  repo <- FALSE
  bioc <- FALSE

  for (record in selected) {

    source <- renv_record_source(record, normalize = TRUE)

    if (source %in% c("repository")) {
      repo <- TRUE
      next
    }

    if (source %in% c("bioconductor")) {
      repo <- bioc <- TRUE
      next
    }

  }

  # activate bioc repositories if needed
  if (bioc)
    renv_scope_bioconductor(project = project)

  # ensure database of available packages is current
  if (repo)
    for (type in renv_package_pkgtypes())
      renv_available_packages(type = type)

  vprintf("* Checking for updated packages ... ")

  # remove records that appear to be from an R package repository,
  # but are not actually available in the current repositories
  selected <- Filter(function(record) {

    source <- renv_record_source(record, normalize = TRUE)
    if (!source %in% c("bioconductor", "cran", "repository"))
      return(TRUE)

    # check for available package
    package <- record$Package
    entry <- catch(renv_available_packages_latest(package))
    !inherits(entry, "error")

  }, selected)

  updates <- renv_update_find(selected)
  vwritef("Done!")

  renv_update_errors_emit()

  if (empty(updates)) {
    vwritef("* All packages appear to be up-to-date.")
    return(invisible(TRUE))
  }

  # perform a diff (for reporting to user)
  old <- selected[names(updates)]
  new <- updates
  diff <- renv_lockfile_diff_packages(old, new)

  # if we're only checking for updates, just report and exit
  if (check) {

    fmt <- case(
      length(diff) == 1 ~ "* %i package has updates available.",
      length(diff) != 1 ~ "* %i packages have updates available."
    )

    vwritef(fmt, length(diff))
    updates <- renv_updates(diff = diff, old = old, new = new)
    return(updates)

  }

  if (prompt || renv_verbose())
    renv_restore_report_actions(diff, old, new)

  if (prompt && !proceed()) {
    renv_report_user_cancel()
    return(invisible(FALSE))
  }

  # perform the install
  install(
    packages = updates,
    library  = libpaths,
    rebuild  = rebuild,
    project  = project
  )

}

renv_update_errors_set <- function(key, errors) {
  assign(key, errors, envir = `_renv_update_errors`)
}

renv_update_errors_clear <- function() {
  rm(
    list = ls(envir = `_renv_update_errors`, all.names = TRUE),
    envir = `_renv_update_errors`
  )
}

renv_update_errors_emit <- function() {

  # clear errors when we're done
  on.exit(renv_update_errors_clear(), add = TRUE)

  # if we have any errors, start by emitting a single newline
  all <- ls(envir = `_renv_update_errors`, all.names = TRUE)
  if (!empty(all))
    writef()

  # then emit errors for each class
  renv_update_errors_emit_repos()
  renv_update_errors_emit_github()

}

renv_update_errors_emit_impl <- function(key, preamble, postamble) {

  errors <- `_renv_update_errors`[[key]]
  if (empty(errors))
    return()

  messages <- enumerate(errors, function(package, error) {
    errmsg <- paste(conditionMessage(error), collapse = "; ")
    sprintf("%s: %s", format(package), errmsg)
  })

  renv_pretty_print(
    values = messages,
    preamble = preamble,
    postamble = postamble,
    wrap = FALSE
  )

}

renv_update_errors_emit_repos <- function() {

  renv_update_errors_emit_impl(
    key       = "repos",
    preamble  = "One or more errors occurred while finding updates for the following packages:",
    postamble = "Ensure that these packages are available from your active package repositories."
  )

}

renv_update_errors_emit_github <- function() {

  renv_update_errors_emit_impl(
    key       = "github",
    preamble  = "One or more errors occurred while finding updates for the following GitHub packages:",
    postamble = "Ensure that these packages were installed from an accessible GitHub remote."
  )

}


renv_updates <- function(diff, old, new) {
  data <- list(diff = diff, old = old, new = new)
  class(data) <- "renv_updates"
  data
}

#' @export
print.renv_updates <- function(x, ...) {

  old <- x$old; new <- x$new; diff <- x$diff

  lhs <- renv_records(old)
  rhs <- renv_records(new)
  renv_pretty_print_records_pair(
    lhs[names(lhs) %in% names(diff)],
    rhs[names(rhs) %in% names(diff)]
  )

}

#' Upgrade renv
#'
#' Upgrade the version of `renv` associated with a project.
#'
#' By default, this function will attempt to install the latest version of
#' `renv` as available on the active R package repositories. If you'd instead
#' like to try out a development version of `renv`, you can explicitly request a
#' different version of `renv` and that version of the package will be
#' downloaded and installed from GitHub. Use `version = "main"` to install the
#' latest development version of `renv`, as from the `renv` project's [GitHub
#' page](https://github.com/rstudio/renv).
#'
#' @inherit renv-params
#'
#' @param version The version of `renv` to be installed. By default, the latest
#'   version of `renv` as available on the active R package repositories is
#'   used.
#'
#' @param prompt Boolean; prompt upgrade before proceeding?
#'
#' @param reload Boolean; reload `renv` after install? When `NULL` (the
#'   default), `renv` will be re-loaded only if updating `renv` for the
#'   active project. Note that this may fail if you've loaded packages
#'   which also depend on `renv`.
#'
#' @return A boolean value, indicating whether the requested version of
#'   `renv` was successfully installed. Note that this function is normally
#'   called for its side effects.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # upgrade to the latest version of renv
#' renv::upgrade()
#'
#' # upgrade to the latest version of renv on GitHub (development version)
#' renv::upgrade(version = "main")
#'
#' }
upgrade <- function(project = NULL,
                    version = NULL,
                    reload  = NULL,
                    prompt = interactive())
{
  renv_scope_error_handler()
  invisible(renv_upgrade_impl(project, version, reload, prompt))
}

renv_upgrade_impl <- function(project, version, reload, prompt) {

  project <- renv_project_resolve(project)
  renv_scope_lock(project = project)

  reload <- reload %||% identical(project, renv_project())

  old <- renv_snapshot_description(package = "renv")
  new <- renv_upgrade_find_record(version)

  # check for some form of change
  if (renv_records_equal(old, new)) {
    fmt <- "* renv [%s] is already installed and active for this project."
    vwritef(fmt, new$Version)
    return(TRUE)
  }

  if (prompt || renv_verbose()) {
    renv_pretty_print_records_pair(
      list(renv = old), list(renv = new),
      "A new version of the renv package will be installed:",
      "This project will use the newly-installed version of renv."
    )
  }

  if (prompt && !proceed()) {
    renv_report_user_cancel()
    return(FALSE)
  }

  renv_scope_restore(
    project   = project,
    library   = renv_libpaths_default(),
    records   = list(renv = new),
    packages  = "renv",
    recursive = FALSE
  )

  # retrieve and install renv
  records <- retrieve("renv")
  renv_install_impl(records)

  # update the lockfile
  lockfile <- renv_lockfile_load(project = project)
  records <- renv_records(lockfile) %||% list()
  records$renv <- new
  renv_records(lockfile) <- records
  renv_lockfile_save(lockfile, project = project)

  # now update the infrastructure to use this version of renv
  record <- records[["renv"]]
  renv_infrastructure_write(project, version = record$Version)

  # reload renv
  if (reload)
    renv_package_reload("renv")

  invisible(TRUE)

}

renv_upgrade_find_record <- function(version) {

  if (is.null(version))
    renv_upgrade_find_record_default()
  else
    renv_upgrade_find_record_dev(version)

}

renv_upgrade_find_record_default <- function() {

  # check if the package is available on R repositories.
  # if not, prefer GitHub
  record <- catch(renv_available_packages_latest("renv"))
  if (inherits(record, "error"))
    return(renv_upgrade_find_record_dev())

  # check the version reported by R repositories.
  # if it's older than current renv, then prefer GitHub
  version <- record$Version
  if (package_version(version) < renv_namespace_version("renv"))
    return(renv_upgrade_find_record_dev())

  # ok -- install from repository
  record

}

renv_upgrade_find_record_dev <- function(version = NULL) {
  version <- version %||% renv_upgrade_find_record_dev_latest()
  entry <- paste("rstudio/renv", version, sep = "@")
  renv_remotes_resolve(entry)
}


renv_upgrade_find_record_dev_latest <- function() {

  # download tags
  url <- "https://api.github.com/repos/rstudio/renv/tags"
  destfile <- tempfile("renv-tags-", fileext = ".json")
  download(url, destfile = destfile, quiet = TRUE)
  json <- renv_json_read(destfile)

  # find latest version
  names <- extract_chr(json, "name")
  versions <- numeric_version(names, strict = FALSE)
  latest <- sort(versions, decreasing = TRUE)[[1]]
  names[versions %in% latest][[1L]]

}

#' Use Python
#'
#' Associate a version of Python with your project.
#'
#' When Python integration is active, `renv` will:
#'
#' - Save metadata about the requested version of Python in `renv.lock` -- in
#'   particular, the Python version, and the Python type ("virtualenv", "conda",
#'   "system"),
#'
#' - Capture the set of installed Python packages during `renv::snapshot()`,
#'
#' - Re-install the set of recorded Python packages during `renv::restore()`.
#'
#' In addition, when the project is loaded, the following actions will be taken:
#'
#' - The `RENV_PYTHON` environment variable will be set, indicating the version
#'   of Python currently active for this sessions,
#'
#' - The `RETICULATE_PYTHON` environment variable will be set, so that the
#'   `reticulate` package can automatically use the requested copy of Python
#'   as appropriate,
#'
#' - The requested version of Python will be placed on the `PATH`, so that
#'   attempts to invoke Python will resolve to the expected version of Python.
#'
#' You can override the version of Python used in a particular project by
#' setting the `RENV_PYTHON` environment variable; e.g. as part of the
#' project's `.Renviron` file. This can be useful if you find that `renv`
#' is unable to automatically discover a compatible version of Python to
#' be used in the project.
#'
#' @inherit renv-params
#'
#' @param ... Optional arguments; currently unused.
#'
#' @param python
#'   The path to the version of Python to be used with this project. See
#'   **Finding Python** for more details.
#'
#' @param type
#'   The type of Python environment to use. When `"auto"` (the default),
#'   virtual environments will be used.
#'
#' @param name
#'   The name or path that should be used for the associated Python environment.
#'   If `NULL` and `python` points to a Python executable living within a
#'   pre-existing virtual environment, that environment will be used. Otherwise,
#'   a project-local environment will be created instead, using a name
#'   generated from the associated version of Python.
#'
#'
#' @section Finding Python:
#'
#' In interactive sessions, when `python = NULL`, `renv` will prompt for an
#' appropriate version of Python. `renv` will search a pre-defined set of
#' locations when attempting to find Python installations on the system:
#'
#' - `getOption("renv.python.root")`,
#' - `/opt/python`,
#' - `/opt/local/python`,
#' - `~/opt/python`,
#' - `/usr/local/opt` (for macOS Homebrew-installed copies of Python),
#' - `/opt/homebrew/opt` (for M1 macOS Homebrew-installed copies of Python),
#' - `~/.pyenv/versions`,
#' - Python instances available on the `PATH`.
#'
#' In non-interactive sessions, `renv` will first check the `RETICULATE_PYTHON`
#' environment variable; if that is unset, `renv` will look for Python on the
#' `PATH`. It is recommended that the version of Python to be used is explicitly
#' supplied for non-interactive usages of `use_python()`.
#'
#'
#' @section Warning:
#'
#' We strongly recommend using Python virtual environments, for a few reasons:
#'
#' 1. If something goes wrong with a local virtual environment, you can safely
#'    delete that virtual environment, and then re-initialize it later, without
#'    worry that doing so might impact other software on your system.
#'
#' 2. If you choose to use a "system" installation of Python, then any packages
#'    you install or upgrade will be visible to any other application that
#'    wants to use that same Python installation. Using a virtual environment
#'    ensures that any changes made are isolated to that environment only.
#'
#' 3. Choosing to use Anaconda will likely invite extra frustration in the
#'    future, as you may be required to upgrade and manage your Anaconda
#'    installation as new versions of Anaconda are released. In addition,
#'    Anaconda installations tend to work poorly with software not specifically
#'    installed as part of that same Anaconda installation.
#'
#' In other words, we recommend selecting "system" or "conda" only if you are an
#' expert Python user who is already accustomed to managing Python / Anaconda
#' installations on your own.
#'
#'
#' @return
#'   `TRUE`, indicating that the requested version of Python has been
#'   successfully activated. Note that this function is normally called for its
#'   side effects.
#'
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # use python with a project
#' renv::use_python()
#'
#' # use python with a project; create the environment
#' # within the project directory in the '.venv' folder
#' renv::use_python(name = ".venv")
#'
#' # use python with a pre-existing virtual environment located elsewhere
#' renv::use_python(name = "~/.virtualenvs/env")
#'
#' # use virtualenv python with a project
#' renv::use_python(type = "virtualenv")
#'
#' # use conda python with a project
#' renv::use_python(type = "conda")
#'
#' }
use_python <- function(python = NULL,
                       ...,
                       type = c("auto", "virtualenv", "conda", "system"),
                       name    = NULL,
                       project = NULL)
{
  renv_scope_error_handler()
  renv_dots_check(...)
  project <- renv_project_resolve(project)

  # deactivate python integration when FALSE
  if (identical(python, FALSE))
    return(renv_python_deactivate(project))

  # handle 'auto' type
  type <- match.arg(type)
  if (identical(type, "auto"))
    type <- "virtualenv"

  case(
    type == "system"     ~ renv_use_python_system(python, name, project),
    type == "virtualenv" ~ renv_use_python_virtualenv(python, name, project),
    type == "conda"      ~ renv_use_python_condaenv(python, name, project)
  )
}

renv_use_python_system <- function(python,
                                   name,
                                   project)
{
  # retrieve python information
  python <- renv_python_resolve(python)
  version <- renv_python_version(python)
  info <- renv_python_info(python)

  # if the user ended up selecting a virtualenv or conda python, then
  # just activate those and ignore the 'system' request
  if (identical(info$type, "virtualenv"))
    return(renv_use_python_virtualenv(info$python, name, project))
  if (identical(info$type, "conda"))
    return(renv_use_python_condaenv(info$python, name, project))

  # for 'system' python usages, we just use the path to python
  # (note that this may not be portable or useful for other machines)
  renv_use_python_fini(info, python, version, project)
}

renv_use_python_virtualenv <- function(python,
                                       name,
                                       project)
{
  # if name has been set, check and see if it refers to an already-existing
  # virtual environment; if that exists, use it
  if (is.null(python) && !is.null(name)) {
    path <- renv_python_virtualenv_path(name)
    if (file.exists(path))
      python <- renv_python_exe(name)
  }

  python  <- renv_python_resolve(python)
  version <- renv_python_version(python)
  info    <- renv_python_info(python)

  # if name is unset, and 'python' doesn't already refer to an existing
  # virtual environment, then we'll use a local virtual environment
  local <- is.null(name) && identical(info$type, "virtualenv")
  if (local) {
    name <- aliased_path(info$root)
    if (renv_path_same(dirname(name), renv_python_virtualenv_home()))
      name <- basename(name)
  } else {
    name <- name %||% renv_python_envpath(project, "virtualenv", version)
    if (grepl("/", name, fixed = TRUE))
      name <- renv_path_canonicalize(name)
  }

  # now, check to see if the python environment exists;
  # if it does not exist, we'll create it now
  vpython <- renv_use_python_virtualenv_impl(project, name, version, python)
  vinfo <- renv_python_info(vpython)

  # finish up now
  renv_use_python_fini(vinfo, name, version, project)

}

renv_use_python_condaenv <- function(python,
                                     name,
                                     project)
{
  # if python is set, see if it's already the path to a python interpreter
  # living within a conda environment
  while (!is.null(python)) {

    if (!is.null(name)) {
      fmt <- "ignoring value of name %s as python was already set"
      warningf(fmt, renv_path_pretty(name))
    }

    # validate that this is a conda python
    info <- renv_python_info(python)
    if (!identical(info$type, "conda")) {
      fmt <- "%s does not appear to refer to a Conda instance of Python; ignoring"
      warningf(fmt, renv_path_pretty(python))
      break
    }

    # use this edition of python without further adieu
    version <- renv_python_version(python)
    return(renv_use_python_fini(info, name, version, project))

  }

  # TODO: how do we select which version of python we want to use?
  name <- name %||% renv_python_envpath(project, "conda")
  python <- renv_use_python_condaenv_impl(project, name)
  info <- renv_python_info(python)
  version <- renv_python_version(python)

  renv_use_python_fini(info, name, version, project)

}

renv_use_python_fini <- function(info,
                                 name,
                                 version,
                                 project)
{
  # ensure project-local names are treated as such
  name    <- if (!is.null(name))    path.expand(chartr("\\", "/", name))
  project <- if (!is.null(project)) path.expand(chartr("\\", "/", project))

  if (!is.null(name) && startswith(name, project)) {
    base <- substring(name, nchar(project) + 2L)
    name <- if (grepl("^[.][^/]+$", base)) base else file.path(".", base)
  }

  # form the lockfile fields we'll want to write
  fields <- as.list(c(Version = version, Type = info$type, Name = name))

  # update the lockfile
  lockfile <- renv_lockfile_load(project)
  if (!identical(fields, lockfile$Python)) {
    lockfile$Python <- fields
    renv_lockfile_save(lockfile, project)
  }

  # re-initialize with these settings
  renv_load_python(project, fields)

  # notify user
  if (!renv_tests_running()) {
    if (is.null(info$type)) {
      fmt <- "* Activated Python %s (%s)."
      vwritef(fmt, version, aliased_path(info$python))
    } else {
      fmt <- "* Activated Python %s [%s; %s]"
      vwritef(fmt, version, info$type, aliased_path(name))
    }
  }

  # report to user
  setwd(project)
  activate(project = project)

  invisible(info$python)

}

# return the path to an existing python binary associated with the virtual
# environment having name 'name' and version 'version', or "" if no such
# python instance exists
renv_use_python_virtualenv_impl_existing <- function(project,
                                                     name = NULL,
                                                     version = NULL)
{
  # resolve environment path from name
  name <- name %||% renv_python_envpath(project, "virtualenv", version)
  path <- renv_python_virtualenv_path(name)
  if (!file.exists(path))
    return("")

  # check that this appears to have a valid python executable
  info <- catch(renv_python_info(path))
  if (inherits(info, "error")) {
    warning(info)
    return("")
  }

  # validate version and return
  renv_python_virtualenv_validate(path, version)
}

# Internal helper for activating a Python virtual environment
#
# @param project
#   The project directory.
#
# @param name
#   The environment name, if any. If unset, it should be constructed
#   based on the Python executable used (note: _not_ the version parameter)
#
# @param version
#   The _requested_ version of Python (which may not be the actual version!)
#   This version should be used as a hint for finding an appropriate version
#   of Python, if the environment needs to be re-created.
#
# @param python
#   The copy of Python to be used. When unset, an appropriate version of Python
#   should be discovered based on the `version` parameter.
#
# @return
#   The path to the Python binary in the associated virtual environment.
#
renv_use_python_virtualenv_impl <- function(project,
                                            name = NULL,
                                            version = NULL,
                                            python = NULL)
{
  # first, look for an already-existing python installation
  # associated with the requested version of python
  exe <- renv_use_python_virtualenv_impl_existing(project, name, version)
  if (file.exists(exe))
    return(exe)

  # couldn't resolve environment from requested version; try to find
  # a compatible version of python and re-create that environment
  python <- python %||% renv_python_find(version)
  pyversion <- renv_python_version(python)
  name <- name %||% renv_python_envpath(project, "virtualenv", pyversion)
  path <- renv_python_virtualenv_path(name)

  # if the environment already exists, but is associated with a different
  # version of Python, prompt the user to re-create that environment
  if (file.exists(path)) {
    exe <- renv_python_virtualenv_validate(path, version)
    if (file.exists(exe))
      return(exe)
  }

  vprintf("* Creating virtual environment '%s' ... ", basename(name))
  vpython <- renv_python_virtualenv_create(python, path)
  vwritef("Done!")

  vprintf("* Updating Python packages ... ")
  renv_python_virtualenv_update(vpython)
  vwritef("Done!")

  renv_python_virtualenv_validate(path, version)

}

renv_use_python_condaenv_impl <- function(project,
                                          name = NULL,
                                          version = NULL,
                                          python = NULL)
{
  # if we can't load reticulate, try installing if there is a version
  # recorded in the lockfile
  if (!requireNamespace("reticulate", quietly = TRUE)) {

    # retrieve reticulate record
    lockfile <- renv_lockfile_load(project = project)
    records <- renv_records(lockfile)
    reticulate <- records[["reticulate"]]

    # if we have a reticulate record, then attempt to restore
    if (!is.null(reticulate)) {
      restore(packages = "reticulate",
              prompt = FALSE,
              project = project)
    } else {
      install(packages = "reticulate",
              prompt = FALSE,
              project = project)
    }

  }

  # try once more to load reticulate
  if (!requireNamespace("reticulate", quietly = TRUE))
    stopf("use of conda environments requires the 'reticulate' package")

  # TODO: how to handle things like a requested Python version here?
  name <- name %||% renv_python_envpath(project, "conda", version)
  renv_python_conda_select(name, version)
}

renv_python_deactivate <- function(project) {

  file <- renv_lockfile_path(project)
  if (!file.exists(file))
    return(TRUE)

  lockfile <- renv_lockfile_read(file)
  if (is.null(lockfile$Python))
    return(TRUE)

  lockfile$Python <- NULL
  renv_lockfile_write(lockfile, file = file)
  vwritef("* Deactived Python -- the lockfile has been updated.")
  TRUE

}

#' Use a set of Packages
#'
#' Given a set of \R package requirements, install those packages into the
#' library path requested via `library`, and then activate that library path.
#'
#' `renv::use()` is intended to be used within standalone \R scripts. It can
#' be useful when you'd like to specify an \R script's dependencies directly
#' within that script, and have those packages automatically installed and
#' loaded when the associated script is run. In this way, an \R script can more
#' easily be shared and re-run with the exact package versions requested via
#' `use()`.
#'
#' `renv::use()` is inspired in part by the [groundhog](https://groundhogr.com/)
#' package, which also allows one to specify a script's \R package requirements
#' within that same \R script.
#'
#' @param ...
#'   The \R packages to be used with this script. Ignored if `lockfile` is
#'   non-`NULL`.
#'
#' @param lockfile
#'   The lockfile to use. When supplied, `renv` will use the packages as
#'   declared in the lockfile.
#'
#' @param library
#'   The library path into which the requested packages should be installed.
#'   When `NULL` (the default), a library path within the \R temporary
#'   directory will be generated and used. Note that this same library path
#'   will be re-used on future calls to `renv::use()`, allowing `renv::use()`
#'   to be used multiple times within a single script.
#'
#' @param isolate
#'   Boolean; should the active library paths be included in the set of library
#'   paths activated for this script? Set this to `TRUE` if you only want the
#'   packages provided to `renv::use()` to be visible on the library paths.
#'
#' @param attach
#'   Boolean; should the set of requested packages be automatically attached?
#'   If `TRUE`, packages will be loaded and attached via a call
#'   to [library()] after install. Ignored if `lockfile` is non-`NULL`.
#'
#' @param verbose
#'   Boolean; be verbose while installing packages?
#'
#' @return
#'   This function is normally called for its side effects.
#'
#' @export
use <- function(...,
                lockfile = NULL,
                library  = NULL,
                isolate  = FALSE,
                attach   = FALSE,
                verbose  = TRUE)
{

  # allow use of the cache in this context
  renv_scope_options(renv.cache.linkable = TRUE)

  # prepare library and activate library
  library <- library %||% renv_use_libpath()
  ensure_directory(library)

  # set library paths
  libpaths <- c(library, if (!isolate) .libPaths())
  renv_libpaths_set(libpaths)

  # if we were supplied a lockfile, use it
  if (!is.null(lockfile)) {
    renv_scope_options(renv.verbose = verbose)
    records <- restore(lockfile = lockfile, clean = FALSE)
    return(invisible(records))
  }

  dots <- list(...)
  if (empty(dots))
    return(invisible())

  # resolve the provided remotes
  remotes <- lapply(dots, renv_remotes_resolve)
  names(remotes) <- map_chr(remotes, `[[`, "Package")

  fmt <- "* renv is installing %i package(s) and their dependencies ... "
  vprintf(fmt, length(remotes))

  # install packages
  records <- local({
    renv_scope_options(renv.verbose = verbose)
    install(packages = remotes, library = library, prompt = FALSE)
  })

  vwritef("Done!")

  # automatically load the requested remotes
  if (attach) {
    enumerate(remotes, function(package, remote) {
      library(package, character.only = TRUE)
    })
  }

  # return set of installed packages
  invisible(records)

}

renv_use_libpath <- function() {
  renv_global("use.library", tempfile("renv-library-"))
}

textfile <- function(description, open = "wt") {
  file(description, open = open, encoding = "native.enc")
}

sprintf <- function(fmt, ...) {

  dots <- eval(substitute(alist(...)))
  if (length(dots) == 0)
    return(fmt)

  base::sprintf(fmt, ...)

}

stopf <- function(fmt = "", ..., call. = FALSE) {
  stop(sprintf(fmt, ...), call. = call.)
}

warningf <- function(fmt = "", ..., call. = FALSE, immediate. = FALSE) {
  warning(sprintf(fmt, ...), call. = call., immediate. = immediate.)
}

messagef <- function(fmt = "", ..., appendLF = TRUE) {
  message(sprintf(fmt, ...), appendLF = appendLF)
}

vmessagef <- function(fmt = "", ..., appendLF = TRUE) {
  if (renv_verbose())
    message(sprintf(fmt, ...), appendLF = appendLF)
}



printf <- function(fmt = "", ..., file = stdout()) {
  if (!is.null(fmt) && renv_tests_verbose())
    cat(sprintf(fmt, ...), file = file, sep = "")
}

eprintf <- function(fmt = "", ..., file = stderr()) {
  if (!is.null(fmt) && renv_tests_verbose())
    cat(sprintf(fmt, ...), file = file, sep = "")
}

vprintf <- function(fmt = "", ..., file = stdout()) {
  if (!is.null(fmt) && renv_verbose())
    cat(sprintf(fmt, ...), file = file, sep = "")
}

veprintf <- function(fmt = "", ..., file = stderr()) {
  if (!is.null(fmt) && renv_verbose())
    cat(sprintf(fmt, ...), file = file, sep = "")
}



writef <- function(fmt = "", ..., con = stdout()) {
  if (!is.null(fmt) && renv_tests_verbose())
    writeLines(sprintf(fmt, ...), con = con)
}

ewritef <- function(fmt = "", ..., con = stderr()) {
  if (!is.null(fmt) && renv_tests_verbose())
    writeLines(sprintf(fmt, ...), con = con)
}

vwritef <- function(fmt = "", ..., con = stdout()) {
  if (!is.null(fmt) && renv_verbose())
    writeLines(sprintf(fmt, ...), con = con)
}

vewritef <- function(fmt = "", ..., con = stderr()) {
  if (!is.null(fmt) && renv_verbose())
    writeLines(sprintf(fmt, ...), con = con)
}

infof <- function(fmt = "", ..., con = stdout()) {
  if (!is.null(fmt) && renv_tests_verbose()) {
    fmt <- paste(if (l10n_info()$`UTF-8`) "\u2139" else "i", fmt)
    writeLines(sprintf(fmt, ...), con = con)
  }
}

bapply <- function(x, f, ..., index = "Index") {
  result <- lapply(x, f, ...)
  bind(result, index = index)
}

enumerate <- function(x, f, ..., FUN.VALUE = NULL) {

  n <- names(x)
  idx <- named(seq_along(x), n)
  callback <- function(i) f(n[[i]], x[[i]], ...)

  if (is.null(FUN.VALUE))
    lapply(idx, callback)
  else
    vapply(idx, callback, FUN.VALUE = FUN.VALUE)

}

enum_chr <- function(x, f, ...) {
  enumerate(x, f, ..., FUN.VALUE = "character")
}

enum_int <- function(x, f, ...) {
  enumerate(x, f, ..., FUN.VALUE = "integer")
}

enum_dbl <- function(x, f, ...) {
  enumerate(x, f, ..., FUN.VALUE = "double")
}

enum_lgl <- function(x, f, ...) {
  enumerate(x, f, ..., FUN.VALUE = "logical")
}


uapply <- function(x, f, ...) {
  f <- match.fun(f)
  unlist(lapply(x, f, ...), recursive = FALSE)
}

filter <- function(x, f, ...) {
  f <- match.fun(f)
  x[map_lgl(x, f, ...)]
}

reject <- function(x, f, ...) {
  f <- match.fun(f)
  x[!map_lgl(x, f, ...)]
}

map <- function(x, f, ...) {
  f <- match.fun(f)
  lapply(x, f, ...)
}

map_chr <- function(x, f, ...) {
  f <- match.fun(f)
  vapply(x, f, ..., FUN.VALUE = character(1))
}

map_dbl <- function(x, f, ...) {
  f <- match.fun(f)
  vapply(x, f, ..., FUN.VALUE = numeric(1))
}

map_int <- function(x, f, ...) {
  f <- match.fun(f)
  vapply(x, f, ..., FUN.VALUE = integer(1))
}

map_lgl <- function(x, f, ...) {
  f <- match.fun(f)
  vapply(x, f, ..., FUN.VALUE = logical(1))
}


extract <- function(x, ...) {
  lapply(x, `[[`, ...)
}

extract_chr <- function(x, ...) {
  vapply(x, `[[`, ..., FUN.VALUE = character(1))
}

extract_dbl <- function(x, ...) {
  vapply(x, `[[`, ..., FUN.VALUE = numeric(1))
}

extract_int <- function(x, ...) {
  vapply(x, `[[`, ..., FUN.VALUE = integer(1))
}

extract_lgl <- function(x, ...) {
  vapply(x, `[[`, ..., FUN.VALUE = logical(1))
}

`%>%` <- function(...) {

  dots <- eval(substitute(alist(...)))
  if (length(dots) != 2L)
    stopf("`%>%` called with invalid number of arguments")

  lhs <- dots[[1L]]; rhs <- dots[[2L]]
  if (!is.call(rhs))
    stopf("right-hand side of rhs is not a call")

  data <- c(rhs[[1L]], lhs, as.list(rhs[-1L]))
  call <- as.call(data)

  nm <- names(rhs)
  if (length(nm))
    names(call) <- c("", "", nm[-1L])

  eval(call, envir = parent.frame())

}

`%""%` <- function(x, y) {
  if (length(x) && nzchar(x)) x else y
}

`%NA%` <- function(x, y) {
  if (length(x) && is.na(x)) y else x
}

`%NULL%` <- function(x, y) {
  if (is.null(x)) y else x
}

`%&&%` <- function(x, y) {
  if (length(x)) y
}


lines <- function(...) {
  paste(..., sep = "\n")
}

is_named <- function(x) {
  nm <- names(x)
  !is.null(nm) && all(nzchar(nm))
}

named <- function(object, names = object) {
  names(object) <- names
  object
}

empty <- function(x) {
  length(x) == 0
}

aliased_path <- function(path) {

  home <-
    Sys.getenv("HOME") %""%
    Sys.getenv("R_USER")

  if (!nzchar(home))
    return(path)

  home <- gsub("\\", "/", home, fixed = TRUE)
  path <- gsub("\\", "/", path, fixed = TRUE)

  match <- regexpr(home, path, fixed = TRUE, useBytes = TRUE)
  path[match == 1] <- file.path("~", substring(path[match == 1], nchar(home) + 2L))

  path

}

trimws <- function(x) {
  gsub("^\\s+|\\s+$", "", x)
}

case <- function(...) {

  dots <- eval(substitute(alist(...)))
  for (i in seq_along(dots)) {

    if (identical(dots[[i]], quote(expr = )))
      next

    dot <- eval(dots[[i]], envir = parent.frame())
    if (!inherits(dot, "formula"))
      return(dot)

    else if (length(dot) == 2) {
      expr <- dot[[2]]
      return(eval(expr, envir = environment(dot)))
    }

    else {

      cond <- dot[[2]]
      expr <- dot[[3]]
      if (eval(cond, envir = environment(dot)))
        return(eval(expr, envir = environment(dot)))

    }
  }

  NULL

}

catch <- function(expr) {
  tryCatch(
    withCallingHandlers(expr, error = renv_error_capture),
    error = renv_error_tag
  )
}

catchall <- function(expr) {
  tryCatch(
    withCallingHandlers(expr, condition = renv_error_capture),
    condition = renv_error_tag
  )
}

# nocov start

ask <- function(question, default = FALSE) {

  if (renv_tests_running())
    return(TRUE)

  if (!interactive())
    return(default)

  # TODO: presumedly we don't want to prompt in the autoloader
  # because it might cause issues in RStudio?
  initializing <- getOption("renv.autoloader.running")
  if (identical(initializing, TRUE))
    return(default)

  selection <- if (default) "[Y/n]" else "[y/N]"
  prompt <- sprintf("%s %s: ", question, selection)
  response <- tolower(trimws(readline(prompt)))
  if (!nzchar(response))
    return(default)

  substring(response, 1L, 1L) == "y"

}

proceed <- function(default = FALSE) {
  ask("Do you want to proceed?", default = default)
}

# nocov end

inject <- function(contents,
                   pattern,
                   replacement,
                   anchor = NULL)
{
  # first, check to see if the pattern matches a line
  index <- grep(pattern, contents)
  if (length(index)) {
    contents[index] <- replacement
    return(contents)
  }

  # otherwise, check for the anchor, and insert after
  index <- if (!is.null(anchor)) grep(anchor, contents)
  if (length(index)) {
    contents <- c(
      head(contents, n = index),
      replacement,
      tail(contents, n = -index)
    )
    return(contents)
  }

  # otherwise, just append the new line
  c(contents, replacement)
}

env <- function(...) {
  list2env(list(...), envir = new.env(parent = emptyenv()))
}

deparsed <- function(value, width = 60L) {
  paste(deparse(value, width.cutoff = width), collapse = "\n")
}

read <- function(file) {
  contents <- readLines(file, warn = FALSE)
  paste(contents, collapse = "\n")
}

plural <- function(word, n) {
  if (n == 1) word else paste(word, "s", sep = "")
}

trunc <- function(text, n = 78) {
  long <- nchar(text) > n
  text[long] <- sprintf("%s <...>", substring(text[long], 1, n - 6))
  text
}

startswith <- function(string, prefix) {
  substring(string, 1, nchar(prefix)) == prefix
}

endswith <- function(string, suffix) {
  substring(string, nchar(string) - nchar(suffix) + 1) == suffix
}

# like tools::file_ext, but includes leading '.', and preserves
# '.tar.gz', '.tar.bz' and so on
fileext <- function(path, default = "") {
  indices <- regexpr("[.]((?:tar[.])?[[:alnum:]]+)$", path)
  ifelse(indices > -1L, substring(path, indices), default)
}

git <- function() {

  gitpath <- Sys.which("git")
  if (!nzchar(gitpath))
    stop("failed to find git executable on the PATH")

  gitpath

}

visited <- function(name, envir) {

  if (exists(name, envir = envir))
    return(TRUE)

  envir[[name]] <- TRUE
  FALSE

}

rowapply <- function(X, FUN, ...) {
  lapply(seq_len(NROW(X)), function(I) {
    FUN(X[I, , drop = FALSE], ...)
  })
}

comspec <- function() {
  Sys.getenv("COMSPEC", unset = Sys.which("cmd.exe"))
}

nullfile <- function() {
  if (renv_platform_windows()) "NUL" else "/dev/null"
}

quietly <- function(expr, sink = TRUE) {

  if (sink) {
    sink(file = nullfile())
    on.exit(sink(NULL), add = TRUE)
  }

  withCallingHandlers(
    expr,
    warning               = function(c) invokeRestart("muffleWarning"),
    message               = function(c) invokeRestart("muffleMessage"),
    packageStartupMessage = function(c) invokeRestart("muffleMessage")
  )

}

convert <- function(x, type) {
  storage.mode(x) <- type
  x
}

remap <- function(x, map) {

  # TODO: use match?
  remapped <- x
  enumerate(map, function(key, val) {
    remapped[remapped == key] <<- val
  })
  remapped

}

header <- function(label,
                   prefix = "#",
                   suffix = "=",
                   n = 38L)
{
  n <- n - nchar(label) - nchar(prefix) - 2L
  if (n <= 0)
    return(paste(prefix, label))

  tail <- paste(rep.int(suffix, n), collapse = "")
  paste(prefix, label, tail)

}

keep <- function(x, keys) {
  x[intersect(keys, names(x))]
}

drop <- function(x, keys) {
  x[setdiff(names(x), keys)]
}

invoke <- function(f, ...) {
  f(...)
}

dequote <- function(strings) {

  for (quote in c("'", '"')) {

    # find strings matching pattern
    pattern <- paste0(quote, "(.*)", quote)
    matches <- grep(pattern, strings)
    if (empty(matches))
      next

    # remove outer quotes
    strings[matches] <- gsub(pattern, "\\1", strings[matches])

    # un-escape inner quotes
    pattern <- paste0("\\", quote)
    strings[matches] <- gsub(pattern, quote, strings[matches], fixed = TRUE)
  }

  strings

}

memoize <- function(key, expr, envir) {
  value <- envir[[key]] %||% expr
  envir[[key]] <- value
  value
}

nth <- function(x, i) {
  x[[i]]
}

heredoc <- function(text) {

  # remove leading, trailing whitespace
  trimmed <- gsub("^\\s*\\n|\\n\\s*$", "", text)

  # split into lines
  lines <- strsplit(trimmed, "\n", fixed = TRUE)[[1L]]

  # compute common indent
  indent <- regexpr("[^[:space:]]", lines)
  common <- min(setdiff(indent, -1L))
  paste(substring(lines, common), collapse = "\n")

}

find <- function(x, f, ...) {
  for (i in seq_along(x))
    if (!is.null(value <- f(x[[i]], ...)))
      return(value)
}

recursing <- function() {

  nf <- sys.nframe()
  if (nf < 2L)
    return(FALSE)

  np <- sys.parent()
  fn <- sys.function(np)
  for (i in seq_len(np - 1L))
    if (identical(fn, sys.function(i)))
      return(TRUE)

  FALSE

}

code <- function(x) {
  paste(deparse(substitute(x)), collapse = "\n")
}

shcode <- function(x) {
  shQuote(paste(deparse(substitute(x)), collapse = "\n"))
}

csort <- function(x, decreasing = FALSE, ...) {
  renv_scope_locale("LC_COLLATE", "C")
  sort(x, decreasing, ...)
}

renv_vector_diff <- function(x, y) {
  x[match(x, y, 0L) == 0L]
}

renv_vector_intersect <- function(x, y) {
  y[match(x, y, 0L)]
}

renv_vector_union <- function(x, y) {
  c(x, renv_vector_diff(y, x))
}

renv_vector_unique <- function(x) {
  x[!duplicated(x)]
}

renv_vector_merge <- function(x, y) {
  x[names(y)] <- y
  x
}

renv_verbose <- function() {

  verbose <- getOption("renv.verbose")
  if (!is.null(verbose))
    return(as.logical(verbose))

  verbose <- Sys.getenv("RENV_VERBOSE", unset = NA)
  if (!is.na(verbose))
    return(as.logical(verbose))

  interactive() || !renv_tests_running()

}

renv_version_compare <- function(lhs, rhs, n = NULL) {

  # retrieve versions as integer vector
  lhs <- unlist(unclass(numeric_version(lhs)))
  rhs <- unlist(unclass(numeric_version(rhs)))

  # compute number of components to compare
  n <- n %||% max(length(lhs), length(rhs))

  # pad each vector with zeroes up to the requested length
  lhs <- c(lhs, rep.int(0L, max(0L, n - length(lhs))))
  rhs <- c(rhs, rep.int(0L, max(0L, n - length(rhs))))

  # iterate through each component and compare
  for (i in seq_len(n)) {
    if (lhs[[i]] < rhs[[i]])
      return(-1L)
    else if (lhs[[i]] > rhs[[i]])
      return(+1L)
  }

  # if we got here, then all components compared equal
  0L

}

renv_version_le <- function(lhs, rhs, n = NULL) {
  renv_version_compare(lhs, rhs, n) <= 0L
}

renv_version_lt <- function(lhs, rhs, n = NULL) {
  renv_version_compare(lhs, rhs, n) <  0L
}

renv_version_eq <- function(lhs, rhs, n = NULL) {
  renv_version_compare(lhs, rhs, n) == 0L
}

renv_version_gt <- function(lhs, rhs, n = NULL) {
  renv_version_compare(lhs, rhs, n) >  0L
}

renv_version_ge <- function(lhs, rhs, n = NULL) {
  renv_version_compare(lhs, rhs, n) >= 0L
}

renv_version_match <- function(versions, request) {

  nrequest <- unclass(numeric_version(request))[[1L]]
  for (i in rev(seq_along(nrequest))) {

    matches <- which(map_lgl(versions, function(version) {
      renv_version_eq(version, request, n = i)
    }))

    if (!length(matches))
      next

    # TODO: should '3.1' match the closest match (e.g. '3.2') or
    # highest match (e.g. '3.6')?
    sorted <- matches[sort(names(matches), decreasing = TRUE)]
    return(names(sorted)[[1L]])

  }

  versions[[1L]]

}

renv_version_components <- function(version, n) {

  # split version into parts
  parts <- unclass(numeric_version(version))[[1L]]

  # extend parts to size of n
  diff <- max(n) - length(parts)
  if (diff > 0)
    parts <- c(parts, rep.int(0L, diff))

  # retrieve components
  parts[n]

}

renv_warnings_unknown_sources <- function(records) {

  if (empty(records))
    return(FALSE)

  enabled <- renv_config_get(
    name    = "unknown_sources",
    scope   = "warnings",
    type    = "logical[1]",
    default = TRUE
  )

  if (!enabled)
    return(FALSE)

  renv_pretty_print_records(
    records,
    "The following package(s) were installed from an unknown source:",
    c(
      "renv may be unable to restore these packages in the future.",
      "Consider reinstalling these packages from a known source (e.g. CRAN)."
    )
  )

  return(TRUE)

}

renv_xcode_available <- function() {

  # allow bypass if required
  check <- getOption("renv.xcode.available", default = NULL)
  if (!is.null(check))
    return(check)

  # otherwise, check via xcode-select
  status <- suppressWarnings(
    system2("/usr/bin/xcode-select", "-p", stdout = FALSE, stderr = FALSE)
  )

  identical(status, 0L)

}

renv_xcode_check <- function() {

  # allow bypass of xcode check if required
  check <- getOption("renv.xcode.check", default = TRUE)
  if (identical(check, FALSE))
    return()

  # only run on macOS
  if (!renv_platform_macos())
    return()

  # only run check once per session
  if (once())
    return()

  cmd <- "/usr/bin/xcrun --find --show-sdk-path"
  status <- system(cmd, ignore.stdout = TRUE, ignore.stderr = TRUE)
  if (identical(status, 0L))
    return()

  if (identical(status, 69L)) {

    msg <- "
macOS is reporting that you have not yet agreed to the Xcode license.
You must accept the Xcode license before R packages can be installed from source.
Please run:

    sudo xcodebuild -license accept

in the Terminal to accept the Xcode license.
Set options(renv.xcode.check = FALSE) to disable this warning.
"
    warning(msg)

  }

  fmt <- "%s returned exit code %i"
  warningf(fmt, cmd, status)

}

renv_yaml_load <- function(text) {

  yaml::yaml.load(
    string = text,
    eval.expr = FALSE,
    handlers = list(
      r = function(yaml) {
        attr(yaml, "type") <- "r"
        yaml
      }
    )
  )

}

.onLoad <- function(libname, pkgname) {

  renv_platform_init()
  renv_envvars_init()
  renv_log_init()
  renv_methods_init()
  renv_filebacked_init()
  renv_libpaths_init()
  renv_patch_init()

  addTaskCallback(renv_repos_init_callback)
  addTaskCallback(renv_snapshot_auto_callback)

  # if an renv project already appears to be loaded, then re-activate
  # the sandbox now -- this is primarily done to support suspend and
  # resume with RStudio where the user profile might not be run
  if (renv_rstudio_available()) {
    project <- getOption("renv.project.path")
    if (!is.null(project))
      renv_sandbox_activate(project = project)
  }

}

.onAttach <- function(libname, pkgname) {
  renv_rstudio_fixup()
  renv_exports_attach()
}

renv_zzz_run <- function() {

  # check if we're running devtools::document()
  documenting <- FALSE
  document <- parse(text = "devtools::document")[[1]]
  for (call in sys.calls()) {
    if (identical(call[[1]], document)) {
      documenting <- TRUE
      break
    }
  }

  # if so, then create some files
  if (documenting) {
    renv_zzz_bootstrap()
    renv_zzz_docs()
  }

  # check if we're running as part of R CMD build
  # if so, build our local repository with a copy of ourselves
  building <-
    !is.na(Sys.getenv("R_CMD", unset = NA)) &&
    grepl("Rbuild", basename(dirname(getwd())))

  if (building) {
    renv_zzz_repos()
  }

}

renv_zzz_bootstrap <- function() {

  source <- "templates/template-activate.R"
  target <- "inst/resources/activate.R"

  # read the necessary bootstrap scripts
  scripts <- c("R/bootstrap.R", "R/json-read.R")
  contents <- map(scripts, readLines)
  bootstrap <- unlist(contents)

  # format nicely for insertion
  bootstrap <- paste(" ", bootstrap)
  bootstrap <- paste(bootstrap, collapse = "\n")

  # replace template with bootstrap code
  template <- renv_file_read(source)
  replaced <- renv_template_replace(template, list(BOOTSTRAP = bootstrap))

  # write to resources
  printf("* Generating 'inst/resources/activate.R' ... ")
  writeLines(replaced, con = target)
  writef("Done!")

}

renv_zzz_docs <- function() {

  reg.finalizer(globalenv(), function(object) {

    printf("* Copying vignettes to 'inst/doc' ... ")

    ensure_directory("inst/doc")

    files <- list.files(
      path = "vignettes",
      pattern = "[.](?:R|Rmd|html)$",
    )

    src <- file.path("vignettes", files)
    tgt <- file.path("inst/doc", files)
    file.copy(src, tgt, overwrite = TRUE)

    writef("Done!")

  }, onexit = TRUE)

}

renv_zzz_repos <- function() {

  # don't run if we're running tests
  if (renv_package_checking())
    return()

  # prevent recursion
  installing <- Sys.getenv("RENV_INSTALLING_REPOS", unset = NA)
  if (!is.na(installing))
    return()

  Sys.setenv("RENV_INSTALLING_REPOS" = "TRUE")

  writeLines("** installing renv to package-local repository")

  # get package directory
  pkgdir <- getwd()

  # move to build directory
  tdir <- tempfile("renv-build-")
  ensure_directory(tdir)
  owd <- setwd(tdir)
  on.exit(setwd(owd), add = TRUE)

  # build renv again
  r_cmd_build("renv", path = pkgdir)

  # copy built tarball to inst folder
  src <- list.files(tdir, full.names = TRUE)
  tgt <- file.path(pkgdir, "inst/repos/src/contrib")

  ensure_directory(tgt)
  file.copy(src, tgt)

  # write PACKAGES
  renv_scope_envvars(R_DEFAULT_SERIALIZE_VERSION = "2")
  tools::write_PACKAGES(tgt, type = "source")

}

if (identical(.packageName, "renv"))
  renv_zzz_run()
