Merge pull request #60 from chainsawriot/as_pkgs

as_pkgrefs #55

NAMESPACE

@@ -1,7 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as_pkgrefs,default)
+S3method(as_pkgrefs,sessionInfo)
 S3method(print,rang)
 S3method(print,ranglet)
+export(as_pkgrefs)
 export(dockerise)
 export(dockerise_rang)
 export(dockerize)

R/as_pkgs.R

@@ -0,0 +1,51 @@
+#' Convert Data Structures into Package References
+#'
+#' This generic function converts several standard data structures into a vector of package references, which in turn
+#' can be used as the first argument of the function [resolve()]. This function guessimates the possible sources of the
+#' packages. But we strongly recommend manually reviewing the detected packages before using them for [resolve()].
+#' @param x, currently supported data structure(s) are: output from [sessionInfo()], a character vector of package names
+#' @param ..., not used
+#' @return a vector of package references
+#' @export
+#' @examples
+#' as_pkgrefs(sessionInfo())
+#' if (interactive()) {
+#'    require(rang)
+#'    require(pkgsearch)
+#'    graph <- resolve(as_pkgrefs(sessionInfo()))
+#' }
+as_pkgrefs <- function(x, ...) {
+    UseMethod("as_pkgrefs", x)
+}
+
+#' @rdname as_pkgrefs
+#' @export
+as_pkgrefs.default <- function(x, ...) {
+    ## an exported version of .normalize_pkgs
+    if (is.numeric(x) || is.logical(x) || is.integer(x)) {
+        stop("Don't know how to convert this to package references.", call. = FALSE)
+    }
+    return(.normalize_pkgs(x))
+}
+
+#' @rdname as_pkgrefs
+#' @export
+as_pkgrefs.sessionInfo <- function(x, ...) {
+    vapply(X = x$otherPkgs, FUN = .extract_pkgref_packageDescription, FUN.VALUE = character(1), USE.NAMES = FALSE)
+}
+
+.extract_pkgref_packageDescription <- function(packageDescription) {
+    handle <- packageDescription[['Package']]
+    if ("GithubRepo" %in% names(packageDescription)) {
+        return(paste0("github::", packageDescription[["GithubUsername"]], "/", packageDescription[["GithubRepo"]]))
+    }
+    ## uncomment this when #57 is implemented
+    ##if (basename(attr(packageDescription, "file")) == "DESCRIPTION") {
+        ## probably load via devtools::load_all
+    ##    return(paste0("local::", dirname(attr(packageDescription, "file"))))
+    ##}
+    ## TODO bioc
+    ## if (basename(attr(packageDescription, "file")) == "package.rds") {
+    return(paste0("cran::", handle))
+    ## }
+}

R/resolve.R

@@ -61,7 +61,7 @@
     pkg_dep_df$x_pubdate <- sha$x_pubdate
     if("y"%in% names(pkg_dep_df)) {
         pkg_dep_df$y_pkgref <- .normalize_pkgs(pkg_dep_df$y)
-        return(pkg_dep_df[,c("snapshot_date", "x", "x_version", "x_pubdate", "x_pkgref", "x_uid", "y", "type", "y_raw_version", "y_pkgref")])  
+        return(pkg_dep_df[,c("snapshot_date", "x", "x_version", "x_pubdate", "x_pkgref", "x_uid", "y", "type", "y_raw_version", "y_pkgref")])
     } else {
         return(pkg_dep_df[,c("snapshot_date", "x", "x_version", "x_pubdate", "x_pkgref", "x_uid")])
     }
@@ -74,7 +74,7 @@
     idx <- which(dates<=date)[1]
     k <- 2
     while(is.null(idx)) {
-        commits <- gh::gh(paste0("GET /repos/", handle, "/commits"), per_page = 100, page = k)  
+        commits <- gh::gh(paste0("GET /repos/", handle, "/commits"), per_page = 100, page = k)
         k <- k + 1
     }
     list(sha = commits[[idx]]$sha, x_pubdate =  anytime::anytime(dates[[idx]], tz = "UTC", asUTC = TRUE))
@@ -161,8 +161,8 @@
 #' Resolve Dependencies Of R Packages
 #'
 #' This function recursively queries dependencies of R packages at a specific snapshot time. The dependency graph can then be used to recreate the computational environment. The data on dependencies are provided by R-hub.
-#' 
-#' @param pkgs character vector of R packages to resolve. `pkgs` can be either in shorthands, e.g. "rtoot", "ropensci/readODS", or in package references, e.g. "cran::rtoot", "github::ropensci/readODS". Please refer to the [Package References documentation](https://r-lib.github.io/pkgdepends/reference/pkg_refs.html) of `pak` for details. Currently, this package supports only cran and github packages.
+#'
+#' @param pkgs `pkgs` can be 1) a character vector of R packages to resolve, or 2) a data structure that [as_pkgrefs()] can convert to a character vector of package references. For 1) `pkgs` can be either in shorthands, e.g. "rtoot", "ropensci/readODS", or in package references, e.g. "cran::rtoot", "github::ropensci/readODS". Please refer to the [Package References documentation](https://r-lib.github.io/pkgdepends/reference/pkg_refs.html) of `pak` for details. Currently, this package supports only cran and github packages. For 2) [as_pkgrefs()] support the output of [sessionInfo()].
 #' @param snapshot_date Snapshot date, if not specified, assume to be a month ago
 #' @param no_enhances logical, whether to ignore packages in the "Enhances" field
 #' @param no_suggests logical, whether to ignore packages in the "Suggests" field
@@ -210,7 +210,11 @@ resolve <- function(pkgs, snapshot_date, no_enhances = TRUE, no_suggests = TRUE,
     if (snapshot_date >= anytime::anytime(Sys.Date())) {
         stop("We don't know the future.", call. = FALSE)
     }
-    pkgrefs <- .normalize_pkgs(pkgs)
+    if (class(pkgs) %in% c("sessionInfo")) {
+        pkgrefs <- as_pkgrefs(pkgs)
+    } else {
+        pkgrefs <- .normalize_pkgs(pkgs)
+    }
     output <- list()
     output$call <- match.call()
     output$ranglets <- list()
@@ -428,11 +432,11 @@ query_sysreqs <- function(rang, os = "ubuntu-20.04") {
     curl <- Sys.which("curl")
     rspm_repo_id <- Sys.getenv("RSPM_REPO_ID", DEFAULT_RSPM_REPO_ID)
     rspm <- Sys.getenv("RSPM_ROOT", DEFAULT_RSPM)
-  
+
     rspm_repo_url <- sprintf("%s/__api__/repos/%s", rspm, rspm_repo_id)
     desc_file <- tempfile()
     ## potenital issue: not going back to snapshot time! but the same is true for the remotes approach?
-    repo_descr <- gh::gh(paste0("GET /repos/", handle, "/contents/DESCRIPTION"))   
+    repo_descr <- gh::gh(paste0("GET /repos/", handle, "/contents/DESCRIPTION"))
     writeLines(readLines(repo_descr$download_url),con = desc_file)
     res <- system2(
         curl,
@@ -453,7 +457,6 @@ query_sysreqs <- function(rang, os = "ubuntu-20.04") {
     if (!is.null(res$error)) {
         stop(res$error)
     }
-    unique(unlist(c(res[["install_scripts"]], 
+    unique(unlist(c(res[["install_scripts"]],
                     lapply(res[["dependencies"]], `[[`, "install_scripts"))))
 }
-

tests/testthat/test_pkgref.R

@@ -64,3 +64,29 @@ test_that(".parse_pkgref", {
     expect_equal(.parse_pkgref("cran::testthat", TRUE), "testthat")
     expect_equal(.parse_pkgref("cran::testthat", FALSE), "cran")
 })
+
+test_that(".extract_pkgref_packageDescription", {
+    si <- readRDS("../testdata/sessionInfo1.RDS")
+    expect_equal(.extract_pkgref_packageDescription(si$otherPkgs[[1]]), "github::chainsawriot/grafzahl")
+    expect_equal(.extract_pkgref_packageDescription(si$otherPkgs[[2]]), "cran::rtoot")
+    ## change this with #57
+    ## expect_equal(.extract_pkgref_packageDescription(si$otherPkgs[[3]]), "local::/home/chainsawriot/dev/rang")
+    expect_equal(.extract_pkgref_packageDescription(si$otherPkgs[[3]]), "cran::rang")
+    expect_equal(.extract_pkgref_packageDescription(si$otherPkgs[[4]]), "cran::testthat")
+})
+
+test_that("as_pkgrefs dispatch", {
+    expect_error(as_pkgrefs(TRUE))
+    expect_error(as_pkgrefs(7.21))
+    expect_error(as_pkgrefs(1L))
+    expect_equal(as_pkgrefs("rtoot"), "cran::rtoot")
+    expect_equal(as_pkgrefs(c("rtoot", "sna")), c("cran::rtoot", "cran::sna"))
+})
+
+test_that("as_pkgrefs_packageDescription", {
+    si <- readRDS("../testdata/sessionInfo1.RDS")
+    res <- as_pkgrefs(si)
+    ## change this with #57
+    ## expect_equal(res, c("github::chainsawriot/grafzahl", "cran::rtoot", "local::/home/chainsawriot/dev/rang", "cran::testthat")
+    expect_equal(res, c("github::chainsawriot/grafzahl", "cran::rtoot", "cran::rang", "cran::testthat"))
+})

tests/testthat/test_resolve.R

@@ -24,7 +24,7 @@ test_that("unresolved", {
     skip_on_cran()
     expect_error(res <- .query_snapshot_dependencies("cran::LDAvis", snapshot_date = "2001-10-01"))
     warns <- capture_warnings(x <- resolve("LDAvis", snapshot_date = "2000-10-01"))
-    expect_equal(x$r_version, "1.1.1")    
+    expect_equal(x$r_version, "1.1.1")
     expect_true(length(warns) == 2)
     expect_true(any(grepl("^Some package", warns)))
     expect_true(any(grepl("^No packages to query", warns)))
@@ -140,3 +140,10 @@ test_that("Non-cran must enforce caching ref #22", {
 ##     expect_warning(x <- resolve("devtools", os = "ubuntu-18.04"))
 ##     expect_warning(x <- resolve("devtools", os = "ubuntu-20.04"), NA)
 ## })
+
+test_that("Integration of as_pkgrefs() in resolve() for sessionInfo()", {
+    x <- resolve(c("cran::sna"), snapshot_date = "2020-05-01", query_sysreqs = FALSE)
+    si <- readRDS("../testdata/sessionInfo2.RDS")
+    expect_error(graph <- resolve(si, snapshot_date = "2020-05-01", query_sysreqs = FALSE), NA)
+    expect_equal(graph$ranglets[["cran::sna"]], x$ranglets[["cran::sna"]])
+})