Implement github precedence for parsing DESCRIPTION ref #113

gesistsa · Mar 27, 2023 · cb42f9b · cb42f9b
1 parent 53abae2
commit cb42f9b
Show file tree

Hide file tree

Showing 4 changed files with 42 additions and 27 deletions.
diff --git a/R/as_pkgrefs.R b/R/as_pkgrefs.R
@@ -41,8 +41,8 @@ as_pkgrefs.character <- function(x, bioc_version = NULL, ...) {
     if(.is_directory(x)) {
       return(.extract_pkgrefs_dir(x,bioc_version))
     }
-    if(.is_DESCRIPTION(x)){
-        return(.extract_pkgrefs_DESCRIPTION(x))
+    if(.is_DESCRIPTION(x)) {
+        return(.extract_pkgrefs_DESCRIPTION(x, bioc_version))
     }
     return(.normalize_pkgs(pkgs = x, bioc_version = bioc_version))
 }
@@ -91,21 +91,35 @@ as_pkgrefs.sessionInfo <- function(x, ...) {
     return(paste0("cran::", handle))
 }
 
-.extract_pkgrefs_DESCRIPTION <- function(path){
-    descr <- read.dcf(path)
-    types <- colnames(descr)
-    refs <- c()
-    if("Imports"%in%types){
-        imports <- descr[,"Imports"]
-        imports <- strsplit(imports,",[\n]*")[[1]]
-        refs <- c(refs,paste0("cran::",gsub("\\(.*\\)","",imports)))
-    }
-    if("Remotes"%in%types){
-        remotes <- descr[,"Remotes"]
-        remotes <- strsplit(remotes,",[\n]*")[[1]]
-        refs <- c(refs,paste0("github::",gsub("\\(.*\\)","",remotes)))
-    }
-    trimws(refs,"both")
+.extract_pkgrefs_DESCRIPTION <- function(path, bioc_version = NULL) {
+    descr_df <- as.data.frame(read.dcf(path))
+    pkg_dep_df <- .parse_desc(descr_df, remotes = TRUE)
+    if (isFALSE("y" %in% colnames(pkg_dep_df))) {
+        stop("No dependencies listed in the DESCRIPTION file.", call. = FALSE)
+    }
+    pkgrefs <- .normalize_pkgs(pkg_dep_df$y, bioc_version = bioc_version)
+    .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) {
@@ -157,4 +171,3 @@ as_pkgrefs.sessionInfo <- function(x, ...) {
     }
     TRUE
 }
-
diff --git a/R/resolve.R b/R/resolve.R
@@ -150,7 +150,7 @@
 }
 
 # parse a description file from github repo
-.parse_desc <- function(descr_df, snapshot_date) {
+.parse_desc <- function(descr_df, snapshot_date = "2019-08-31", remotes = FALSE) {
     types <- c("Depends","LinkingTo","Imports","Suggests","Enhances")
     depends <- descr_df[["Depends"]]
     imports <- descr_df[["Imports"]]
@@ -162,9 +162,14 @@
     if(!is.null(suggests)) suggests <- trimws(strsplit(suggests, ",[\n]*")[[1]])
     if(!is.null(enhances)) enhances <- trimws(strsplit(enhances, ",[\n]*")[[1]])
     if(!is.null(depends))  depends <- trimws(strsplit(depends, ",[\n]*")[[1]])
-    raw_deps <- list(
-        depends, linking, imports, suggests, enhances
-    )
+    if (isFALSE(remotes)) {
+        raw_deps <- list(depends, linking, imports, suggests, enhances)
+    } else {
+        types <- c(types, "Remotes")
+        remotes <- descr_df[["Remotes"]]
+        if(!is.null(remotes))  remotes <- trimws(strsplit(remotes, ",[\n]*")[[1]])
+        raw_deps <- list(depends, linking, imports, suggests, enhances, remotes)
+    }
     type <- lapply(seq_along(raw_deps), function(x) rep(types[x], length(raw_deps[[x]])))
     version <- vapply(unlist(raw_deps), .extract_version, character(1), USE.NAMES = FALSE)
     deps <- gsub("\\s*\\(.*\\)","",unlist(raw_deps))

diff --git a/tests/testdata/DESCRIPTION → tests/testdata/mzesalike/DESCRIPTION b/tests/testdata/DESCRIPTION → tests/testdata/mzesalike/DESCRIPTION
diff --git a/tests/testthat/test_pkgref.R b/tests/testthat/test_pkgref.R
@@ -141,14 +141,11 @@ test_that("as_pkgrefs directory", {
 
 ## as_pkgrefs.character (DESCRIPTION)
 test_that("as_pkgrefs DESCRIPTION", {
-    res <- suppressWarnings(as_pkgrefs("../testdata/DESCRIPTION",bioc_version = "3.16"))
-    expect_equal(res, c("cran::xaringan", "cran::xaringanExtra", "cran::leaflet", "cran::fontawesome", 
-                        "github::yihui/xaringan", "github::chainsawriot/xaringanExtra", 
+    res <- suppressWarnings(as_pkgrefs("../testdata/mzesalike/DESCRIPTION",bioc_version = "3.16"))
+    expect_equal(res, c("cran::leaflet", "github::yihui/xaringan", "github::chainsawriot/xaringanExtra",
                         "github::rstudio/fontawesome"))
 })
 
-
-
 ## .is_*
 
 test_that(".is_pkgref", {