memoise_bioc_available(): query all Bioconductor repositories, not just BioCsoft

NEWS.md

@@ -1,5 +1,35 @@
 # riskmetric (development version)
 
+- `memoise_bioc_available()` now queries every Bioconductor repository
+  advertised by `BiocManager::repositories()` (BioCsoft, BioCann, BioCexp,
+  BioCworkflows, BioCbooks) instead of only the software repository, so
+  packages hosted in the annotation, experiment, workflow and books
+  repositories (~1,400 additional packages in Bioc 3.22) are now recognised
+  by `pkg_bioc()` / `pkg_ref()`. `pkg_bioc()` also now records the actual
+  repository the package resolves from rather than hard-coding the
+  software repository URL.
+- `bioc_repositories()` now falls through to `options("repos")` — matching
+  either on a `BioC*` name prefix or on a URL containing `bioconductor`
+  / `/bioc/` — after checking `BiocManager::repositories()`, and accepts
+  an explicit override via `options("riskmetric.bioc_repos")` or
+  `Sys.setenv(RISKMETRIC_BIOC_REPOS = ...)`. This makes the resolver
+  work on internal Posit Package Manager mirrors where the BioC
+  snapshot is only surfaced through `options("repos")` (e.g. alongside
+  a CRAN entry) and not through `BiocManager::repositories()`.
+- `is_available_cran()` now excludes packages that are also present in
+  `memoise_bioc_available()`, so `verify_pkg_source()` dispatch falls
+  through to `is_available_bioc()` for Bioconductor packages that
+  happen to be advertised in a `options("repos")` entry the CRAN
+  check would otherwise scan first. Fixes `pkg_ref("BiocGenerics")`
+  being classified as `pkg_cran_remote` when both a CRAN and a BioC
+  repository are configured — which in turn broke downstream
+  BioC-specific cache methods (`has_examples`, `remote_checks`, ...).
+- `assess_dependencies.pkg_bioc_remote()` now queries all Bioconductor
+  repositories (previously only the first entry of
+  `BiocManager::repositories()`), so dependency lookups succeed for
+  annotation, experiment, workflow and books packages.
+
+
 # riskmetric 0.2.6
 
 - Update to address new failing tests responding to `devtools` v2.4.7 changes.

R/assess_dependencies.R

@@ -62,7 +62,9 @@ assess_dependencies.pkg_cran_remote <- function(x, ...){
 #' @export
 assess_dependencies.pkg_bioc_remote <- function(x, ...){
   pkg_metric_eval(class = "pkg_metric_dependencies", {
-    get_package_dependencies(x$name, BiocManager::repositories()[1])
+    bioc_repos <- bioc_repositories()
+    if (length(bioc_repos) == 0L) bioc_repos <- BiocManager::repositories()[1]
+    get_package_dependencies(x$name, repo = bioc_repos)
   })
 }
 

R/pkg_ref_class.R

@@ -210,10 +210,16 @@ pkg_bioc <- function(x) {
   bp <- memoise_bioc_available()
   info <- bp[bp[, "Package"] == x, , drop = FALSE]
 
+  repo <- if ("Repository" %in% colnames(info) && nrow(info) > 0L) {
+    sub("/src/contrib$", "", info[, "Repository"][1])
+  } else {
+    "https://bioconductor.org/packages/release/bioc"
+  }
+
   new_pkg_ref(
     x,
     version = info[, "Version"],
-    repo = "https://bioconductor.org/packages/release/bioc",
+    repo = repo,
     source = c("pkg_bioc_remote")
   )
 }

R/utils.R

@@ -322,6 +322,20 @@ with.pkg_ref <- function(data, expr, ...) {
 
 
 is_available_cran <- function(x, repos, p) {
+  # A package that appears in memoise_bioc_available() is a Bioconductor
+  # package. Even if it also shows up in memoise_available_packages()
+  # (which happens whenever options("repos") advertises both a CRAN and a
+  # BioC entry -- the standard PPM setup), we want verify_pkg_source()'s
+  # dispatch to fall through to is_available_bioc() so the reference is
+  # classified as pkg_bioc_remote rather than pkg_cran_remote. Otherwise
+  # every downstream BioC-only cache method (has_examples, remote_checks,
+  # ...) either errors with "no applicable method" or scrapes the wrong
+  # HTML endpoint.
+  in_bioc <- tryCatch(
+    x %in% memoise_bioc_available()[, "Package"],
+    error = function(e) FALSE
+  )
+  if (isTRUE(in_bioc)) return(FALSE)
   x %in% memoise_available_packages(repos = repos)[,"Package"] ||
     (!is.null(memoise_cran_mirrors()) &&
        # isTRUE added to catch any issues where the cran mirror isn't available

R/utils_memoised.R

@@ -31,18 +31,124 @@ memoise_cran_mirrors <- memoise::memoise({
 
 
 
-#' @importFrom BiocManager available
+#' Fetch the set of packages available across all Bioconductor repositories
+#'
+#' Previously only the "BioCsoft" repository
+#' (\code{https://bioconductor.org/packages/release/bioc}) was queried, which
+#' silently excluded ~1,400 packages hosted in the annotation, experiment,
+#' workflow and books repositories for a given Bioconductor release. This
+#' function now consults every repository advertised by
+#' \code{BiocManager::repositories()} whose name starts with \code{"BioC"}.
+#'
+#' @param repos a named character vector of Bioconductor repository URLs,
+#'   defaulting to the \code{BioC*} entries of \code{BiocManager::repositories()}.
+#'   Users pointing at an internal / mirrored Bioconductor can override this by
+#'   setting \code{options(repos = ...)} so \code{BiocManager::repositories()}
+#'   returns the mirrored URLs.
+#' @param ... additional arguments forwarded to \code{utils::available.packages()}.
+#' @param .local an optional local directory to source a mocked Bioconductor
+#'   package index from, defaulting to \code{getOption("riskmetric.tests")}.
+#'   Used for isolating repository requests during testing.
+#'
+#' @return a data frame with at least \code{Package}, \code{Version} and
+#'   \code{Repository} columns, combining the results from every Bioconductor
+#'   repository queried. Duplicates (a package appearing in more than one
+#'   repository) are resolved to the first occurrence.
+#'
+#' @importFrom BiocManager repositories
 #' @importFrom memoise memoise
 #' @keywords internal
 memoise_bioc_available <- memoise::memoise({
-  function() {
-    con <- url("https://bioconductor.org/packages/release/bioc/src/contrib/PACKAGES")
-    on.exit(close(con))
-    as.data.frame(read.dcf(con), stringsAsFactors = FALSE)
+  function(repos = bioc_repositories(), ...,
+           .local = getOption("riskmetric.tests")) {
+    if (!is.null(.local)) {
+      db <- read.csv(
+        file.path(.local, "test_webmocks", "data", "bioc_packages.csv"),
+        stringsAsFactors = FALSE)
+      if (!"Repository" %in% names(db)) {
+        db[["Repository"]] <- paste0(
+          "https://bioconductor.org/packages/release/bioc", "/src/contrib")
+      }
+      return(db)
+    }
+
+    if (is.null(repos) || length(repos) == 0L) {
+      return(data.frame(
+        Package = character(0), Version = character(0),
+        Repository = character(0), stringsAsFactors = FALSE))
+    }
+
+    ap <- tryCatch(
+      utils::available.packages(repos = repos, ...),
+      error = function(e) NULL)
+
+    if (is.null(ap) || nrow(ap) == 0L) {
+      return(data.frame(
+        Package = character(0), Version = character(0),
+        Repository = character(0), stringsAsFactors = FALSE))
+    }
+
+    df <- as.data.frame(ap, stringsAsFactors = FALSE)
+    df[!duplicated(df[["Package"]]), , drop = FALSE]
   }
 })
 
 
+#' Return the set of Bioconductor repository URLs to query
+#'
+#' Resolves the list of Bioconductor repository URLs to hand to
+#' \code{utils::available.packages()}, in order of specificity:
+#'
+#' \enumerate{
+#'   \item \code{options("riskmetric.bioc_repos")} — explicit override
+#'         (named \code{character} or single URL).
+#'   \item \code{Sys.getenv("RISKMETRIC_BIOC_REPOS")} — comma-separated
+#'         URLs, useful in air-gapped batch runs.
+#'   \item \code{BiocManager::repositories()} entries whose names begin
+#'         \code{"BioC"} (the public-network default: \code{BioCsoft},
+#'         \code{BioCann}, \code{BioCexp}, \code{BioCworkflows},
+#'         \code{BioCbooks}).
+#'   \item \code{options("repos")} entries whose name begins \code{"BioC"}
+#'         \emph{or} whose URL contains \code{bioconductor} / \code{/bioc/}
+#'         (case-insensitive). This covers PPM-style setups where the
+#'         BioC snapshot is exposed via \code{options("repos")} alongside
+#'         a CRAN entry, without being named \code{BioCsoft}.
+#' }
+#'
+#' Any non-BioC entries (e.g. \code{CRAN}) are dropped so
+#' \code{utils::available.packages()} isn't asked to fold CRAN into the
+#' Bioconductor index.
+#'
+#' @return a named character vector of repository URLs, possibly empty if
+#'   no Bioconductor repository can be identified.
+#' @keywords internal
+bioc_repositories <- function() {
+  opt <- getOption("riskmetric.bioc_repos", NULL)
+  if (length(opt)) return(opt)
+  env <- Sys.getenv("RISKMETRIC_BIOC_REPOS", unset = "")
+  if (nzchar(env)) return(trimws(strsplit(env, ",", fixed = TRUE)[[1]]))
+  repos <- tryCatch(BiocManager::repositories(), error = function(e) NULL)
+  if (length(repos)) {
+    nms <- names(repos)
+    if (!is.null(nms)) {
+      hits <- repos[startsWith(nms, "BioC")]
+      if (length(hits)) return(hits)
+    }
+  }
+  all_repos <- getOption("repos", character())
+  if (length(all_repos)) {
+    nms <- names(all_repos)
+    if (is.null(nms)) nms <- rep("", length(all_repos))
+    match_name <- startsWith(nms, "BioC")
+    match_url  <- grepl("bioconductor|/bioc(/|$)",
+                        all_repos, ignore.case = TRUE)
+    hits <- all_repos[match_name | match_url]
+    if (length(hits)) return(hits)
+  }
+  character(0)
+}
+
+
 
 #' Fetch BioC Mirrors Info
 #'

tests/testthat/test_memoise_bioc_available.R

@@ -0,0 +1,153 @@
+test_that("bioc_repositories() filters BiocManager::repositories() to BioC entries", {
+  fake_repos <- c(
+    BioCsoft      = "http://example.com/bioc",
+    BioCann       = "http://example.com/data/annotation",
+    BioCexp       = "http://example.com/data/experiment",
+    BioCworkflows = "http://example.com/workflows",
+    BioCbooks     = "http://example.com/books",
+    CRAN          = "http://example.com/cran"
+  )
+
+  with_mocked_bindings(
+    repositories = function(...) fake_repos,
+    .package = "BiocManager",
+    {
+      out <- bioc_repositories()
+      expect_named(out, c("BioCsoft", "BioCann", "BioCexp",
+                          "BioCworkflows", "BioCbooks"))
+      expect_false("CRAN" %in% names(out))
+    }
+  )
+})
+
+test_that("bioc_repositories() returns character(0) when BiocManager errors", {
+  with_mocked_bindings(
+    repositories = function(...) stop("no network"),
+    .package = "BiocManager",
+    {
+      expect_identical(bioc_repositories(), character(0))
+    }
+  )
+})
+
+test_that("memoise_bioc_available() combines all BioC repositories", {
+  memoise::forget(memoise_bioc_available)
+
+  fake_repos <- c(
+    BioCsoft = "http://example.com/bioc",
+    BioCann  = "http://example.com/data/annotation",
+    BioCexp  = "http://example.com/data/experiment"
+  )
+
+  fake_ap <- rbind(
+    c(Package = "SoftPkg", Version = "1.0",
+      Repository = "http://example.com/bioc/src/contrib"),
+    c(Package = "AnnPkg",  Version = "2.0",
+      Repository = "http://example.com/data/annotation/src/contrib"),
+    c(Package = "ExpPkg",  Version = "3.0",
+      Repository = "http://example.com/data/experiment/src/contrib")
+  )
+
+  with_mocked_bindings(
+    repositories = function(...) fake_repos,
+    .package = "BiocManager",
+    {
+      with_mocked_bindings(
+        available.packages = function(repos = NULL, ...) fake_ap,
+        .package = "utils",
+        {
+          out <- memoise_bioc_available()
+          expect_true(all(c("SoftPkg", "AnnPkg", "ExpPkg") %in% out[["Package"]]))
+          expect_true("Repository" %in% names(out))
+        }
+      )
+    }
+  )
+
+  memoise::forget(memoise_bioc_available)
+})
+
+test_that("memoise_bioc_available() returns an empty frame when no BioC repos exist", {
+  memoise::forget(memoise_bioc_available)
+
+  with_mocked_bindings(
+    repositories = function(...) character(0),
+    .package = "BiocManager",
+    {
+      out <- memoise_bioc_available()
+      expect_s3_class(out, "data.frame")
+      expect_equal(nrow(out), 0L)
+      expect_true(all(c("Package", "Version", "Repository") %in% names(out)))
+    }
+  )
+
+  memoise::forget(memoise_bioc_available)
+})
+
+
+test_that("bioc_repositories() honours the riskmetric.bioc_repos option override", {
+  withr::local_options(
+    riskmetric.bioc_repos = c(BioC = "https://internal.example.com/bioc")
+  )
+  expect_equal(
+    unname(bioc_repositories()),
+    "https://internal.example.com/bioc"
+  )
+})
+
+test_that("bioc_repositories() honours the RISKMETRIC_BIOC_REPOS env var", {
+  withr::local_options(riskmetric.bioc_repos = NULL)
+  withr::local_envvar(
+    RISKMETRIC_BIOC_REPOS = "https://a.example.com/bioc,https://b.example.com/bioc"
+  )
+  expect_equal(
+    bioc_repositories(),
+    c("https://a.example.com/bioc", "https://b.example.com/bioc")
+  )
+})
+
+test_that("bioc_repositories() falls through to options('repos') by URL pattern", {
+  withr::local_options(
+    riskmetric.bioc_repos = NULL,
+    repos = c(
+      CRAN = "https://internal.example.com/cran/latest",
+      PPM_Bioc = "https://internal.example.com/bioconductor-3.22/latest"
+    )
+  )
+  withr::local_envvar(RISKMETRIC_BIOC_REPOS = "")
+  # Force BiocManager::repositories() out of the picture for the test.
+  with_mocked_bindings(
+    repositories = function(...) stop("no BiocManager on this host"),
+    .package = "BiocManager",
+    {
+      res <- bioc_repositories()
+      expect_length(res, 1L)
+      expect_match(res, "bioconductor-3.22")
+    }
+  )
+})
+
+test_that("is_available_cran() vetoes packages known to memoise_bioc_available", {
+  fake_bioc <- data.frame(
+    Package = "BiocGenerics", Version = "0.99.0",
+    Repository = "https://internal.example.com/bioc/src/contrib",
+    stringsAsFactors = FALSE
+  )
+  fake_cran <- matrix(
+    c("BiocGenerics", "0.99.0", "https://internal.example.com/cran"),
+    nrow = 1, byrow = TRUE,
+    dimnames = list(NULL, c("Package", "Version", "Repository"))
+  )
+  with_mocked_bindings(
+    memoise_bioc_available = function() fake_bioc,
+    memoise_available_packages = function(repos = NULL, ...) fake_cran,
+    memoise_cran_mirrors = function() NULL,
+    {
+      expect_false(
+        is_available_cran("BiocGenerics",
+                          repos = c(CRAN = "https://internal.example.com/cran"),
+                          p = list(repo_base_url = NA_character_))
+      )
+    }
+  )
+})