diff --git a/R/00_Config_file.R b/R/00_Config_file.R index fb5a048..a52d8f8 100644 --- a/R/00_Config_file.R +++ b/R/00_Config_file.R @@ -19,7 +19,7 @@ # Version of the Workflow workflow_version <- - "1.0.0" + "1.0.1" # Set the current environment current_env <- environment() diff --git a/R/___Init_project___.R b/R/___Init_project___.R index 3df0191..6cebd7c 100644 --- a/R/___Init_project___.R +++ b/R/___Init_project___.R @@ -11,16 +11,79 @@ # #----------------------------------------------------------# -# Script to prepare all necessary components of environment to run the Project. +# Script to prepare all components of the environment to run the Project. # Needs to be run only once +#----------------------------------------------------------# +# Step 0: Install {renv} for package management ----- +#----------------------------------------------------------# + +if ( + "renv" %in% utils::installed.packages() +) { + library(renv) +} else { + # install package + utils::install.packages("renv") + + # load the package + library(renv) +} + +#----------------------------------------------------------# +# Step 1: Activate 'renv' project ----- +#----------------------------------------------------------# + +# NOTE: The R may ask the User to restart the session (R). +# After that, continue with the next step + +renv::activate() #----------------------------------------------------------# -# Step 0: Define package list and custom function ----- +# Step 1: Install {here} for file navigation ----- #----------------------------------------------------------# -# list of all CRAN packages -package_list <- +if ( + "here" %in% utils::installed.packages() +) { + library(here) +} else { + # install package + utils::install.packages("here") + + # load the package + library(here) +} + +#----------------------------------------------------------# +# Step 2: Synchronize package versions with the project ----- +#----------------------------------------------------------# + +# If there is no lock file present make a new snapshot +if ( + isTRUE("library_list.lock" %in% list.files(here::here("renv"))) +) { + cat("The project already has a lockfile. Restoring packages", "\n") + + renv::restore( + lockfile = here::here("renv/library_list.lock") + ) + + cat("Set up completed. You can continute to run the project", "\n") + + cat("Do NOT run the rest of this script", "\n") +} else { + cat("The project seems to be new (no lockfile)", "\n") + + cat("Continue with this script", "\n") +} + +#----------------------------------------------------------# +# Step 3: Install packages to the project ----- +#----------------------------------------------------------# + +# install all packages in the lst from CRAN +sapply( c( "assertthat", "Bchron", @@ -39,6 +102,7 @@ package_list <- "lifecycle", "magrittr", "methods", + "neotoma2", "purrr", "qs", "raster", @@ -60,94 +124,32 @@ package_list <- "utils", "waldo", "zip" - ) + ), + utils::install.packages, + character.only = TRUE +) -# define helper function -install_packages <- - function(pkgs_list) { - # install all packages in the lst from CRAN - sapply(pkgs_list, utils::install.packages, character.only = TRUE) - - # install RUtilpol from GitHub - remotes::install_github( - repo = "HOPE-UIB-BIO/R-Utilpol-package", - ref = "HEAD", - quiet = FALSE, - upgrade = "ask" - ) - - # install neotoma2 from GitHub - remotes::install_github( - repo = "NeotomaDB/neotoma2", - quiet = FALSE, - upgrade = "ask" - ) - - # install RFossilpol from GitHub - remotes::install_github( - repo = "HOPE-UIB-BIO/R-Fossilpol-package@*release", - quiet = FALSE, - upgrade = "ask" - ) - } +# install RUtilpol from GitHub +remotes::install_github( + repo = "HOPE-UIB-BIO/R-Utilpol-package", + ref = "HEAD", + quiet = FALSE, + upgrade = "ask" +) +# install RFossilpol from GitHub +remotes::install_github( + repo = "HOPE-UIB-BIO/R-Fossilpol-package@*release", + quiet = FALSE, + upgrade = "ask" +) #----------------------------------------------------------# -# Step 1: Install 'renv' package ----- +# Step 4: Save versions of packages ----- #----------------------------------------------------------# -utils::install.packages("renv") +renv::snapshot( + lockfile = here::here("renv/library_list.lock") +) - -#----------------------------------------------------------# -# Step 2: Deactivate 'renv' package ----- -#----------------------------------------------------------# - -# deactivate to make sure that packages are updated on the machine -renv::deactivate() - - -#----------------------------------------------------------# -# Step 3: Install packages to the machine -#----------------------------------------------------------# - -install_packages(package_list) - - -#----------------------------------------------------------# -# Step 4: Activate 'renv' project -#----------------------------------------------------------# - -renv::activate() - - -#----------------------------------------------------------# -# Step 5: Install packages to the project -#----------------------------------------------------------# - -install_packages(package_list) - - -#----------------------------------------------------------# -# Step 6: Synchronize package versions with the project -#----------------------------------------------------------# - -library(here) - -# if there is no lock file present make a new snapshot -if ( - isFALSE("library_list.lock" %in% list.files(here::here("renv"))) -) { - renv::snapshot( - lockfile = here::here("renv/library_list.lock") - ) -} else { - renv::restore( - lockfile = here::here("renv/library_list.lock") - ) -} - - -#----------------------------------------------------------# -# Step 7: Run the project -#----------------------------------------------------------# +cat("Set up completed. You can continute to run the project", "\n") diff --git a/renv/.gitignore b/renv/.gitignore index c3ba241..0ec0cbb 100644 --- a/renv/.gitignore +++ b/renv/.gitignore @@ -1,7 +1,7 @@ -cellar/ -sandbox/ -local/ library/ +local/ +cellar/ lock/ python/ +sandbox/ staging/ diff --git a/renv/activate.R b/renv/activate.R index 360dd52..03f9289 100644 --- a/renv/activate.R +++ b/renv/activate.R @@ -2,7 +2,8 @@ local({ # the requested version of renv - version <- "0.17.0" + version <- "1.0.0" + attr(version, "sha") <- NULL # the project directory project <- getwd() @@ -60,21 +61,75 @@ local({ # load bootstrap tools `%||%` <- function(x, y) { - if (is.environment(x) || length(x)) x else y + if (is.null(x)) y else x + } + + catf <- function(fmt, ..., appendLF = TRUE) { + + quiet <- getOption("renv.bootstrap.quiet", default = FALSE) + if (quiet) + return(invisible()) + + msg <- sprintf(fmt, ...) + cat(msg, file = stdout(), sep = if (appendLF) "\n" else "") + + invisible(msg) + + } + + header <- function(label, + ..., + prefix = "#", + suffix = "-", + n = min(getOption("width"), 78)) + { + label <- sprintf(label, ...) + n <- max(n - nchar(label) - nchar(prefix) - 2L, 8L) + if (n <= 0) + return(paste(prefix, label)) + + tail <- paste(rep.int(suffix, n), collapse = "") + paste0(prefix, " ", label, " ", tail) + + } + + startswith <- function(string, prefix) { + substring(string, 1, nchar(prefix)) == prefix } bootstrap <- function(version, library) { + friendly <- renv_bootstrap_version_friendly(version) + section <- header(sprintf("Bootstrapping renv %s", friendly)) + catf(section) + # attempt to download renv - tarball <- tryCatch(renv_bootstrap_download(version), error = identity) - if (inherits(tarball, "error")) - stop("failed to download renv ", version) + catf("- Downloading renv ... ", appendLF = FALSE) + withCallingHandlers( + tarball <- renv_bootstrap_download(version), + error = function(err) { + catf("FAILED") + stop("failed to download:\n", conditionMessage(err)) + } + ) + catf("OK") + on.exit(unlink(tarball), add = TRUE) # now attempt to install - status <- tryCatch(renv_bootstrap_install(version, tarball, library), error = identity) - if (inherits(status, "error")) - stop("failed to install renv ", version) + catf("- Installing renv ... ", appendLF = FALSE) + withCallingHandlers( + status <- renv_bootstrap_install(version, tarball, library), + error = function(err) { + catf("FAILED") + stop("failed to install:\n", conditionMessage(err)) + } + ) + catf("OK") + + # add empty line to break up bootstrapping from normal output + catf("") + return(invisible()) } renv_bootstrap_tests_running <- function() { @@ -83,31 +138,32 @@ local({ renv_bootstrap_repos <- function() { + # get CRAN repository + cran <- getOption("renv.repos.cran", "https://cloud.r-project.org") + # check for repos override repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA) - if (!is.na(repos)) + if (!is.na(repos)) { + + # check for RSPM; if set, use a fallback repository for renv + rspm <- Sys.getenv("RSPM", unset = NA) + if (identical(rspm, repos)) + repos <- c(RSPM = rspm, CRAN = cran) + 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()) { - repos <- getOption("renv.tests.repos") - if (!is.null(repos)) - return(repos) - } - # retrieve current repos repos <- getOption("repos") # ensure @CRAN@ entries are resolved - repos[repos == "@CRAN@"] <- getOption( - "renv.repos.cran", - "https://cloud.r-project.org" - ) + repos[repos == "@CRAN@"] <- cran # add in renv.bootstrap.repos if set default <- c(FALLBACK = "https://cloud.r-project.org") @@ -146,33 +202,34 @@ local({ 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 + sha <- attr(version, "sha", exact = TRUE) + + methods <- if (!is.null(sha)) { + + # attempting to bootstrap a development version of renv + c( + function() renv_bootstrap_download_tarball(sha), + function() renv_bootstrap_download_github(sha) ) - ) + + } else { + + # attempting to bootstrap a release version of renv + c( + function() renv_bootstrap_download_tarball(version), + function() renv_bootstrap_download_cran_latest(version), + function() renv_bootstrap_download_cran_archive(version) + ) + + } for (method in methods) { - path <- tryCatch(method(version), error = identity) + path <- tryCatch(method(), error = identity) if (is.character(path) && file.exists(path)) return(path) } - stop("failed to download renv ", version) + stop("All download methods failed") } @@ -236,8 +293,6 @@ local({ type <- spec$type repos <- spec$repos - message("* Downloading renv ", version, " ... ", appendLF = FALSE) - baseurl <- utils::contrib.url(repos = repos, type = type) ext <- if (identical(type, "source")) ".tar.gz" @@ -254,13 +309,10 @@ local({ condition = identity ) - if (inherits(status, "condition")) { - message("FAILED") + if (inherits(status, "condition")) return(FALSE) - } # report success and return - message("OK (downloaded ", type, ")") destfile } @@ -317,8 +369,6 @@ local({ 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( @@ -326,14 +376,11 @@ local({ condition = identity ) - if (identical(status, 0L)) { - message("OK") + if (identical(status, 0L)) return(destfile) - } } - message("FAILED") return(FALSE) } @@ -356,7 +403,7 @@ local({ 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." + fmt <- "- RENV_BOOTSTRAP_TARBALL is set (%s) but does not exist." msg <- sprintf(fmt, tarball) warning(msg) @@ -365,10 +412,7 @@ local({ } - fmt <- "* Bootstrapping with tarball at path '%s'." - msg <- sprintf(fmt, tarball) - message(msg) - + catf("- Using local tarball '%s'.", tarball) tarball } @@ -395,8 +439,6 @@ local({ 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) @@ -406,26 +448,105 @@ local({ condition = identity ) - if (!identical(status, 0L)) { - message("FAILED") + if (!identical(status, 0L)) return(FALSE) - } - message("OK") + renv_bootstrap_download_augment(destfile) + return(destfile) } + # Add Sha to DESCRIPTION. This is stop gap until #890, after which we + # can use renv::install() to fully capture metadata. + renv_bootstrap_download_augment <- function(destfile) { + sha <- renv_bootstrap_git_extract_sha1_tar(destfile) + if (is.null(sha)) { + return() + } + + # Untar + tempdir <- tempfile("renv-github-") + on.exit(unlink(tempdir, recursive = TRUE), add = TRUE) + untar(destfile, exdir = tempdir) + pkgdir <- dir(tempdir, full.names = TRUE)[[1]] + + # Modify description + desc_path <- file.path(pkgdir, "DESCRIPTION") + desc_lines <- readLines(desc_path) + remotes_fields <- c( + "RemoteType: github", + "RemoteHost: api.github.com", + "RemoteRepo: renv", + "RemoteUsername: rstudio", + "RemotePkgRef: rstudio/renv", + paste("RemoteRef: ", sha), + paste("RemoteSha: ", sha) + ) + writeLines(c(desc_lines[desc_lines != ""], remotes_fields), con = desc_path) + + # Re-tar + local({ + old <- setwd(tempdir) + on.exit(setwd(old), add = TRUE) + + tar(destfile, compression = "gzip") + }) + invisible() + } + + # Extract the commit hash from a git archive. Git archives include the SHA1 + # hash as the comment field of the tarball pax extended header + # (see https://www.kernel.org/pub/software/scm/git/docs/git-archive.html) + # For GitHub archives this should be the first header after the default one + # (512 byte) header. + renv_bootstrap_git_extract_sha1_tar <- function(bundle) { + + # open the bundle for reading + # We use gzcon for everything because (from ?gzcon) + # > Reading from a connection which does not supply a ‘gzip’ magic + # > header is equivalent to reading from the original connection + conn <- gzcon(file(bundle, open = "rb", raw = TRUE)) + on.exit(close(conn)) + + # The default pax header is 512 bytes long and the first pax extended header + # with the comment should be 51 bytes long + # `52 comment=` (11 chars) + 40 byte SHA1 hash + len <- 0x200 + 0x33 + res <- rawToChar(readBin(conn, "raw", n = len)[0x201:len]) + + if (grepl("^52 comment=", res)) { + sub("52 comment=", "", res) + } else { + NULL + } + } + 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) + output <- renv_bootstrap_install_impl(library, tarball) + + # check for successful install + status <- attr(output, "status") + if (is.null(status) || identical(status, 0L)) + return(status) + + # an error occurred; report it + header <- "installation of renv failed" + lines <- paste(rep.int("=", nchar(header)), collapse = "") + text <- paste(c(header, lines, output), collapse = "\n") + stop(text) + + } + + renv_bootstrap_install_impl <- function(library, tarball) { # 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) + R <- file.path(bin, exe) args <- c( "--vanilla", "CMD", "INSTALL", "--no-multiarch", @@ -433,19 +554,7 @@ local({ 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 + system2(R, args, stdout = TRUE, stderr = TRUE) } @@ -655,34 +764,60 @@ local({ } - renv_bootstrap_validate_version <- function(version) { + renv_bootstrap_validate_version <- function(version, description = NULL) { - loadedversion <- utils::packageDescription("renv", fields = "Version") - if (version == loadedversion) - return(TRUE) + # resolve description file + description <- description %||% { + path <- getNamespaceInfo("renv", "path") + packageDescription("renv", lib.loc = dirname(path)) + } - # 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 = "@") + # check whether requested version 'version' matches loaded version of renv + sha <- attr(version, "sha", exact = TRUE) + valid <- if (!is.null(sha)) + renv_bootstrap_validate_version_dev(sha, description) else - paste("renv", loadedversion, sep = "@") + renv_bootstrap_validate_version_release(version, description) + + if (valid) + return(TRUE) + + # the loaded version of renv doesn't match the requested version; + # give the user instructions on how to proceed + remote <- if (!is.null(description[["RemoteSha"]])) { + paste("rstudio/renv", description[["RemoteSha"]], sep = "@") + } else { + paste("renv", description[["Version"]], sep = "@") + } + + # display both loaded version + sha if available + friendly <- renv_bootstrap_version_friendly( + version = description[["Version"]], + sha = description[["RemoteSha"]] + ) 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.", + "- 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) + catf(fmt, friendly, renv_bootstrap_version_friendly(version), remote) FALSE } + renv_bootstrap_validate_version_dev <- function(version, description) { + expected <- description[["RemoteSha"]] + is.character(expected) && startswith(expected, version) + } + + renv_bootstrap_validate_version_release <- function(version, description) { + expected <- description[["Version"]] + is.character(expected) && identical(expected, version) + } + renv_bootstrap_hash_text <- function(text) { hashfile <- tempfile("renv-hash-") @@ -847,6 +982,40 @@ local({ } + renv_bootstrap_version_friendly <- function(version, sha = NULL) { + sha <- sha %||% attr(version, "sha", exact = TRUE) + parts <- c(version, sprintf("[sha: %s]", substring(sha, 1L, 7L))) + paste(parts, collapse = " ") + } + + renv_bootstrap_run <- function(version, libpath) { + + # perform bootstrap + bootstrap(version, libpath) + + # exit early if we're just testing bootstrap + if (!is.na(Sys.getenv("RENV_BOOTSTRAP_INSTALL_ONLY", unset = NA))) + return(TRUE) + + # try again to load + if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) { + return(renv::load(project = getwd())) + } + + # failed to download or load renv; warn the user + msg <- c( + "Failed to find an renv installation: the project will not be loaded.", + "Use `renv::activate()` to re-initialize the project." + ) + + warning(paste(msg, collapse = "\n"), call. = FALSE) + + } + + + renv_bootstrap_in_rstudio <- function() { + commandArgs()[[1]] == "RStudio" + } renv_json_read <- function(file = NULL, text = NULL) { @@ -990,31 +1159,23 @@ local({ if (renv_bootstrap_load(project, libpath, version)) return(TRUE) - # load failed; inform user we're about to bootstrap - prefix <- paste("# Bootstrapping renv", version) - postfix <- paste(rep.int("-", 77L - nchar(prefix)), collapse = "") - header <- paste(prefix, postfix) - message(header) - - # perform bootstrap - bootstrap(version, libpath) - - # exit early if we're just testing bootstrap - if (!is.na(Sys.getenv("RENV_BOOTSTRAP_INSTALL_ONLY", unset = NA))) - return(TRUE) + if (renv_bootstrap_in_rstudio()) { + setHook("rstudio.sessionInit", function(...) { + renv_bootstrap_run(version, libpath) - # try again to load - if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) { - message("* Successfully installed and loaded renv ", version, ".") - return(renv::load()) + # Work around buglet in RStudio if hook uses readline + tryCatch( + { + tools <- as.environment("tools:rstudio") + tools$.rs.api.sendToConsole("", echo = FALSE, focus = FALSE) + }, + error = function(cnd) {} + ) + }) + } else { + renv_bootstrap_run(version, libpath) } - # failed to download or load renv; warn the user - msg <- c( - "Failed to find an renv installation: the project will not be loaded.", - "Use `renv::activate()` to re-initialize the project." - ) - - warning(paste(msg, collapse = "\n"), call. = FALSE) + invisible() }) diff --git a/renv/settings.dcf b/renv/settings.dcf deleted file mode 100644 index bf722e8..0000000 --- a/renv/settings.dcf +++ /dev/null @@ -1,7 +0,0 @@ -external.libraries: -ignored.packages: -package.dependency.fields: Imports, Depends, LinkingTo -r.version: -snapshot.type: implicit -use.cache: TRUE -vcs.ignore.library: TRUE