From 134bdd60cb03ff717012ed165979ba1a4f15943e Mon Sep 17 00:00:00 2001 From: "J Kyle Armstrong, PhD" Date: Tue, 9 Dec 2025 11:40:42 -0500 Subject: [PATCH] improve snapshot performance warning for existing .renvignore --- R/snapshot.R | 350 +++++++++++++++++++++++++-------------------------- 1 file changed, 173 insertions(+), 177 deletions(-) diff --git a/R/snapshot.R b/R/snapshot.R index 92cce0f88..51629d5e2 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -1,4 +1,3 @@ - #' Record current state of the project library in the lockfile #' #' @description @@ -122,20 +121,19 @@ #' @export #' #' @example examples/examples-init.R -snapshot <- function(project = NULL, +snapshot <- function(project = NULL, ..., - library = NULL, + library = NULL, lockfile = paths$lockfile(project = project), - type = settings$snapshot.type(project = project), - dev = NULL, - repos = getOption("repos"), + type = settings$snapshot.type(project = project), + dev = NULL, + repos = getOption("repos"), packages = NULL, - exclude = NULL, - prompt = interactive(), - update = FALSE, - force = FALSE, - reprex = FALSE) -{ + exclude = NULL, + prompt = interactive(), + update = FALSE, + force = FALSE, + reprex = FALSE) { renv_consent_check() renv_scope_error_handler() renv_dots_check(...) @@ -147,8 +145,9 @@ snapshot <- function(project = NULL, renv_scope_verbose_if(prompt) # use setting as default if dev not explicitly provided - if (is.null(dev)) + if (is.null(dev)) { dev <- settings$snapshot.dev(project = project) + } repos <- renv_repos_validate(repos) renv_scope_options(repos = repos) @@ -156,24 +155,24 @@ snapshot <- function(project = NULL, # set up .renvignore defensively renv_load_cache_renvignore(project = project) - if (!is.null(lockfile)) + if (!is.null(lockfile)) { renv_activate_prompt("snapshot", library, prompt, project) + } libpaths <- renv_path_normalize(library %||% renv_libpaths_all()) - if (config$snapshot.validate()) + 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, stringify(type)) } type <- "packages" - } alt <- new <- renv_lockfile_create( @@ -187,12 +186,14 @@ snapshot <- function(project = NULL, dev = dev ) - if (is.null(lockfile)) + if (is.null(lockfile)) { return(new) + } # if running as part of 'reprex', then render output inline - if (reprex) + if (reprex) { return(renv_snapshot_reprex(new)) + } # check for missing dependencies and warn if any are discovered # (note: use 'new' rather than 'alt' here as we don't want to attempt @@ -212,7 +213,6 @@ snapshot <- function(project = NULL, ) if (length(old)) { - # preserve records from alternate OSes in lockfile alt <- renv_snapshot_preserve(old, new) @@ -222,7 +222,6 @@ snapshot <- function(project = NULL, writef("- The lockfile is already up to date.") return(renv_snapshot_successful(alt, prompt, project)) } - } # update new reference @@ -230,14 +229,17 @@ snapshot <- function(project = NULL, # 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)) + 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()) + if (prompt || renv_verbose()) { renv_snapshot_report_actions(actions, old, new) + } # request user confirmation cancel_if(length(actions) && file.exists(lockfile) && prompt && !proceed()) @@ -258,20 +260,20 @@ snapshot <- function(project = NULL, renv_snapshot_preserve <- function(old, new) { records <- filter(old$Packages, renv_snapshot_preserve_impl) - if (length(records)) + if (length(records)) { new$Packages[names(records)] <- records + } new } renv_snapshot_preserve_impl <- function(record) { - ostype <- tolower(record[["OS_type"]] %||% "") - if (!nzchar(ostype)) + if (!nzchar(ostype)) { return(FALSE) + } altos <- if (renv_platform_unix()) "windows" else "unix" identical(ostype, altos) - } renv_snapshot_preflight <- function(project, libpaths) { @@ -283,11 +285,11 @@ renv_snapshot_preflight_impl <- function(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") + if (type == "directory") { return(TRUE) + } # if the file exists but isn't a directory, fail if (nzchar(type)) { @@ -304,15 +306,14 @@ renv_snapshot_preflight_library_exists <- function(project, library) { # user tried to snapshot arbitrary but missing path fmt <- "library '%s' does not exist; cannot proceed" stopf(fmt, renv_path_aliased(library)) - } renv_snapshot_validate <- function(project, lockfile, libpaths) { - # allow user to disable snapshot validation, just in case enabled <- config$snapshot.validate() - if (!enabled) + if (!enabled) { return(TRUE) + } methods <- list( renv_snapshot_validate_bioconductor, @@ -324,16 +325,17 @@ renv_snapshot_validate <- function(project, lockfile, libpaths) { ok <- map_lgl(methods, function(method) { tryCatch( method(project, lockfile, libpaths), - error = function(e) { warning(e); FALSE } + error = function(e) { + warning(e) + FALSE + } ) }) all(ok) - } renv_snapshot_validate_report <- function(valid, prompt, force) { - # nothing to do if everything is valid if (valid) { dlog("snapshot", "passed pre-flight validation checks") @@ -361,24 +363,22 @@ renv_snapshot_validate_report <- function(valid, prompt, force) { # otherwise, bail on error (need to use 'force = TRUE') stop("aborting snapshot due to pre-flight validation failure") - } # nocov start renv_snapshot_validate_bioconductor <- function(project, lockfile, libpaths) { - ok <- TRUE # check whether any packages are installed from Bioconductor records <- renv_lockfile_records(lockfile) sources <- extract_chr(records, "Source") - if (!"Bioconductor" %in% sources) + if (!"Bioconductor" %in% sources) { return(ok) + } # check for BiocManager or BiocInstaller package <- renv_bioconductor_manager() if (!package %in% names(records)) { - text <- c( "One or more Bioconductor packages are used in your project,", "but the %s package is not available.", @@ -408,26 +408,25 @@ renv_snapshot_validate_bioconductor <- function(project, lockfile, libpaths) { # collect latest versions of these packages bioc$Latest <- vapply(bioc$Package, function(package) { entry <- catch(renv_available_packages_latest(package)) - if (inherits(entry, "error")) + if (inherits(entry, "error")) { return("") + } entry$Version }, FUN.VALUE = character(1)) # check for version mismatches (allow mismatch in minor version) bioc$Mismatch <- mapply(function(current, latest) { - - if (identical(latest, "")) + if (identical(latest, "")) { return(TRUE) + } current <- renv_version_maj_min(current) latest <- renv_version_maj_min(latest) current != latest - }, 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) bulletin( @@ -443,19 +442,18 @@ renv_snapshot_validate_bioconductor <- function(project, lockfile, libpaths) { } ok - } # nocov end renv_snapshot_validate_dependencies_available <- function(project, lockfile, libpaths) { - # use library to collect package dependency versions records <- renv_lockfile_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)) + if (empty(deps)) { return(TRUE) + } splat <- split(deps, deps$Package) @@ -465,19 +463,21 @@ renv_snapshot_validate_dependencies_available <- function(project, lockfile, lib # check for required packages not currently installed requested <- names(splat) missing <- renv_vector_diff(requested, packages) - if (empty(missing)) + if (empty(missing)) { return(TRUE) + } # exclude ignored packages missing <- renv_vector_diff(missing, settings$ignored.packages(project = project)) - if (empty(missing)) + if (empty(missing)) { return(TRUE) + } usedby <- map_chr(missing, function(package) { - revdeps <- sort(unique(basename(deps$Source)[deps$Package == package])) - items <- revdeps; limit <- 3L + items <- revdeps + limit <- 3L if (length(revdeps) > limit) { rest <- length(revdeps) - limit suffix <- paste("and", length(revdeps) - 3L, plural("other", rest)) @@ -485,7 +485,6 @@ renv_snapshot_validate_dependencies_available <- function(project, lockfile, lib } paste(items, collapse = ", ") - }) bulletin( @@ -495,18 +494,17 @@ renv_snapshot_validate_dependencies_available <- function(project, lockfile, lib ) FALSE - } renv_snapshot_validate_dependencies_compatible <- function(project, lockfile, libpaths) { - # use library to collect package dependency versions records <- renv_lockfile_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)) + if (empty(deps)) { return(TRUE) + } splat <- split(deps, deps$Package) @@ -515,18 +513,19 @@ renv_snapshot_validate_dependencies_compatible <- function(project, lockfile, li # 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)) + if (is.null(record)) { return(NULL) + } version <- record$Version # drop packages without explicit version requirement requirements <- requirements[nzchar(requirements$Require), ] - if (nrow(requirements) == 0) + if (nrow(requirements) == 0) { return(NULL) + } # add in requested version requirements$Requested <- version @@ -539,16 +538,16 @@ renv_snapshot_validate_dependencies_compatible <- function(project, lockfile, li # return requirements that weren't satisfied requirements[!ok, ] - }) bad <- bind(bad) - if (empty(bad)) + if (empty(bad)) { return(TRUE) + } - package <- basename(bad$Source) + package <- basename(bad$Source) requires <- sprintf("%s (%s %s)", bad$Package, bad$Require, bad$Version) - request <- bad$Requested + request <- bad$Requested fmt <- "%s requires %s, but version %s is installed" txt <- sprintf(fmt, format(package), format(requires), format(request)) @@ -559,7 +558,6 @@ renv_snapshot_validate_dependencies_compatible <- function(project, lockfile, li ) FALSE - } renv_snapshot_validate_sources <- function(project, lockfile, libpaths) { @@ -571,8 +569,7 @@ renv_snapshot_validate_sources <- function(project, lockfile, libpaths) { # then the first package found in the library paths is # kept and others are discarded renv_snapshot_libpaths <- function(libpaths = NULL, - project = NULL) -{ + project = NULL) { dynamic( key = list(libpaths = libpaths, project = project), value = renv_snapshot_libpaths_impl(libpaths, project) @@ -580,8 +577,7 @@ renv_snapshot_libpaths <- function(libpaths = NULL, } renv_snapshot_libpaths_impl <- function(libpaths = NULL, - project = NULL) -{ + project = NULL) { records <- uapply( libpaths, renv_snapshot_library, @@ -594,8 +590,7 @@ renv_snapshot_libpaths_impl <- function(libpaths = NULL, renv_snapshot_library <- function(library = NULL, records = TRUE, - project = NULL) -{ + project = NULL) { # list packages in the library library <- renv_path_normalize(library %||% renv_libpaths_active()) paths <- list.files(library, full.names = TRUE) @@ -619,8 +614,9 @@ renv_snapshot_library <- function(library = NULL, packages <- valid[!duplicated] # early exit if we're just collecting the list of packages - if (!records) + if (!records) { return(basename(packages)) + } # snapshot description files descriptions <- file.path(packages, "DESCRIPTION") @@ -630,7 +626,6 @@ renv_snapshot_library <- function(library = NULL, # report any snapshot failures broken <- filter(records, inherits, what = "error") if (length(broken)) { - messages <- map_chr(broken, conditionMessage) text <- sprintf("'%s': %s", names(broken), messages) bulletin( @@ -640,30 +635,26 @@ renv_snapshot_library <- function(library = NULL, ) stopf("snapshot of library %s failed", renv_path_pretty(library)) - } # name results and return names(records) <- map_chr(records, `[[`, "Package") records - } renv_snapshot_check <- function(paths) { - paths <- grep("00LOCK", paths, invert = TRUE, value = TRUE) paths <- renv_snapshot_check_broken_link(paths) paths <- renv_snapshot_check_tempfile(paths) paths <- renv_snapshot_check_missing_description(paths) paths - } renv_snapshot_check_broken_link <- function(paths) { - broken <- !file.exists(paths) - if (!any(broken)) + if (!any(broken)) { return(paths) + } bulletin( "The following package(s) have broken symlinks into the cache:", @@ -672,15 +663,14 @@ renv_snapshot_check_broken_link <- function(paths) { ) paths[!broken] - } renv_snapshot_check_tempfile <- function(paths) { - names <- basename(paths) missing <- grepl("^file(?:\\w){12}", names) - if (!any(missing)) + if (!any(missing)) { return(paths) + } bulletin( "The following folder(s) appear to be left-over temporary directories:", @@ -689,15 +679,14 @@ renv_snapshot_check_tempfile <- function(paths) { ) paths[!missing] - } renv_snapshot_check_missing_description <- function(paths) { - desc <- file.path(paths, "DESCRIPTION") missing <- !file.exists(desc) - if (!any(missing)) + if (!any(missing)) { return(paths) + } bulletin( "The following package(s) are missing their DESCRIPTION files:", @@ -709,39 +698,35 @@ renv_snapshot_check_missing_description <- function(paths) { ) paths[!missing] - } renv_snapshot_description <- function(path = NULL, package = NULL) { - # resolve path path <- path %||% renv_package_find(package, lib.loc = renv_libpaths_all()) - if (!nzchar(path)) + if (!nzchar(path)) { stopf("package '%s' is not installed", package) + } # read and snapshot DESCRIPTION file dcf <- renv_description_read(path, package) renv_snapshot_description_impl(dcf, path) - } renv_snapshot_description_impl <- function(dcf, path = NULL) { - version <- getOption("renv.lockfile.version") %||% Sys.getenv("RENV_LOCKFILE_VERSION", unset = 2L) - if (version == 1L) + if (version == 1L) { renv_snapshot_description_impl_v1(dcf, path) - else if (version == 2L) + } else if (version == 2L) { renv_snapshot_description_impl_v2(dcf, path) - else + } else { stopf("unsupported lockfile version '%s'", format(version)) - + } } renv_snapshot_description_impl_v1 <- function(dcf, path = NULL) { - # figure out the package source source <- renv_snapshot_description_source(dcf) dcf[names(source)] <- source @@ -758,7 +743,7 @@ renv_snapshot_description_impl_v1 <- function(dcf, path = NULL) { # remove the other remote fields bioc <- nzchar(dcf[["biocViews"]] %||% "") && - identical(dcf[["RemoteType"]], "standard") + identical(dcf[["RemoteType"]], "standard") if (bioc) { fields <- grep("^Remote(?!s)", names(dcf), perl = TRUE, invert = TRUE) @@ -766,10 +751,11 @@ renv_snapshot_description_impl_v1 <- function(dcf, path = NULL) { } # generate a hash if we can - dcf[["Hash"]] <- if (is.null(path)) + dcf[["Hash"]] <- if (is.null(path)) { renv_hash_record(dcf) - else + } else { renv_hash_description(path) + } # generate a Requirements field -- primarily for use by 'pak' fields <- c("Depends", "Imports", "LinkingTo") @@ -779,15 +765,15 @@ renv_snapshot_description_impl_v1 <- function(dcf, path = NULL) { # get remotes fields remotes <- local({ - # if this seems to be a cran-like record, only keep remotes # when RemoteSha appears to be a hash (e.g. for r-universe) # note that RemoteSha may be a package version when installed # by e.g. pak if (renv_record_cranlike(dcf)) { sha <- dcf[["RemoteSha"]] - if (is.null(sha) || nchar(sha) < 40L) + if (is.null(sha) || nchar(sha) < 40L) { return(character()) + } } # grab the relevant remotes @@ -795,11 +781,11 @@ renv_snapshot_description_impl_v1 <- function(dcf, path = NULL) { remotes <- grep("^Remote(?!s)", names(dcf), perl = TRUE, value = TRUE) # don't include 'RemoteRef' if it's a non-informative remote - if (identical(dcf[["RemoteRef"]], "HEAD")) + if (identical(dcf[["RemoteRef"]], "HEAD")) { remotes <- setdiff(remotes, "RemoteRef") + } c(git, remotes) - }) # only keep relevant fields @@ -809,11 +795,9 @@ renv_snapshot_description_impl_v1 <- function(dcf, path = NULL) { # return as list as.list(dcf[keep]) - } renv_snapshot_description_impl_v2 <- function(dcf, path) { - # figure out the package source source <- renv_snapshot_description_source(dcf) dcf[names(source)] <- source @@ -830,7 +814,7 @@ renv_snapshot_description_impl_v2 <- function(dcf, path) { # remove the other remote fields bioc <- nzchar(dcf[["biocViews"]] %||% "") && - identical(dcf[["RemoteType"]], "standard") + identical(dcf[["RemoteType"]], "standard") if (bioc) { fields <- grep("^Remote(?!s)", names(dcf), perl = TRUE, invert = TRUE) @@ -870,35 +854,38 @@ renv_snapshot_description_impl_v2 <- function(dcf, path) { # return as list as.list(dcf) - } renv_snapshot_description_source_custom <- function(dcf) { - # only proceed for cranlike remotes - if (!renv_record_cranlike(dcf)) + if (!renv_record_cranlike(dcf)) { return(NULL) + } # check for a declared repository URL remoterepos <- dcf[["RemoteRepos"]] - if (is.null(remoterepos)) + if (is.null(remoterepos)) { return(NULL) + } # if this package appears to be installed from Bioconductor, skip - if (nzchar(dcf[["biocViews"]] %||% "")) + if (nzchar(dcf[["biocViews"]] %||% "")) { return(NULL) + } # if the declared repository appears to be a CRAN mirror, skip it mirrors <- renv_cran_mirrors() - if (any(renv_repos_matches(remoterepos, mirrors))) + if (any(renv_repos_matches(remoterepos, mirrors))) { return(NULL) + } # if this package appears to have been installed from a # repository which we have knowledge of, skip repos <- as.list(getOption("repos")) repository <- dcf[["Repository"]] - if (!is.null(repository) && repository %in% names(repos)) + if (!is.null(repository) && repository %in% names(repos)) { return(NULL) + } # check whether the declared repository matches one of the # repositories that are currently in use; if so, skip it @@ -909,25 +896,26 @@ renv_snapshot_description_source_custom <- function(dcf) { # # https://github.com/rstudio/renv/issues/2104 name <- dcf[["RemoteReposName"]] - declared <- if (is.null(name) || identical(name, "CRAN")) + declared <- if (is.null(name) || identical(name, "CRAN")) { renv_repos_matches(remoterepos, repos) - else + } else { name %in% names(repos) + } - if (declared) + if (declared) { return(NULL) + } list(Source = "Repository", Repository = remoterepos) - } renv_snapshot_description_source <- function(dcf) { - # check for packages installed from a repository not currently # encoded as part of the user's repository option, and include if required source <- renv_snapshot_description_source_custom(dcf) - if (!is.null(source)) + if (!is.null(source)) { return(source) + } # check for a custom declared remote type if (!renv_record_cranlike(dcf)) { @@ -937,23 +925,27 @@ renv_snapshot_description_source <- function(dcf) { # packages from Bioconductor are normally tagged with a 'biocViews' entry; # use that to infer a Bioconductor source - if (nzchar(dcf[["biocViews"]] %||% "")) + if (nzchar(dcf[["biocViews"]] %||% "")) { return(list(Source = "Bioconductor")) + } # check for a declared repository repository <- dcf[["RemoteReposName"]] %||% dcf[["Repository"]] - if (!is.null(repository)) + if (!is.null(repository)) { return(list(Source = "Repository", Repository = repository)) + } # check for a valid package name package <- dcf[["Package"]] - if (is.null(package)) + if (is.null(package)) { return(list(Source = "unknown")) + } # if this is running as part of the synchronization check, skip CRAN queries # https://github.com/rstudio/renv/issues/812 - if (the$project_synchronized_check_running) + if (the$project_synchronized_check_running) { return(list(Source = "unknown")) + } # check to see if this is a base / recommended package; if so, assume that # the package was installed from CRAN at this point @@ -969,8 +961,9 @@ renv_snapshot_description_source <- function(dcf) { field = "Package" ) - if (package %in% pkgs) + if (package %in% pkgs) { return(list(Source = "Repository", Repository = "CRAN")) + } # 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 @@ -989,38 +982,38 @@ renv_snapshot_description_source <- function(dcf) { renv_snapshot_description_source_hack(package, dcf), error = function(e) list(Source = "unknown") ) - } renv_snapshot_description_source_hack <- function(package, dcf) { - # check cellar for (type in renv_package_pkgtypes()) { cellar <- renv_available_packages_cellar(type) - if (package %in% cellar$Package) + if (package %in% cellar$Package) { return(list(Source = "Cellar")) + } } # check available packages latest <- catch(renv_available_packages_latest(package)) - if (is.null(latest) || inherits(latest, "error")) + if (is.null(latest) || inherits(latest, "error")) { return(list(Source = "unknown")) + } # check version; use unknown if it's too new - if (renv_version_gt(dcf[["Version"]], latest[["Version"]])) + if (renv_version_gt(dcf[["Version"]], latest[["Version"]])) { return(list(Source = "unknown")) + } # ok, this package appears to be from a package repository list(Source = "Repository", Repository = latest[["Repository"]]) - } # nocov start renv_snapshot_report_actions <- function(actions, old, new) { - - if (!renv_verbose()) + if (!renv_verbose()) { return(invisible()) + } if (length(actions)) { lhs <- renv_lockfile_records(old) @@ -1045,7 +1038,6 @@ renv_snapshot_report_actions <- function(actions, old, new) { c("The version of R recorded in the lockfile will be updated:", msg, "") ) } - } # nocov end @@ -1053,7 +1045,6 @@ renv_snapshot_report_actions <- function(actions, old, new) { # respecting the snapshot type selected (or currently configured) # for the associated project renv_snapshot_dependencies <- function(project, type = NULL, dev = FALSE) { - type <- type %||% settings$snapshot.type(project = project) packages <- dynamic( @@ -1061,15 +1052,14 @@ renv_snapshot_dependencies <- function(project, type = NULL, dev = FALSE) { renv_snapshot_dependencies_impl(project, type, dev) ) - if (!renv_tests_running()) + if (!renv_tests_running()) { packages <- unique(c(packages, "renv")) + } packages - } renv_snapshot_dependencies_impl <- function(project, type = NULL, dev = FALSE) { - if (type %in% "all") { packages <- installed_packages(field = "Package") return(setdiff(packages, renv_packages_base())) @@ -1093,15 +1083,15 @@ renv_snapshot_dependencies_impl <- function(project, type = NULL, dev = FALSE) { # does not exist (imply no dependencies) # # https://github.com/rstudio/renv/issues/1949 - if (!file.exists(path)) + if (!file.exists(path)) { return(character()) + } # count the number of files in each directory, so we can report # to the user if we scanned a folder containing many files count <- integer() packages <- withCallingHandlers( - renv_dependencies_impl( path = path, root = project, @@ -1112,13 +1102,13 @@ renv_snapshot_dependencies_impl <- function(project, type = NULL, dev = FALSE) { # require user confirmation to proceed if there's a reported error renv.dependencies.problems = function(cnd) { - - if (identical(config$dependency.errors(), "ignored")) + if (identical(config$dependency.errors(), "ignored")) { return() + } - if (interactive() && !proceed()) + if (interactive() && !proceed()) { cancel() - + } }, # collect information about folders containing lots of files @@ -1128,50 +1118,59 @@ renv_snapshot_dependencies_impl <- function(project, type = NULL, dev = FALSE) { # notify the user if we took a long time to discover dependencies renv.dependencies.elapsed_time = function(cnd) { - # only relevant for implicit-type snapshots - if (!type %in% c("packrat", "implicit")) + if (!type %in% c("packrat", "implicit")) { return() + } # check for timeout elapsed <- cnd$data limit <- getOption("renv.dependencies.elapsed_time_threshold", default = 10L) - if (elapsed < limit) + if (elapsed < limit) { return() + } # tally up directories with lots of files count <- count[order(count)] count <- count[count >= 200] # report to user + ignore <- file.exists(file.path(project, ".renvignore")) + lines <- c( "", - "NOTE: Dependency discovery took %s during snapshot.", - "Consider using .renvignore to ignore files, or switching to explicit snapshots.", + if (ignore) { + "NOTE: Dependency discovery took %s during snapshot using current .renvignore specifications." + } else { + "NOTE: Dependency discovery took %s during snapshot." + }, + if (ignore) { + "Consider modifying .renvignore or switching to explicit snapshots." + } else { + "Consider using .renvignore to ignore files, or switching to explicit snapshots." + }, "See `?renv::dependencies` for more information.", - if (length(count)) c( - "", - sprintf("- %s: %s", format(names(count)), nplural("file", count)) - ), + if (length(count)) { + c( + "", + sprintf("- %s: %s", format(names(count)), nplural("file", count)) + ) + }, "" ) # force output in this scope renv_scope_caution(TRUE) caution(lines, renv_difftime_format(elapsed)) - } - ) unique(packages) - } # compute package records from the provided library paths, # normally to be included as part of an renv lockfile renv_snapshot_packages <- function(packages, libpaths, project) { - ignored <- c( renv_packages_base(), renv_project_ignored_packages(project = project), @@ -1179,8 +1178,9 @@ renv_snapshot_packages <- function(packages, libpaths, project) { ) callback <- function(package, location, project) { - if (nzchar(location) && !package %in% ignored) + if (nzchar(location) && !package %in% ignored) { return(location) + } } # expand package dependency tree @@ -1192,30 +1192,32 @@ renv_snapshot_packages <- function(packages, libpaths, project) { ) # keep only packages with known locations - paths <- paths %>% filter(is.character) %>% filter(nzchar) + paths <- paths %>% + filter(is.character) %>% + filter(nzchar) # diagnose issues with the scanned packages paths <- renv_snapshot_check(paths) # now, snapshot the remaining packages map(paths, renv_snapshot_description) - } renv_snapshot_report_missing <- function(missing, type) { - missing <- setdiff(missing, "renv") - if (empty(missing)) + if (empty(missing)) { return(invisible()) + } preamble <- "The following required packages are not installed:" postamble <- c( "Packages must first be installed before renv can snapshot them.", - if (type %in% "explicit") + if (type %in% "explicit") { "If these packages are no longer required, consider removing them from your DESCRIPTION file." - else + } else { "Use `renv::dependencies()` to see where this package is used in your project." + } ) bulletin( @@ -1226,8 +1228,9 @@ renv_snapshot_report_missing <- function(missing, type) { # only prompt the user to install if a restart is available restart <- findRestart("renv_recompute_records") - if (is.null(restart)) + if (is.null(restart)) { return(invisible()) + } choices <- c( snapshot = "Snapshot, just using the currently installed packages.", @@ -1247,11 +1250,9 @@ renv_snapshot_report_missing <- function(missing, type) { } invisible() - } renv_snapshot_filter_custom_resolve <- function() { - # check for custom filter filter <- getOption("renv.snapshot.filter", default = NULL) if (is.null(filter)) { @@ -1260,8 +1261,9 @@ renv_snapshot_filter_custom_resolve <- function() { } # allow for filter naming a function to use - if (is.character(filter)) + if (is.character(filter)) { filter <- eval(parse(text = filter), envir = baseenv()) + } # check we got a function if (!is.function(filter)) { @@ -1271,30 +1273,29 @@ renv_snapshot_filter_custom_resolve <- function() { # return resolved function filter - } renv_snapshot_fixup <- function(records) { - records <- renv_snapshot_fixup_renv(records) records - } renv_snapshot_fixup_renv <- function(records) { - # don't run when testing renv - if (renv_tests_running()) + if (renv_tests_running()) { return(records) + } # check for an existing valid record record <- records$renv - if (is.null(record)) + if (is.null(record)) { return(records) + } source <- renv_record_source(record) - if (source != "unknown") + if (source != "unknown") { return(records) + } # no valid record available; construct a synthetic one remote <- renv_metadata_remote() @@ -1304,11 +1305,9 @@ renv_snapshot_fixup_renv <- function(records) { # return it records - } renv_snapshot_reprex <- function(lockfile) { - fmt <- "Lockfile generated by renv %s." version <- sprintf(fmt, renv_metadata_version_friendly()) @@ -1327,11 +1326,9 @@ renv_snapshot_reprex <- function(lockfile) { attr(output, "knit_cacheable") <- NA output - } renv_snapshot_successful <- function(records, prompt, project) { - # update snapshot flag the$auto_snapshot_failed <- FALSE @@ -1340,5 +1337,4 @@ renv_snapshot_successful <- function(records, prompt, project) { # return generated records invisible(records) - }