From 47de031f5b78f1de05a73352ffdaa207946becb3 Mon Sep 17 00:00:00 2001 From: Pascal Sauer <156898545+pascal-sauer@users.noreply.github.com> Date: Thu, 30 Jan 2025 13:53:04 +0100 Subject: [PATCH] new renv version --- renv/activate.R | 192 +++++++++++++++++++++++++----------------------- 1 file changed, 100 insertions(+), 92 deletions(-) diff --git a/renv/activate.R b/renv/activate.R index 0eb51088a..ebbe30304 100644 --- a/renv/activate.R +++ b/renv/activate.R @@ -2,7 +2,7 @@ local({ # the requested version of renv - version <- "1.0.11" + version <- "1.1.0" attr(version, "sha") <- NULL # the project directory @@ -42,7 +42,7 @@ local({ return(FALSE) # next, check environment variables - # TODO: prefer using the configuration one in the future + # prefer using the configuration one in the future envvars <- c( "RENV_CONFIG_AUTOLOADER_ENABLED", "RENV_AUTOLOADER_ENABLED", @@ -209,10 +209,6 @@ local({ } - startswith <- function(string, prefix) { - substring(string, 1, nchar(prefix)) == prefix - } - bootstrap <- function(version, library) { friendly <- renv_bootstrap_version_friendly(version) @@ -563,6 +559,9 @@ local({ # prepare download options token <- renv_bootstrap_github_token() + if (is.null(token)) + token <- "" + if (nzchar(Sys.which("curl")) && nzchar(token)) { fmt <- "--location --fail --header \"Authorization: token %s\"" extra <- sprintf(fmt, token) @@ -951,8 +950,14 @@ local({ } renv_bootstrap_validate_version_dev <- function(version, description) { + expected <- description[["RemoteSha"]] - is.character(expected) && startswith(expected, version) + if (!is.character(expected)) + return(FALSE) + + pattern <- sprintf("^\\Q%s\\E", version) + grepl(pattern, expected, perl = TRUE) + } renv_bootstrap_validate_version_release <- function(version, description) { @@ -1132,10 +1137,10 @@ local({ renv_bootstrap_exec <- function(project, libpath, version) { if (!renv_bootstrap_load(project, libpath, version)) - renv_bootstrap_run(version, libpath) + renv_bootstrap_run(project, libpath, version) } - renv_bootstrap_run <- function(version, libpath) { + renv_bootstrap_run <- function(project, libpath, version) { # perform bootstrap bootstrap(version, libpath) @@ -1146,7 +1151,7 @@ local({ # try again to load if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) { - return(renv::load(project = getwd())) + return(renv::load(project = project)) } # failed to download or load renv; warn the user @@ -1192,98 +1197,101 @@ local({ jsonlite::fromJSON(txt = text, simplifyVector = FALSE) } - renv_json_read_default <- function(file = NULL, text = NULL) { - - # find strings in the JSON - text <- paste(text %||% readLines(file, warn = FALSE), 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) + renv_json_read_patterns <- function() { + + list( + + # objects + list("{", "\t\n\tobject(\t\n\t"), + list("}", "\t\n\t)\t\n\t"), + + # arrays + list("[", "\t\n\tarray(\t\n\t"), + list("]", "\n\t\n)\n\t\n"), + + # maps + list(":", "\t\n\t=\t\n\t") + + ) + + } + renv_json_read_envir <- function() { + + envir <- new.env(parent = emptyenv()) + + envir[["+"]] <- `+` + envir[["-"]] <- `-` + + envir[["object"]] <- function(...) { + result <- list(...) + names(result) <- as.character(names(result)) + result } - - # 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_read_remap(json, map) - - # evaluate - eval(remapped, envir = baseenv()) - + + envir[["array"]] <- list + + envir[["true"]] <- TRUE + envir[["false"]] <- FALSE + envir[["null"]] <- NULL + + envir + } - renv_json_read_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] + renv_json_read_remap <- function(object, patterns) { + + # repair names if necessary + if (!is.null(names(object))) { + + nms <- names(object) + for (pattern in patterns) + nms <- gsub(pattern[[2L]], pattern[[1L]], nms, fixed = TRUE) + names(object) <- nms + } - - # 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) + + # repair strings if necessary + if (is.character(object)) { + for (pattern in patterns) + object <- gsub(pattern[[2L]], pattern[[1L]], object, fixed = TRUE) } + + # recurse for other objects + if (is.recursive(object)) + for (i in seq_along(object)) + object[i] <- list(renv_json_read_remap(object[[i]], patterns)) + + # return remapped object + object + + } - # recurse - if (is.recursive(json)) { - for (i in seq_along(json)) { - json[i] <- list(renv_json_read_remap(json[[i]], map)) - } - } + renv_json_read_default <- function(file = NULL, text = NULL) { - json + # read json text + text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n") + + # convert into something the R parser will understand + patterns <- renv_json_read_patterns() + transformed <- text + for (pattern in patterns) + transformed <- gsub(pattern[[1L]], pattern[[2L]], transformed, fixed = TRUE) + + # parse it + rfile <- tempfile("renv-json-", fileext = ".R") + on.exit(unlink(rfile), add = TRUE) + writeLines(transformed, con = rfile) + json <- parse(rfile, keep.source = FALSE, srcfile = NULL)[[1L]] + # evaluate in safe environment + result <- eval(json, envir = renv_json_read_envir()) + + # fix up strings if necessary + renv_json_read_remap(result, patterns) + } + # load the renv profile, if any renv_bootstrap_profile_load(project)