Merge pull request #104 from schochastics/export_renv

Export renv (#55)

NAMESPACE

@@ -15,6 +15,7 @@ export(dockerise_rang)
 export(dockerize)
 export(dockerize_rang)
 export(export_rang)
+export(export_renv)
 export(query_sysreqs)
 export(resolve)
 importFrom(memoise,memoise)

R/installation.R

@@ -412,6 +412,69 @@ export_rang <- function(rang, path, rang_as_comment = TRUE, verbose = TRUE, lib
     invisible(path)
 }
 
+#' Export The Resolved Result As a renv Lockfile
+#'
+#' This function exports the results from [resolve()] to a renv lockfile that can be used as an alternative to a docker container.
+#' @param rang output from [resolve()]
+#' @param path character, path of the exported renv lockfile
+#' @return `path`, invisibly
+#' @details A renv lockfile is easier to handle than a docker container, but it cannot always reliably reproduce the exact computational environment,especially for very old code.
+#' @export
+#' @examples
+#' \donttest{
+#' if (interactive()) {
+#'     graph <- resolve(pkgs = c("openNLP", "LDAvis", "topicmodels", "quanteda"),
+#'                     snapshot_date = "2020-01-16")
+#'     export_renv(graph, ".")
+#' }
+#' }
+export_renv <- function(rang, path = ".") {
+    if (length(rang$ranglets) == 0) {
+        warning("Nothing to export.")
+        return(invisible(NULL))
+    }
+    pkg_df <- .generate_installation_order(rang)
+    pkg_list <- vector(mode = "list",length = nrow(pkg_df))
+    names(pkg_list) <- pkg_df$x
+    for(i in seq_len(nrow(pkg_df))){
+        pkg_list[[i]][["Package"]] <- pkg_df$x[i]
+        pkg_list[[i]][["Version"]] <- pkg_df$version[i] 
+        if(pkg_df$source[i]=="cran"){
+            pkg_list[[i]][["Source"]] <- "Repository"
+            pkg_list[[i]][["Repository"]] <- "CRAN"
+        #   pkg_list[[i]][["Requirements"]] <- c()
+        } else if(pkg_df$source[i]=="github"){
+            pkg_list[[i]][["Source"]] <- "GitHub"
+            pkg_list[[i]][["RemoteType"]] <- "GitHub"
+            pkg_list[[i]][["RemoteHost"]] <- "api.github.com"
+            pkg_list[[i]][["RemoteRepo"]] <- pkg_df$x[i]
+            pkg_list[[i]][["RemoteUsername"]]<- strsplit(pkg_df$handle[i],"/")[[1]][1]
+            pkg_list[[i]][["RemoteRef"]] = "HEAD"
+            pkg_list[[i]][["RemoteSha"]] = pkg_df$uid[i]
+        #   pkg_list[[i]][["Requirements"]] <- c()
+        } else if(pkg_df$source[i]=="bioc"){
+            pkg_list[[i]][["Source"]] <- "Bioconductor"
+            # pkg_list[[i]][["git_url"]] <- paste0("https://git.bioconductor.org/packages/",pkg_df$x[i])
+            # pkg_list[[i]][["git_branch"]] <- ""
+            # pkg_list[[i]][["git_last_commit"]] <- ""
+            # pkg_list[[i]][["git_last_commit_date"]] <- ""
+            # pkg_list[[i]][["Requirements"]] <- c()
+        } else if(pkg_df$source[i]=="local"){
+            pkg_list[[i]][["Source"]] <- "Local"
+            pkg_list[[i]][["RemoteType"]] <- "local"
+            pkg_list[[i]][["RemoteUrl"]] <- pkg_df$uid[i]
+        } else{
+          stop("source not supported")
+        }
+    }
+    r_lst <- list(Version = rang$r_version,
+                  Repositories = data.frame(Name = "CRAN",URL = "https://cloud.r-project.org"))
+    pkg_json <- jsonlite::toJSON(list(R = r_lst,Packages = pkg_list),auto_unbox = TRUE)
+    writeLines(jsonlite::prettify(pkg_json), file.path(path,"renv.lock"))
+    invisible(pkg_list)
+}
+
+
 #' Dockerize The Resolved Result
 #'
 #' This function exports the result from [resolve()] to a Docker file. For R version >= 3.1.0, the Dockerfile is based on the versioned Rocker image.

tests/testthat/test_expost_rang.R

@@ -138,3 +138,45 @@ test_that("prevent infinite loop, #81", {
     graph$ranglets[[1]]$original$y_pkgref <- "bioc::S4Vectors"
     expect_error(.generate_installation_order(graph), "cran::LDAvis")
 })
+
+test_that("renv export cran", {
+  temp_dir <- tempdir()
+  graph <- readRDS("../testdata/rang_ok.RDS")
+  export_renv(graph, path = temp_dir)
+  x <- readLines(file.path(temp_dir,"renv.lock"))
+  expect_true(any(grepl("LDAvis",x)))
+  expect_true(any(grepl("proxy",x)))
+  expect_true(any(grepl("RJSONIO",x)))
+})
+
+test_that("renv export bioc", {
+  temp_dir <- tempdir()
+  graph <- readRDS("../testdata/rang_bioc.RDS")
+  export_renv(graph, path = temp_dir)
+  x <- readLines(file.path(temp_dir,"renv.lock"))
+  expect_true(any(grepl("Bioconductor",x)))
+})
+
+test_that("renv export local and GH", {
+  temp_dir <- tempdir()
+  graph <- readRDS("../testdata/rang_local_gh.RDS")
+  export_renv(graph, path = temp_dir)
+  x <- readLines(file.path(temp_dir,"renv.lock"))
+  expect_true(any(grepl("local",x)))
+  expect_true(any(grepl("GitHub",x)))
+})
+
+test_that("empty renv export", {
+  temp_dir <- tempdir()
+  graph <- readRDS("../testdata/rang_ok.RDS")
+  graph$ranglets <- list()
+  expect_warning(x <- export_rang(graph, path = temp_dir))
+  expect_equal(x, NULL)
+})
+
+test_that("renv export unknown source", {
+  temp_dir <- tempdir()
+  graph <- readRDS("../testdata/rang_ok.RDS")
+  graph$ranglets[[1]]$original$x_pkgref <- "errr::or"
+  expect_error(export_rang(graph, temp_dir))
+})