Fix #68

gesistsa · Feb 23, 2023 · b460ef3 · b460ef3
1 parent d2a3f12
commit b460ef3
Show file tree

Hide file tree

Showing 4 changed files with 58 additions and 55 deletions.
diff --git a/R/memo_misc.R b/R/memo_misc.R
@@ -13,62 +13,54 @@ NULL
 
 .memo_rver <- memoise::memoise(.rver, cache = cachem::cache_mem(max_age = 120 * 60))
 
-.biocver <- function(){
+.biocver <- function() {
     url <- "https://bioconductor.org/config.yaml"
     tag <- "release_dates"
     txt <- readLines(url)
     grps <- grep("^[^[:blank:]]", txt)
-
     start <- match(grep(tag, txt), grps)
     end <- ifelse(length(grps) < start + 1, length(txt), grps[start + 1] - 1)
     map <- txt[seq(grps[start] + 1, end)]
     map <- trimws(gsub("\"", "", sub(" #.*", "", map)))
     pattern <- "(.*): (.*)"
     bioc_ver <- sub(pattern, "\\1", map)
     bioc_date <- anytime::anytime(sub(pattern, "\\2", map), tz = "UTC", asUTC = TRUE)
-    data.frame(version = bioc_ver,date=bioc_date)
+    data.frame(version = bioc_ver, date=bioc_date)
 }
 
 .memo_biocver <- memoise::memoise(.biocver, cache = cachem::cache_mem(max_age = 120 * 60))
 
-
-.bioc_package_history <- function(bioc_version){
-    if(bioc_version>="2.0"){
-        con <- url(paste0("http://bioconductor.org/packages/",bioc_version,"/bioc/VIEWS"))
-        pkgs <- read.dcf(con)
-        close(con)
-    } else{
-        stop("Bioconductor versions <2.0 are not supported")
+.bioc_package_history <- function(bioc_version) {
+    if (bioc_version != "release" && utils::compareVersion(bioc_version, "2.0") == -1) {
+        stop("Bioconductor versions < 2.0 are not supported.", call. = FALSE)
     }
+    con <- url(paste0("http://bioconductor.org/packages/", bioc_version, "/bioc/VIEWS"))
+    pkgs <- read.dcf(con)
+    close(con)
     as.data.frame(pkgs)
 }
 
-.memo_search_bioc <- memoise::memoise(.bioc_package_history, cache = cachem::cache_mem(max_age = 60 * 60)) 
+.memo_search_bioc <- memoise::memoise(.bioc_package_history, cache = cachem::cache_mem(max_age = 60 * 60))
 
-.query_sysreqs_rhub <- function(){
-  jsonlite::fromJSON("https://sysreqs.r-hub.io/list")
+.query_sysreqs_rhub <- function() {
+    jsonlite::fromJSON("https://sysreqs.r-hub.io/list")
 }
 
 .memo_query_sysreqs_rhub <- memoise::memoise(.query_sysreqs_rhub,cache = cachem::cache_mem(max_age = 60 * 60))
+
 ## internal data generation
 ## ---
+### Supported OS Versions
 ## os <- names(remotes:::supported_os_versions())
 ## supported_os <- unlist(mapply(function(x, y) paste(x,"-", y, sep = ""), os, remotes:::supported_os_versions()))
 ## names(supported_os) <- NULL
+### R version history
 ## cached_rver <- .rver()
 ## attr(cached_rver, "newest_date") <- anytime::anytime(tail(cached_rver, n = 1)$date, tz = "UTC", asUTC = TRUE)
-## usethis::use_data(supported_os, cached_rver, internal = TRUE, overwrite = TRUE)
-
-##library(rvest)
-##doc <- read_html("https://www.bioconductor.org/about/release-announcements/")
-##cached_biocver <- html_table(doc)[[1]]
-##cached_biocver$Date <- anytime::anytime(cached_biocver$Date, tz = "UTC", asUTC = TRUE)
-##cached_biocver$`Software packages` <- NULL
-##names(cached_biocver) <- c("version","date","rver")
-##cached_biocver <- cached_biocver[order(cached_biocver$date),]
-##cached_biocver <- as.data.frame(cached_biocver)
-
-
+### Bioconductor version history
+## cached_biocver <- .biocver()
+## attr(cached_biocver, "newest_date") <- max(cached_biocver$date)
+## usethis::use_data(supported_os, cached_rver, cached_biocver, internal = TRUE, overwrite = TRUE)
 
 ## test data upgrade
 ## ---

diff --git a/R/resolve.R b/R/resolve.R
@@ -8,14 +8,14 @@
     utils::tail(allvers[allvers$date < snapshot_date,], 1)$version
 }
 
-.query_biocver <- function(snapshot_date){
-  if (snapshot_date < attr(cached_biocver, "newest_date")) {
-    allvers <- cached_biocver
-  } else {
-    allvers <- .memo_biocver()
-  }
-  allvers$date <- anytime::anytime(allvers$date, tz = "UTC", asUTC = TRUE)
-  utils::tail(allvers[allvers$date < snapshot_date,], 1)[,1:2]
+.query_biocver <- function(snapshot_date) {
+    if (snapshot_date < attr(cached_biocver, "newest_date")) {
+        allvers <- cached_biocver
+    } else {
+        allvers <- .memo_biocver()
+    }
+    allvers$date <- anytime::anytime(allvers$date, tz = "UTC", asUTC = TRUE)
+    utils::tail(allvers[allvers$date < snapshot_date,], 1)[,1:2]
 }
 
 ## .msysreps <- memoise::memoise(.raw_sysreqs, cache = cachem::cache_mem(max_age = 60 * 60))

diff --git a/R/sysdata.rda b/R/sysdata.rda
diff --git a/tests/testthat/test_resolve.R b/tests/testthat/test_resolve.R
@@ -149,27 +149,38 @@ test_that("Integration of as_pkgrefs() in resolve() for sessionInfo()", {
 })
 
 test_that("resolving packages from bioconductor", {
-  skip_if_offline()
-  skip_on_cran()
-  expect_silent(x <- resolve("BiocGenerics", snapshot_date = "2022-10-20", query_bioc = TRUE))
-  expect_equal(x$unresolved_pkgrefs, character(0))
-  expect_equal(x$sysreqs, character(0))
-  expect_equal(x$r_version, "4.2.1")
+    skip_if_offline()
+    skip_on_cran()
+    expect_silent(x <- resolve("BiocGenerics", snapshot_date = "2022-10-20", query_bioc = TRUE))
+    expect_equal(x$unresolved_pkgrefs, character(0))
+    expect_equal(x$sysreqs, character(0))
+    expect_equal(x$r_version, "4.2.1")
 })
 
 test_that("cache bioc pkgs", {
-  skip_if_offline()
-  skip_on_cran()
-  rang_bioc <- readRDS("../testdata/rang_bioc.RDS")
-  temp_dir <- .generate_temp_dir()
-  dockerize(rang_bioc, output_dir = temp_dir) ## cache = FALSE
-  x <- readLines(file.path(temp_dir, "Dockerfile"))
-  expect_false(any(grepl("^COPY cache", x)))
-  expect_false(dir.exists(file.path(temp_dir, "cache")))
-  expect_false(file.exists(file.path(temp_dir, "cache", "BiocGenerics_0.44.0.tar.gz")))
-  expect_silent(dockerize(rang_bioc, output_dir = temp_dir, cache = TRUE, verbose = FALSE))
-  x <- readLines(file.path(temp_dir, "Dockerfile"))
-  expect_true(any(grepl("^COPY cache", x)))
-  expect_true(dir.exists(file.path(temp_dir, "cache")))
-  expect_true(file.exists(file.path(temp_dir, "cache", "BiocGenerics_0.44.0.tar.gz")))
-})
+    skip_if_offline()
+    skip_on_cran()
+    rang_bioc <- readRDS("../testdata/rang_bioc.RDS")
+    temp_dir <- .generate_temp_dir()
+    dockerize(rang_bioc, output_dir = temp_dir) ## cache = FALSE
+    x <- readLines(file.path(temp_dir, "Dockerfile"))
+    expect_false(any(grepl("^COPY cache", x)))
+    expect_false(dir.exists(file.path(temp_dir, "cache")))
+    expect_false(file.exists(file.path(temp_dir, "cache", "BiocGenerics_0.44.0.tar.gz")))
+    expect_silent(dockerize(rang_bioc, output_dir = temp_dir, cache = TRUE, verbose = FALSE))
+    x <- readLines(file.path(temp_dir, "Dockerfile"))
+    expect_true(any(grepl("^COPY cache", x)))
+    expect_true(dir.exists(file.path(temp_dir, "cache")))
+    expect_true(file.exists(file.path(temp_dir, "cache", "BiocGenerics_0.44.0.tar.gz")))
+})
+
+test_that("issue 68, correct querying of bioc packages from major releases", {
+    skip_if_offline()
+    skip_on_cran()
+    expect_equal(.query_biocver("2007-04-27")$version, "2.0")
+    expect_false(is.numeric(.query_biocver("2007-04-27")$version))
+    expect_error(.query_snapshot_dependencies_bioc("affy", "2014-10-15"), NA)
+    expect_error(.query_snapshot_dependencies_bioc("affy", "2014-10-15"), NA)
+    expect_equal(length(resolve("bioc::affy", snapshot_date = "2007-04-27")$ranglets), 1)
+    expect_equal(length(resolve("bioc::affy", snapshot_date = "2014-10-15")$ranglets), 1)
+})