Merge pull request #22 from LibraryCarpentry/update/packages

Update 2 packages

Author: jt14den

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)