1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
snapshotRenvDependencies <- function(bundleDir,
extraPackages = character(),
quiet = FALSE,
verbose = FALSE) {
recordExtraDependencies(bundleDir, extraPackages)
old <- options(
renv.verbose = FALSE,
renv.consent = TRUE
)
defer(options(old))
dependenciesLimit <- getOption("renv.config.dependencies.limit")
if (is.null(dependenciesLimit)) {
maxFiles <- getOption("rsconnect.max.bundle.files", 10000)
oldlim <- options(
renv.config.dependencies.limit = maxFiles
)
defer(options(oldlim))
}
# analyze code dependencies ourselves rather than relying on the scan during renv::snapshot, as
# that will add renv to renv.lock as a dependency.
deps <- renv::dependencies(
bundleDir,
root = bundleDir,
quiet = if (quiet) TRUE else NULL,
progress = FALSE)
renv::snapshot(bundleDir, packages = deps$Package, prompt = FALSE)
defer(removeRenv(bundleDir))
parseRenvDependencies(bundleDir, snapshot = TRUE)
}
parseRenvDependencies <- function(bundleDir, snapshot = FALSE) {
renvLock <- jsonlite::read_json(renvLockFile(bundleDir))
repos <- setNames(
vapply(renvLock$R$Repositories, "[[", "URL", FUN.VALUE = character(1)),
vapply(renvLock$R$Repositories, "[[", "Name", FUN.VALUE = character(1))
)
deps <- standardizeRenvPackages(
renvLock$Packages,
repos,
biocPackages = biocPackages(bundleDir)
)
if (nrow(deps) == 0) {
return(data.frame())
}
deps$description <- lapply(deps$Package, package_record)
if (!snapshot) {
lib_versions <- unlist(lapply(deps$description, "[[", "Version"))
if (any(deps$Version != lib_versions)) {
cli::cli_abort(c(
"Library and lockfile are out of sync",
i = "Use renv::restore() or renv::snapshot() to synchronise",
i = "Or ignore the lockfile by adding to your .rscignore"
))
}
}
deps
}
standardizeRenvPackages <- function(packages, repos, biocPackages = NULL) {
repos <- standardizeRepos(repos)
availablePackages <- availablePackages(repos)
names(packages) <- NULL
out <- lapply(
packages,
standardizeRenvPackage,
availablePackages = availablePackages,
biocPackages = biocPackages,
repos = repos
)
out <- compact(out)
out <- lapply(out, as.data.frame, stringsAsFactors = FALSE)
rbind_fill(out)
}
standardizeRenvPackage <- function(pkg,
availablePackages,
biocPackages = NULL,
repos = character(),
bioc) {
# Convert renv source to manifest source/repository
# https://github.com/rstudio/renv/blob/0.17.2/R/snapshot.R#L730-L773
if (is.null(pkg$Repository) && !is.null(pkg$RemoteRepos) && grepl("bioconductor.org", pkg$RemoteRepos)) {
# Work around bug where renv fails to detect BioC package installed by pak
# https://github.com/rstudio/renv/issues/1202
pkg$Source <- "Bioconductor"
}
if (pkg$Source == "Repository") {
if (identical(pkg$Repository, "CRAN")) {
if (isDevVersion(pkg, availablePackages)) {
pkg$Source <- NA_character_
pkg$Repository <- NA_character_
} else {
pkg$Source <- "CRAN"
pkg$Repository <- findRepoUrl(pkg$Package, availablePackages)
}
} else {
# $Repository comes from DESCRIPTION and is set by repo, so can be
# anything. So we must look up from the package name
originalRepository <- pkg$Repository
pkg$Repository <- findRepoUrl(pkg$Package, availablePackages)
pkg$Source <- findRepoName(pkg$Repository, repos)
if (is.na(pkg$Source)) {
# Archived packages are not publicized by available.packages(). Use
# the renv.lock repository as source, expecting that the package is
# available through one of the repository URLs.
pkg$Source <- originalRepository
}
}
} else if (pkg$Source == "Bioconductor") {
pkg$Repository <- findRepoUrl(pkg$Package, availablePackages)
if (is.na(pkg$Repository)) {
# Try packages defined from default bioC repos
pkg$Repository <- findRepoUrl(pkg$Package, biocPackages)
}
} else if (pkg$Source %in% c("Bitbucket", "GitHub", "GitLab")) {
pkg$Source <- tolower(pkg$Source)
} else if (pkg$Source %in% c("Local", "unknown")) {
pkg$Source <- NA_character_
pkg$Repository <- NA_character_
}
# Remove Remote fields that pak adds for "standard" installs from CRAN
if (identical(pkg$RemoteType, "standard")) {
pkg <- pkg[!grepl("^Remote", names(pkg))]
}
pkg[manifestPackageColumns(pkg)]
}
biocPackages <- function(bundleDir) {
signal("evaluating", class = "rsconnect_biocRepos") # used for testing
availablePackages(biocRepos(bundleDir))
}
biocRepos <- function(bundleDir) {
repos <- getFromNamespace("renv_bioconductor_repos", "renv")(bundleDir)
repos[setdiff(names(repos), "CRAN")]
}
renvLockFile <- function(bundleDir) {
file.path(bundleDir, "renv.lock")
}
removeRenv <- function(path, lockfile = TRUE) {
if (lockfile) {
unlink(renvLockFile(path))
}
unlink(file.path(path, "renv"), recursive = TRUE)
}
|
