Skip to content

Commit

Permalink
Merge pull request #127 from chainsawriot/userang
Browse files Browse the repository at this point in the history
Add a usable version of `use_rang` for Rocker
  • Loading branch information
chainsawriot authored Apr 11, 2023
2 parents bf3bfd3 + 05c4bbb commit 0866aad
Show file tree
Hide file tree
Showing 15 changed files with 424 additions and 63 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: rang
Title: Reconstructing Reproducible R Computational Environments
Version: 0.2.2
Version: 0.2.3
Authors@R:
c(person("Chung-hong", "Chan", , "[email protected]", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-6232-7530")),
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ export(export_rang)
export(export_renv)
export(query_sysreqs)
export(resolve)
export(use_rang)
importFrom(here,here)
importFrom(memoise,memoise)
importFrom(pkgsearch,cran_package_history)
Expand Down
14 changes: 7 additions & 7 deletions R/cache.R
Original file line number Diff line number Diff line change
Expand Up @@ -84,9 +84,9 @@ NULL
}
}

.cache_pkgs <- function(rang, output_dir, cran_mirror, bioc_mirror, verbose) {
.cache_pkgs <- function(rang, base_dir, cran_mirror, bioc_mirror, verbose) {
installation_order <- .generate_installation_order(rang)
cache_dir <- file.path(output_dir, "cache", "rpkgs")
cache_dir <- file.path(base_dir, "cache", "rpkgs")
if (!dir.exists(cache_dir)) {
dir.create(cache_dir, recursive = TRUE)
}
Expand Down Expand Up @@ -116,11 +116,11 @@ NULL
.cache_pkg_local(x = x, version = version, cache_dir = cache_dir, uid = uid)
}
}
invisible(output_dir)
invisible(base_dir)
}

.cache_rsrc <- function(r_version, output_dir, verbose) {
cache_dir <- file.path(output_dir, "cache", "rsrc")
.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)
}
Expand All @@ -142,8 +142,8 @@ NULL
}


.cache_debian <- function(debian_version, output_dir, verbose) {
cache_dir <- file.path(output_dir, "cache", "debian")
.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)
}
Expand Down
36 changes: 25 additions & 11 deletions R/dockerfile.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,33 +11,44 @@
}

.generate_debian_eol_dockerfile_content <- function(r_version, lib, sysreqs_cmd, cache, debian_version = "lenny",
post_installation_steps = NULL) {
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")
dockerfile_content <- list(
FROM = c(paste0("FROM debian/eol:", debian_version)),
ENV = c("ENV TZ UTC",
"RUN 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", "ENV RANG_PATH rang.R"),
COPY = c("COPY rang.R ./rang.R", "COPY compile_r.sh ./compile_r.sh"),
"RUN 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", paste0("ENV RANG_PATH ", rang_path), paste0("ENV COMPILE_PATH ", compile_path)),
COPY = c(paste0("COPY rang.R ", rang_path), paste0("COPY compile_r.sh ", compile_path)),
RUN = c(paste("RUN", sysreqs_cmd)),
CMD = c("CMD [\"R\"]"))
if (!is.na(lib)) {
dockerfile_content$RUN <- append(dockerfile_content$RUN, paste0("RUN mkdir ", lib, " && bash compile_r.sh ", r_version))
dockerfile_content$RUN <- append(dockerfile_content$RUN, paste0("RUN mkdir ", lib, " && bash $COMPILE_PATH ", r_version))
} else {
dockerfile_content$RUN <- append(dockerfile_content$RUN, paste0("RUN bash compile_r.sh ", r_version))
dockerfile_content$RUN <- append(dockerfile_content$RUN, paste0("RUN bash $COMPILE_PATH ", r_version))
}
if (isTRUE(cache)) {
dockerfile_content$COPY <- append(dockerfile_content$COPY,
c("COPY cache/rpkgs ./cache/rpkgs", "COPY cache/rsrc ./cache/rsrc"))
dockerfile_content$FROM <- c("FROM scratch", "ADD cache/debian/rootfs.tar.xz /")
dockerfile_content$ENV <- append(dockerfile_content$ENV, "ENV CACHE_PATH cache")
c(paste0("COPY cache/rpkgs ", file.path(cache_path, "rpkgs")),
paste0("COPY cache/rsrc ", file.path(cache_path, "rsrc"))))
dockerfile_content$FROM <- c("FROM scratch", paste0("ADD ", file.path(rel_dir, "cache/debian/rootfs.tar.xz"), " /"))
dockerfile_content$ENV <- append(dockerfile_content$ENV, paste0("ENV CACHE_PATH ", cache_path))
}
dockerfile_content$RUN <- append(dockerfile_content$RUN, post_installation_steps)
if (isTRUE(copy_all)) {
dockerfile_content$COPY <- c("COPY . /")
}
return(dockerfile_content)
}

.generate_rocker_dockerfile_content <- function(r_version, lib, sysreqs_cmd, cache, image,
post_installation_steps = NULL,
rang_path= "rang.R",
cache_path = "cache") {
rel_dir = "",
copy_all = FALSE) {
rang_path <- file.path(rel_dir, "rang.R")
cache_path <- file.path(rel_dir, "cache")
dockerfile_content <- list(
FROM = c(paste0("FROM rocker/", image, ":", r_version)),
ENV = c(paste0("ENV RANG_PATH ", rang_path)),
Expand All @@ -51,12 +62,15 @@
}
if (isTRUE(cache)) {
dockerfile_content$COPY <- append(dockerfile_content$COPY, paste0("COPY cache ", cache_path))
dockerfile_content$ENV <- append(dockerfile_content$ENV, "ENV CACHE_PATH cache")
dockerfile_content$ENV <- append(dockerfile_content$ENV, paste0("ENV CACHE_PATH ", cache_path))
}
if (image == "rstudio") {
dockerfile_content$CMD <- c("EXPOSE 8787", "CMD [\"/init\"]")
}
dockerfile_content$RUN <- append(dockerfile_content$RUN, post_installation_steps)
if (isTRUE(copy_all)) {
dockerfile_content$COPY <- c("COPY . /")
}
return(dockerfile_content)
}

Expand Down
52 changes: 38 additions & 14 deletions R/installation.R
Original file line number Diff line number Diff line change
Expand Up @@ -281,11 +281,13 @@ export_renv <- function(rang, path = ".") {
#' @param no_rocker logical, whether to skip using Rocker images even when an appropriate version is available. Please keep this as `TRUE` unless you know what you are doing
#' @param debian_version when Rocker images are not used, which EOL version of Debian to use. Can only be "lenny", "etch", "squeeze", "wheezy", "jessie", "stretch". Please keep this as default "lenny" unless you know what you are doing
#' @param skip_r17 logical, whether to skip R 1.7.x. Currently, it is not possible to compile R 1.7.x (R 1.7.0 and R 1.7.1) with the method provided by `rang`. It affects `snapshot_date` from 2003-04-16 to 2003-10-07. When `skip_r17` is TRUE and `snapshot_date` is within the aforementioned range, R 1.8.0 is used instead
#' @param insert_readme logical, whether to insert a README file
#' @param copy_all logical, whether to copy everything in the current directory into the container. If `inst/rang` is detected in `output_dir`, this is coerced to TRUE.
#' @param ... arguments to be passed to `dockerize`
#' @return `output_dir`, invisibly
#' @inheritParams export_rang
#' @inherit export_rang details
#' @seealso [resolve()], [export_rang()]
#' @seealso [resolve()], [export_rang()], [use_rang()]
#' @references
#' [The Rocker Project](https://rocker-project.org)
#' Ripley, B. (2005) [Packages and their Management in R 2.1.0.](https://cran.r-project.org/doc/Rnews/Rnews_2005-1.pdf) R News, 5(1):8--11.
Expand All @@ -311,7 +313,9 @@ dockerize <- function(rang, output_dir, materials_dir = NULL, post_installation_
bioc_mirror = "https://bioconductor.org/packages/",
no_rocker = FALSE,
debian_version = c("lenny", "squeeze", "wheezy", "jessie", "stretch"),
skip_r17 = TRUE) {
skip_r17 = TRUE,
insert_readme = TRUE,
copy_all = FALSE) {
if (length(rang$ranglets) == 0) {
warning("Nothing to dockerize.")
return(invisible(NULL))
Expand Down Expand Up @@ -343,40 +347,57 @@ dockerize <- function(rang, output_dir, materials_dir = NULL, post_installation_
if (!dir.exists(output_dir)) {
dir.create(output_dir)
}
rang_path <- file.path(output_dir, "rang.R")
export_rang(rang = rang, path = rang_path, rang_as_comment = rang_as_comment,
verbose = verbose, lib = lib, cran_mirror = cran_mirror,
check_cran_mirror = check_cran_mirror, bioc_mirror = bioc_mirror)
if (dir.exists(file.path(output_dir, "inst/rang"))) {
base_dir <- file.path(output_dir, "inst/rang")
rel_dir <- "inst/rang"
} else {
base_dir <- output_dir
rel_dir <- ""
}
if (rel_dir == "inst/rang" && isFALSE(copy_all)) {
.vcat(verbose, "`inst/rang` detected. `copy_all` is coerced to TRUE")
copy_all <- TRUE
}
rang_path <- file.path(base_dir, "rang.R")
export_rang(rang = rang, path = rang_path,
rang_as_comment = rang_as_comment,
verbose = verbose, lib = lib, cran_mirror = cran_mirror,
check_cran_mirror = check_cran_mirror, bioc_mirror = bioc_mirror)
if (isTRUE(skip_r17) && rang$r_version %in% c("1.7.0", "1.7.1")) {
r_version <- "1.8.0"
} else {
r_version <- rang$r_version
}
if (isTRUE(cache)) {
.cache_pkgs(rang, output_dir, cran_mirror, bioc_mirror, verbose)
.cache_pkgs(rang = rang, base_dir = base_dir, cran_mirror = cran_mirror,
bioc_mirror = bioc_mirror, verbose = verbose)
}
if (.is_r_version_older_than(rang, "3.1") || isTRUE(no_rocker)) {
file.copy(system.file("compile_r.sh", package = "rang"), file.path(output_dir, "compile_r.sh"),
file.copy(system.file("compile_r.sh", package = "rang"), file.path(base_dir, "compile_r.sh"),
overwrite = TRUE)
dockerfile_content <- .generate_debian_eol_dockerfile_content(r_version = r_version,
sysreqs_cmd = sysreqs_cmd, lib = lib,
cache = cache,
debian_version = debian_version,
post_installation_steps = post_installation_steps)
post_installation_steps = post_installation_steps,
rel_dir = rel_dir,
copy_all = copy_all)
if (isTRUE(cache)) {
.cache_rsrc(r_version = r_version, output_dir = output_dir,
.cache_rsrc(r_version = r_version, base_dir = base_dir,
verbose = verbose)
.cache_debian(debian_version = debian_version, output_dir = output_dir,
.cache_debian(debian_version = debian_version, base_dir = base_dir,
verbose = verbose)
}
} else {
dockerfile_content <- .generate_rocker_dockerfile_content(r_version = r_version,
sysreqs_cmd = sysreqs_cmd, lib = lib,
cache = cache, image = image,
post_installation_steps = post_installation_steps)
post_installation_steps = post_installation_steps,
rel_dir = rel_dir,
copy_all = copy_all)
}
if (!(is.null(materials_dir))) {
materials_subdir_in_output_dir <- file.path(output_dir, "materials")
materials_subdir_in_output_dir <- file.path(base_dir, "materials")
if (isFALSE(dir.exists(materials_subdir_in_output_dir))) {
dir.create(materials_subdir_in_output_dir)
}
Expand All @@ -385,8 +406,11 @@ dockerize <- function(rang, output_dir, materials_dir = NULL, post_installation_
recursive = TRUE)
dockerfile_content <- .insert_materials_dir(dockerfile_content)
}
## This should be written in the root level, not base_dir
.write_dockerfile(dockerfile_content, file.path(output_dir, "Dockerfile"))
.generate_docker_readme(output_dir = output_dir,image = image)
if (isTRUE(insert_readme)) {
.generate_docker_readme(output_dir = output_dir, image = image)
}
invisible(output_dir)
}

Expand Down
7 changes: 7 additions & 0 deletions R/memo_misc.R
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,13 @@ NULL

.memo_search_bioc <- memoise::memoise(.bioc_package_history, cache = cachem::cache_mem(max_age = 60 * 60))

.vcat <- function(verbose = TRUE, ...) {
if (isTRUE(verbose)) {
message(..., "\n")
}
invisible()
}

## internal data generation
## ---
## ### Supported OS Versions
Expand Down
60 changes: 36 additions & 24 deletions R/resolve.R
Original file line number Diff line number Diff line change
Expand Up @@ -318,7 +318,7 @@ resolve <- function(pkgs = ".", snapshot_date, no_enhances = TRUE, no_suggests =
if (!os %in% supported_os) {
stop("Don't know how to resolve ", os, ". Supported OSes are: ", paste(supported_os, collapse = ", "))
}
snapshot_date <- .extract_date(pkgs = pkgs, date = snapshot_date, verbose = verbose)
snapshot_date <- .extract_date(pkgs = pkgs, snapshot_date = snapshot_date, verbose = verbose)
bioc_version <- .generate_bioc_version(snapshot_date = snapshot_date, pkgs = pkgs)
pkgrefs <- as_pkgrefs(pkgs, bioc_version = bioc_version, no_enhances = no_enhances,
no_suggests = no_suggests)
Expand Down Expand Up @@ -423,29 +423,41 @@ print.rang <- function(x, all_pkgs = FALSE, ...) {
}
}

.extract_date <- function(pkgs,date,verbose = FALSE){
if(missing(date)){
snapshot_date <- NA
if(.is_directory(pkgs)){
snapshot_date <- max(file.mtime(dir(pkgs,recursive = TRUE)))
}
if(.is_renv_lockfile(pkgs)){
snapshot_date <- file.mtime(pkgs)
}
if(is.na(snapshot_date)){
if (isTRUE(verbose)) {
cat("No `snapshot_date`: Assuming `snapshot_date` to be a month ago.\n")
}
snapshot_date <- Sys.Date() - 30
}
} else{
snapshot_date <- date
}
snapshot_date <- parsedate::parse_date(snapshot_date)
if (snapshot_date > parsedate::parse_date(Sys.time())) {
stop("We don't know the future.", call. = FALSE)
}
snapshot_date
.extract_latest_modification_date <- function(path, verbose, ignore_use_rang = TRUE) {
file_paths <- dir(path, recursive = TRUE)
if (isTRUE(ignore_use_rang)) {
file_paths <- grep("inst/rang/|Makefile", file_paths, value = TRUE, invert = TRUE)
}
if (length(file_paths) == 0) {
return(NA)
}
snapshot_date <- max(file.mtime(file_paths))
.vcat(verbose, "Based on the latest modification date of files inside the directory: ", snapshot_date)
return(snapshot_date)
}

## determine the snapshot_date for `resolve` based on `date` and `pkgs`
.extract_date <- function(pkgs, snapshot_date, verbose = FALSE) {
if (missing(snapshot_date) || is.na(snapshot_date)) {
.vcat(verbose, "No `snapshot_date`, determining...")
snapshot_date <- NA
if (.is_directory(pkgs)) {
snapshot_date <- .extract_latest_modification_date(path = pkgs, verbose = verbose)
}
if (.is_renv_lockfile(pkgs)) {
snapshot_date <- file.mtime(pkgs)
.vcat(verbose, "Based on the latest modification date of lockfile: ", snapshot_date)
}
}
if (is.na(snapshot_date)) {
.vcat(verbose, "Assuming `snapshot_date` to be a month ago.\n")
snapshot_date <- Sys.Date() - 30
}
parsed_snapshot_date <- parsedate::parse_date(snapshot_date)
if (parsed_snapshot_date > parsedate::parse_date(Sys.time())) {
stop("We don't know the future.", call. = FALSE)
}
parsed_snapshot_date
}


Expand Down
54 changes: 54 additions & 0 deletions R/use_rang.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,54 @@
#' Setup rang for a directory
#'
#' This function adds the infrastructure in a directory (presumably with R scripts
#' and data) for (re)constructing the computational environment.
#' Specifically, this function inserts `inst/rang` into the directory, which contains
#' all components for the reconstruction. Optionally, `Makefile` and `.here` are also inserted
#' to ease the development of analytic code.
#' By default, (re)running this function does not overwrite any file. One can change this by setting
#' `force` to TRUE.
#' @param path character, path to the project root
#' @param add_makefile logical, whether to insert a barebone `Makefile` in the project root.
#' @param add_here logical, whether to insert a hidden `.here` file in the project root
#' @param verbose logical, whether to print out messages
#' @param force logical, whether to overwrite files (`inst/rang/update.R`, `Makefile`, `.here`) if they
#' exist.
#' @return path, invisibly
#' @details The infrastructure being added to your path consists of:
#' * `inst/rang` directory in the project root
#' * `update.R` file inside the directory
#' * `.here` in the project root (if `add_here` is TRUE)
#' * `Makefile` in the project root (if `add_makefile` is TRUE)
#' You might need to edit `update.R` manually. The default is to scan the whole project for
#' used R packages and assume they are either on CRAN or Bioconductor. If you have used other R packages,
#' you might need to edit this manually.
#' @export
use_rang <- function(path = ".", add_makefile = TRUE, add_here = TRUE,
verbose = TRUE, force = FALSE) {
if (isFALSE(dir.exists(path))) {
stop("'path' does not exist")
}
base_dir <- file.path(path, "inst/rang")
if (isFALSE(dir.exists(base_dir))) {
dir.create(base_dir, recursive = TRUE)
.vcat(verbose, "`inst/rang` created.")
} else {
.vcat(verbose, "`inst/rang` exists.")
}
if (isFALSE(file.exists(file.path(base_dir, "update.R"))) || isTRUE(force)) {
file.copy(system.file("update.R", package = "rang"), file.path(base_dir, "update.R"), overwrite = TRUE)
}
if (isTRUE(add_makefile) && (isFALSE(file.exists(file.path(path, "Makefile"))) || isTRUE(force))) {
file.copy(system.file("Makefile", package = "rang"), file.path(path, "Makefile"), overwrite = TRUE)
.vcat(verbose, "`Makefile` added.")
}
if (isTRUE(add_here) && (isFALSE(file.exists(file.path(path, ".here"))) || isTRUE(force))) {
file.create(file.path(path, ".here"))
.vcat(verbose, "`.here` added.")
}
.vcat(verbose, "The infrastructure for running `rang` in this project is now ready.")
.vcat(verbose, "You might want to edit this file: inst/rang/update.R")
.vcat(verbose, paste0("After that, run: setwd(\"", path,"\"); source(\"inst/rang/update.R\")"))
.vcat(verbose && add_makefile, "Or run in your shell: make update")
return(invisible(path))
}
14 changes: 14 additions & 0 deletions inst/Makefile
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
## Autogenerated by rang, you might want to change the handle
handle=yourproject
.PHONY: update build launch export rebuild

update:
Rscript inst/rang/update.R
build: Dockerfile
docker build -t ${handle}img .
dockerlaunch:
docker run --rm --name "${handle}container" -ti ${handle}img
export:
docker save ${handle}img | gzip > ${handle}img.tar.gz
rebuild: ${handle}img.tar.gz
docker load < ${handle}img.tar.gz
Loading

0 comments on commit 0866aad

Please sign in to comment.