Skip to content

Commit

Permalink
Merge branch 'v0.3' into v0.2
Browse files Browse the repository at this point in the history
  • Loading branch information
chainsawriot authored Jul 30, 2023
2 parents eb76625 + dac946a commit 30cd722
Show file tree
Hide file tree
Showing 77 changed files with 8,960 additions and 411 deletions.
10 changes: 7 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,11 +1,13 @@
Package: rang
Title: Reconstructing Reproducible R Computational Environments
Version: 0.2.1
Version: 0.2.5
Authors@R:
c(person("Chung-hong", "Chan", , "chainsawtiney@gmail.com", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-6232-7530")),
person("David", "Schoch", , "david@schochastics.net", role = "aut",
comment = c(ORCID = "0000-0003-2952-4812")))
comment = c(ORCID = "0000-0003-2952-4812")),
person("Egor", "Kotov", , "kotov.egor@gmail.com", role = "ctb",
comment = c(ORCID = "0000-0001-6690-5345")))
Description: Resolve the dependency graph of R packages at a specific time point based on the information from various 'R-hub' web services <https://blog.r-hub.io/>. The dependency graph can then be used to reconstruct the R computational environment with 'Rocker' <https://rocker-project.org>.
License: GPL (>= 3)
Encoding: UTF-8
Expand All @@ -28,7 +30,9 @@ Imports:
utils,
httr,
vctrs,
renv
renv,
here
Depends:
R (>= 3.5.0)
VignetteBuilder: knitr
LazyData: true
12 changes: 12 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,13 @@ S3method(convert_edgelist,rang)
S3method(convert_edgelist,ranglet)
S3method(print,rang)
S3method(print,ranglet)
export(apptainerise)
export(apptainerise_rang)
export(apptainerize)
export(apptainerize_rang)
export(as_pkgrefs)
export(convert_edgelist)
export(create_turing)
export(dockerise)
export(dockerise_rang)
export(dockerize)
Expand All @@ -18,6 +23,13 @@ export(export_rang)
export(export_renv)
export(query_sysreqs)
export(resolve)
export(singularise)
export(singularise_rang)
export(singularize)
export(singularize_rang)
export(use_rang)
importFrom(here,here)
importFrom(memoise,memoise)
importFrom(pkgsearch,cran_package_history)
importFrom(remotes,system_requirements)
importFrom(utils,download.file)
88 changes: 88 additions & 0 deletions R/apptainer.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,88 @@
.generate_debian_eol_apptainer_content <- function(r_version, lib, sysreqs_cmd, cache, debian_version = "lenny",
post_installation_steps = NULL,
rel_dir = "",
copy_all = FALSE) {
rang_path <- file.path(rel_dir, "rang.R")
cache_path <- file.path(rel_dir, "cache")
compile_path <- file.path(rel_dir, "compile_r.sh")
environment_vars <- c("export TZ=UTC", paste0("export COMPILE_PATH=", compile_path), paste0("export RANG_PATH=", rang_path))
containerfile_content <- list(
BOOTSTRAP = "Bootstrap: docker",
FROM = c(paste0("From: debian/eol:", debian_version)),
ENV_section = "\n%environment\n",
ENV = environment_vars,
FILES_section = "\n%files\n",
FILES = c(paste0("rang.R ", rang_path), paste0("compile_r.sh ", compile_path)),
POST_section = "\n%post\n",
POST = c(
environment_vars,
"ln -snf /usr/share/zoneinfo/$TZ /etc/localtime && echo $TZ > /etc/timezone && apt-get update -qq && apt-get install wget locales build-essential r-base-dev -y",
sysreqs_cmd
),
STARTSCRIPT_section = "\n%startscript\n",
STARTSCRIPT = c("exec R \"${@}\"")
)
if (!is.na(lib)) {
containerfile_content$POST <- append(containerfile_content$POST, paste0("mkdir ", lib, " && bash $COMPILE_PATH ", r_version))
} else {
containerfile_content$POST <- append(containerfile_content$POST, paste0("bash $COMPILE_PATH ", r_version))
}
if (isTRUE(cache)) {
containerfile_content$BOOTSTRAP <- "Bootstrap: docker"
containerfile_content$FROM <- c(paste0("From: debian/eol:", debian_version))
containerfile_content$FILES <- append(
containerfile_content$FILES,
c(
paste0("cache/rpkgs ", file.path(cache_path, "rpkgs")),
paste0("cache/rsrc ", file.path(cache_path, "rsrc"))
)
)
containerfile_content$POST <- append(paste0("export CACHE_PATH=", cache_path), containerfile_content$POST)
}
containerfile_content$POST <- append(containerfile_content$POST, post_installation_steps)
if (isTRUE(copy_all)) {
containerfile_content$FILES <- c(". /")
}
return(containerfile_content)
}

.generate_rocker_apptainer_content <- function(r_version, lib, sysreqs_cmd, cache, image,
post_installation_steps = NULL,
rel_dir = "",
copy_all = FALSE) {
rang_path <- file.path(rel_dir, "rang.R")
cache_path <- file.path(rel_dir, "cache")
environment_vars <- c(paste0("export RANG_PATH=", rang_path))
containerfile_content <- list(
BOOTSTRAP = "Bootstrap: docker",
FROM = c(paste0("From: rocker/", image, ":", r_version)),
ENV_section = "\n%environment\n",
ENV = c(environment_vars, "export RPORT=${RPORT:-8787}",
"export USER=$(whoami)", "export PASSWORD=${PASSWORD:-set_your_password}"),
FILES_section = "\n%files\n",
FILES = c(paste0("rang.R ", rang_path)),
POST_section = "\n%post\n",
POST = c(environment_vars, sysreqs_cmd),
STARTSCRIPT_section = "\n%startscript\n",
STARTSCRIPT = c("exec R \"${@}\"")
)
if (!is.na(lib)) {
containerfile_content$POST <- append(containerfile_content$POST, paste0("mkdir ", lib, " && Rscript $RANG_PATH"))
} else {
containerfile_content$POST <- append(containerfile_content$POST, "Rscript $RANG_PATH")
}
if (isTRUE(cache)) {
containerfile_content$FILES <- append(containerfile_content$FILES, paste0("cache ", cache_path))
containerfile_content$POST <- append(paste0("export CACHE_PATH=", cache_path), containerfile_content$POST)
}
if (image == "rstudio") {
containerfile_content$STARTSCRIPT <- c("exec /usr/lib/rstudio-server/bin/rserver \\\
--auth-none=0 --auth-pam-helper-path=pam-helper \\\
--server-user=${USER} --www-port=${RPORT}")
}
containerfile_content$POST <- append(containerfile_content$POST, post_installation_steps)
if (isTRUE(copy_all)) {
containerfile_content$FILES <- c(". /")
}
return(containerfile_content)
}
55 changes: 54 additions & 1 deletion R/as_pkgrefs.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,8 @@
#' @param x, currently supported data structure(s) are: output from [sessionInfo()], a character vector of package names
#' @param bioc_version character. When x is a character vector, version of Bioconductor to search for package names. NULL indicates not
#' search for Bioconductor.
#' @param no_enhances logical, when parsing DESCRIPTION, whether to ignore packages in the "Enhances" field
#' @param no_suggests logical, when parsing DESCRIPTION, whether to ignore packages in the "Suggests" field
#' @param ..., not used
#' @return a vector of package references
#' @export
Expand Down Expand Up @@ -34,13 +36,17 @@ as_pkgrefs.default <- function(x, ...) {

#' @rdname as_pkgrefs
#' @export
as_pkgrefs.character <- function(x, bioc_version = NULL, ...) {
as_pkgrefs.character <- function(x, bioc_version = NULL, no_enhances = TRUE, no_suggests = TRUE, ...) {
if(.is_renv_lockfile(x)) {
return(.extract_pkgrefs_renv_lockfile(path = x))
}
if(.is_directory(x)) {
return(.extract_pkgrefs_dir(x,bioc_version))
}
if(.is_DESCRIPTION(x)) {
return(.extract_pkgrefs_DESCRIPTION(x, bioc_version, no_enhances = no_enhances,
no_suggests = no_suggests))
}
return(.normalize_pkgs(pkgs = x, bioc_version = bioc_version))
}

Expand Down Expand Up @@ -88,6 +94,39 @@ as_pkgrefs.sessionInfo <- function(x, ...) {
return(paste0("cran::", handle))
}

.extract_pkgrefs_DESCRIPTION <- function(path, bioc_version = NULL, no_enhances = TRUE, no_suggests = TRUE) {
descr_df <- as.data.frame(read.dcf(path))
pkg_dep_df <- .parse_desc(descr_df, remotes = TRUE)
pkg_dep_df$y_pkgref <- .normalize_pkgs(pkg_dep_df$y, bioc_version = bioc_version)
pkgrefs <- .extract_queryable_dependencies(pkg_dep_df, no_enhances = no_enhances,
no_suggests = no_suggests)
if (isTRUE(is.null(pkgrefs))) {
stop("No queryable dependencies listed in the DESCRIPTION file.", call. = FALSE)
}
.remove_overlapped_pkgrefs(pkgrefs)
}

.remove_overlapped_pkgrefs <- function(pkgrefs) {
## Eliminate all github/cran duplicates, github has precedence
grouped_pkgrefs <- .group_pkgrefs_by_source(pkgrefs)
if (is.null(grouped_pkgrefs$github)) {
## no possible overlap
return(pkgrefs)
}
for (handle in grouped_pkgrefs$github) {
pkgname <- strsplit(handle, "/")[[1]][2]
cran_version <- paste0("cran::", pkgname)
bioc_version <- paste0("bioc::", pkgname)
if (cran_version %in% pkgrefs) {
pkgrefs <- setdiff(pkgrefs, cran_version)
}
if (bioc_version %in% pkgrefs) {
pkgrefs <- setdiff(pkgrefs, bioc_version)
}
}
return(pkgrefs)
}

.is_renv_lockfile <- function(path) {
# assuming all renv lockfiles are called renv.lock and path is only length 1
if(length(path)!=1) {
Expand Down Expand Up @@ -123,3 +162,17 @@ as_pkgrefs.sessionInfo <- function(x, ...) {
warning("scanning directories for R packages cannot detect github packages.",call. = FALSE)
return(.normalize_pkgs(pkgs = pkgs, bioc_version = bioc_version))
}

.is_DESCRIPTION <- function(path) {
# assuming all DESCRIPTION files are called DESCRIPTION and path is only length 1
if(length(path)!=1) {
return(FALSE)
}
if(isFALSE(file.exists(path))) {
return(FALSE)
}
if (isFALSE(basename(path) == "DESCRIPTION")) {
return(FALSE)
}
TRUE
}
157 changes: 157 additions & 0 deletions R/cache.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,157 @@
#' @importFrom utils download.file
#' @importFrom here here
NULL

.query_mirror_validity <- function(mirror) {
if (mirror == "https://cran.r-project.org/") {
return(TRUE)
}
all_mirrors <- utils::getCRANmirrors()$URL
mirror %in% all_mirrors
}

.normalize_url <- function(mirror, https = TRUE) {
if (grepl("^http://", mirror)) {
mirror <- gsub("^http://", "https://", mirror)
}
if (!grepl("^https://", mirror)) {
mirror <- paste0("https://", mirror)
}
if (!grepl("/$", mirror)) {
mirror <- paste0(mirror, "/")
}
if (grepl("/+$", mirror)) {
mirror <- gsub("/+$", "/", mirror)
}
if (isTRUE(https)) {
return(mirror)
} else {
return(gsub("^https://", "http://", mirror))
}
}

.check_tarball_path <- function(tarball_path, x, dir = FALSE) {
## raise error when tarball_path doesn't exist
if ((isFALSE(dir) && isFALSE(file.exists(tarball_path))) ||
(isTRUE(dir) && isFALSE(dir.exists(tarball_path)))) {
stop(x, " can't be cached.", call. = FALSE)
}
invisible()
}

.cache_pkg_cran <- function(x, version, cache_dir, cran_mirror, verbose) {
url <- paste(cran_mirror, "src/contrib/Archive/", x, "/", x, "_", version, ".tar.gz", sep = "")
tarball_path <- file.path(cache_dir, paste(x, "_", version, ".tar.gz", sep = ""))
tryCatch({
suppressWarnings(utils::download.file(url, destfile = tarball_path, quiet = !verbose))
}, error = function(e) {
## is the current latest
url <- paste(cran_mirror, "src/contrib/", x, "_", version, ".tar.gz", sep = "")
utils::download.file(url, destfile = tarball_path, quiet = !verbose)
})
.check_tarball_path(tarball_path, x)
}

.cache_pkg_bioc <- function(x, version, cache_dir, bioc_mirror, bioc_version, verbose, uid) {
url <- paste(bioc_mirror, bioc_version, "/", uid, "/src/contrib/", x, "_", version, ".tar.gz", sep = "")
tarball_path <- file.path(cache_dir, paste(x, "_", version, ".tar.gz", sep = ""))
suppressWarnings(utils::download.file(url, destfile = tarball_path, quiet = !verbose))
.check_tarball_path(tarball_path, x)
}

.cache_pkg_github <- function(x, version, handle, source, uid, cache_dir, verbose) {
sha <- uid
tarball_path <- file.path(cache_dir, paste("raw_", x, "_", version, ".tar.gz", sep = ""))
utils::download.file(paste("https://api.github.com/repos/", handle, "/tarball/", sha, sep = ""), destfile = tarball_path,
quiet = !verbose)
.check_tarball_path(tarball_path, x)
}

.cache_pkg_local <- function(x, version, cache_dir, uid) {
local_path <- uid
tarball_path <- file.path(cache_dir, paste("raw_", x, "_", version, ".tar.gz", sep = ""))
if (isTRUE(grepl("\\.tar.gz$|\\.tgz$", local_path))) {
## it could be a valid source package, but don't trust it blindly, mark it as raw_
## similar to github packages
file.copy(local_path, tarball_path)
return(.check_tarball_path(tarball_path, x))
}
if (.is_directory(local_path)) {
dir_pkg_path <- file.path(cache_dir, paste("dir_", x, "_", version, sep = ""))
res <- file.copy(from = local_path, to = cache_dir, recursive = TRUE, overwrite = TRUE)
res <- file.rename(from = file.path(cache_dir, x), to = dir_pkg_path)
return(.check_tarball_path(dir_pkg_path, x, dir = TRUE))
}
}

.cache_pkgs <- function(rang, base_dir, cran_mirror, bioc_mirror, verbose) {
installation_order <- .generate_installation_order(rang)
cache_dir <- file.path(base_dir, "cache", "rpkgs")
if (!dir.exists(cache_dir)) {
dir.create(cache_dir, recursive = TRUE)
}
for (i in seq(from = 1, to = nrow(installation_order), by = 1)) {
x <- installation_order$x[i]
source <- installation_order$source[i]
version <- installation_order$version[i]
handle <- installation_order$handle[i]
uid <- installation_order$uid[i]
if (source == "cran") {
.cache_pkg_cran(x = x, version = version, cache_dir = cache_dir,
cran_mirror = cran_mirror, verbose = verbose)
}
if (source == "github") {
## please note that these cached packages are not built
.cache_pkg_github(x = x, version = version, handle = handle,
source = source, uid = uid,
cache_dir = cache_dir, verbose = verbose)
}
if(source == "bioc") {
.cache_pkg_bioc(x = x, version = version, cache_dir = cache_dir,
bioc_mirror = bioc_mirror, bioc_version = rang$bioc_version, verbose = verbose,
uid = uid)
}
if(source == "local") {
## please note that these cached packages are not built
.cache_pkg_local(x = x, version = version, cache_dir = cache_dir, uid = uid)
}
}
invisible(base_dir)
}

.cache_rsrc <- function(r_version, base_dir, verbose) {
cache_dir <- file.path(base_dir, "cache", "rsrc")
if (!dir.exists(cache_dir)) {
dir.create(cache_dir, recursive = TRUE)
}
major_version <- as.character(package_version(r_version)$major)
if (major_version == "1") {
file_extension <- ".tgz"
} else {
file_extension <- ".tar.gz"
}
download_dir <- paste0("R-", major_version)
tar_file <- paste0("R-", r_version, file_extension)
url <- paste0("https://cran.r-project.org/src/base/", download_dir, "/", tar_file)
tar_path <- file.path(cache_dir, tar_file)
download.file(url = url, destfile = tar_path, quiet = !verbose)
if (!file.exists(tar_path)) {
stop("Fail to cache R source.")
}
return(tar_path)
}


.cache_debian <- function(debian_version, base_dir, verbose) {
cache_dir <- file.path(base_dir, "cache", "debian")
if (!dir.exists(cache_dir)) {
dir.create(cache_dir, recursive = TRUE)
}
debian_image_url <- debian_urls[debian_version]
rootfs_path <- file.path(cache_dir, "rootfs.tar.xz")
download.file(debian_image_url, destfile = rootfs_path, quiet = !verbose)
if (!file.exists(rootfs_path)) {
stop("Fail to cache Debian disk image.")
}
return(rootfs_path)
}
Loading

0 comments on commit 30cd722

Please sign in to comment.