Merge pull request #56 from insightsengineering/fix_tests

Fix tests

DESCRIPTION

@@ -19,7 +19,7 @@ Imports:
     desc (>= 1.2),
     gh,
     jsonlite,
-    pkgcache (>= 2.1.0),
+    pkgcache (>= 2.2.2.9000),
     pkgdepends (>= 0.5.0),
     rcmdcheck,
     remotes (>= 2.2.0),
@@ -32,6 +32,8 @@ Suggests:
     pingr,
     rmarkdown (>= 2.23),
     testthat (>= 3.0.4)
+Remotes:
+    r-lib/pkgcache
 Config/Needs/verdepcheck:
     r-lib/cli,
     r-lib/desc,

NAMESPACE

@@ -1,5 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(get_avail_date,remote_ref)
+S3method(get_avail_date,remote_ref_cran)
+S3method(get_avail_date,remote_ref_standard)
 S3method(get_ref_min,remote_ref)
 S3method(get_ref_min,remote_ref_cran)
 S3method(get_ref_min,remote_ref_github)
@@ -17,6 +20,7 @@ S3method(solve_ip,min_isolated_deps_installation_proposal)
 export(check_ip)
 export(download_ip)
 export(execute_ip)
+export(get_avail_date)
 export(get_ref_max)
 export(get_ref_min)
 export(get_ref_min_incl_cran)
@@ -53,8 +57,8 @@ importFrom(gh,gh_gql)
 importFrom(jsonlite,fromJSON)
 importFrom(pkgcache,cran_archive_list)
 importFrom(pkgcache,meta_cache_list)
-importFrom(pkgcache,ppm_repo_url)
 importFrom(pkgcache,ppm_snapshots)
+importFrom(pkgcache,repo_resolve)
 importFrom(pkgdepends,as_pkg_dependencies)
 importFrom(pkgdepends,new_pkg_deps)
 importFrom(pkgdepends,new_pkg_installation_proposal)
@@ -65,6 +69,5 @@ importFrom(rcmdcheck,rcmdcheck)
 importFrom(remotes,github_remote)
 importFrom(stats,na.omit)
 importFrom(stats,setNames)
-importFrom(utils,head)
 importFrom(utils,installed.packages)
 importFrom(withr,defer)

R/deps_installation_proposal.R

@@ -197,23 +197,24 @@ new_min_cohort_deps_installation_proposal <- function(path, # nolint
       version <- version_from_desc(d, i_ref$package)
       i_ref_ver <- get_ref_min(i_ref, version$op, version$op_ver)
 
-      get_release_date(i_ref_ver)
+      get_avail_date(i_ref_ver)
     }
   )
 
   # Obtain the maximum release data of all the dependencies
+  deps_release_dates_v <- unlist(lapply(deps_release_dates, as.Date, origin = "1970-01-01"))
+  if (length(deps_release_dates_v) == 1 && is.na(deps_release_dates_v)) {
+    deps_release_dates_v <- Inf
+  }
   max_release_date <- as.Date(
     max(
-      as.Date(-Inf), # Suppress warning when running max() with all NA and `na.rm = TRUE`
-      unlist(
-        lapply(deps_release_dates, as.Date, origin = "1970-01-01")
-      ),
+      deps_release_dates_v,
       na.rm = TRUE
     ),
     origin = "1970-01-01"
   )
 
-  ppm_repo <- get_ppm_snapshot_by_date(max_release_date + 1)
+  ppm_repo <- get_ppm_snapshot_by_date(max_release_date)
 
   config <- append_config(config, list("cran_mirror" = ppm_repo))
 

R/get_ref.R

@@ -15,10 +15,10 @@ get_ref_min_incl_cran <- function(remote_ref, op = "", op_ver = "") {
 
 #' @rdname get_ref_min_incl_cran
 #' @export
-#' @examples
-#' verdepcheck:::get_ref_min_incl_cran(pkgdepends::parse_pkg_ref("bioc::MultiAssayExperiment"))
 #' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
 #' verdepcheck:::get_ref_min_incl_cran(pkgdepends::parse_pkg_ref("dplyr"))
+#' @examples
+#' verdepcheck:::get_ref_min_incl_cran(pkgdepends::parse_pkg_ref("bioc::MultiAssayExperiment"))
 get_ref_min_incl_cran.remote_ref <- function(remote_ref, op = "", op_ver = "") {
   get_ref_min(remote_ref, op, op_ver)
 }
@@ -27,7 +27,7 @@ get_ref_min_incl_cran.remote_ref <- function(remote_ref, op = "", op_ver = "") {
 #' @importFrom pkgdepends parse_pkg_ref
 #' @export
 #' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
-#' verdepcheck:::get_ref_min_incl_cran(pkgdepends::parse_pkg_ref("cran/dplyr"))
+#' verdepcheck:::get_ref_min_incl_cran(pkgdepends::parse_pkg_ref("tidyverse/dplyr"))
 get_ref_min_incl_cran.remote_ref_github <- function(remote_ref, op = "", op_ver = "") {
   if (check_if_on_cran(remote_ref, op = op, op_ver = op_ver)) {
     gh_res <- get_ref_min(remote_ref, op, op_ver)
@@ -53,10 +53,10 @@ get_ref_min_incl_cran.remote_ref_github <- function(remote_ref, op = "", op_ver
 #' @keywords internal
 #'
 #' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
-#' verdepcheck:::check_if_on_cran(list(package = "dplyr"))
-#' verdepcheck:::check_if_on_cran(list(package = "dplyr"), op = ">=", op_ver = "1.1.0")
-#' verdepcheck:::check_if_on_cran(list(package = "dplyr"), op = ">=", op_ver = "9999.9.99")
-#' verdepcheck:::check_if_on_cran(list(package = "dplyr"), op = "<", op_ver = "0.0.0")
+#' verdepcheck:::check_if_on_cran(pkgdepends::parse_pkg_ref("dplyr"))
+#' verdepcheck:::check_if_on_cran(pkgdepends::parse_pkg_ref("dplyr"), op = ">=", op_ver = "1.1.0")
+#' verdepcheck:::check_if_on_cran(pkgdepends::parse_pkg_ref("dplyr"), op = ">=", op_ver = "9999.9.99")
+#' verdepcheck:::check_if_on_cran(pkgdepends::parse_pkg_ref("dplyr"), op = "<", op_ver = "0.0.0")
 check_if_on_cran <- function(remote_ref, op = "", op_ver = "") {
   cran_listings <- pkgcache::meta_cache_list(remote_ref$package)
   if (op == "" || op_ver == "") {
@@ -140,7 +140,7 @@ get_ref_min.remote_ref_standard <- function(remote_ref, op = "", op_ver = "") {
 #' @importFrom pkgdepends parse_pkg_ref
 #'
 #' @examplesIf gh::gh_token() != ""
-#' get_ref_min(pkgdepends::parse_pkg_ref("cran/dplyr"))
+#' get_ref_min(pkgdepends::parse_pkg_ref("tidyverse/dplyr"))
 get_ref_min.remote_ref_github <- function(remote_ref, op = "", op_ver = "") {
   if (remote_ref$commitish != "") {
     return(remote_ref)
@@ -276,7 +276,9 @@ get_desc_from_gh <- function(org, repo, ref = "") {
 #'
 #' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
 #' get_ref_max(pkgdepends::parse_pkg_ref("dplyr"))
+#' get_ref_max(pkgdepends::parse_pkg_ref("cran::dplyr"))
 #' get_ref_max(pkgdepends::parse_pkg_ref("tidyverse/dplyr"))
+#' get_ref_max(pkgdepends::parse_pkg_ref("bioc::MultiAssayExperiment"))
 get_ref_max <- function(remote_ref) {
   get_ref_internal(remote_ref, include_release = FALSE)
 }
@@ -291,7 +293,9 @@ get_ref_max <- function(remote_ref) {
 #'
 #' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
 #' get_ref_release(pkgdepends::parse_pkg_ref("dplyr"))
+#' get_ref_release(pkgdepends::parse_pkg_ref("cran::dplyr"))
 #' get_ref_release(pkgdepends::parse_pkg_ref("tidyverse/dplyr"))
+#' get_ref_release(pkgdepends::parse_pkg_ref("bioc::MultiAssayExperiment"))
 get_ref_release <- function(remote_ref) {
   get_ref_internal(remote_ref, include_input = FALSE)
 }
@@ -404,6 +408,7 @@ get_version <- function(remote_ref) {
 #' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
 #' get_version(pkgdepends::parse_pkg_ref("dplyr"))
 #' get_version(pkgdepends::parse_pkg_ref("tidyverse/dplyr"))
+#' get_version(pkgdepends::parse_pkg_ref("tidyverse/[email protected]"))
 #' get_version(pkgdepends::parse_pkg_ref("bioc::MultiAssayExperiment"))
 get_version.remote_ref <- function(remote_ref) {
   x <- pkgdepends::new_pkg_deps(remote_ref$ref, config = list(dependencies = FALSE))
@@ -462,13 +467,12 @@ get_release_date.remote_ref_github <- function(remote_ref) {
   as.Date(resp$data$repository$object$committedDate)
 }
 
-#' Get release date from GitHub references
-#'
 #' @rdname get_release_date
 #' @export
 #'
 #' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
-#' get_release_date(pkgdepends::parse_pkg_ref("[email protected]"))
+#' get_release_date(pkgdepends::parse_pkg_ref("cran::dplyr"))
+#' get_release_date(pkgdepends::parse_pkg_ref("cran::[email protected]"))
 get_release_date.remote_ref_cran <- function(remote_ref) {
   rel_data <- get_release_data(remote_ref$package)
 
@@ -520,7 +524,7 @@ get_release_date.remote_ref <- function(remote_ref) {
 #' @keywords internal
 #' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
 #' verdepcheck:::get_release_data("dplyr")
-#' verdepcheck:::get_release_data("SummarizedExperiment")
+#' verdepcheck:::get_release_data("MultiAssayExperiment")
 get_release_data <- function(package) {
   cran_archive <- pkgcache::cran_archive_list(packages = package)[, c("package", "version", "mtime")]
   cran_current <- head(
@@ -546,11 +550,15 @@ get_release_data <- function(package) {
         )
       } else if (cran_current$type == "bioc") {
         url <- sprintf(
-          "https://packagemanager.posit.co/__api__/repos/4/packages/%s?bioc_version=%s",
+          "https://packagemanager.posit.co/__api__/repos/bioconductor/packages/%s?bioc_version=%s",
           package,
           pkgcache::bioc_version()
         )
-        release_date <- as.POSIXct(jsonlite::fromJSON(readLines(url, warn = FALSE))$occurred)
+        data <- jsonlite::fromJSON(readLines(url, warn = FALSE))
+        release_date <- as.POSIXct(data$occurred) %||%
+          as.POSIXct(data$package_date) %||%
+          as.POSIXct(data$date_publication) %||%
+          as.POSIXct(NA)
         cran_current <- data.frame(
           type = "bioc",
           package = package,
@@ -567,3 +575,100 @@ get_release_data <- function(package) {
   cran_current <- setNames(cran_current, names(cran_archive))
   rbind(cran_archive, cran_current)
 }
+
+
+#' Get available date for the package.
+#'
+#' Oftentimes, the release date of the package does not correspond to the date when the package is
+#' available in the PPM. Usually it takes one day for the PPM to sync with the CRAN.
+#' This function will return the date when the package is available in the PPM.
+#'
+#' @inheritParams get_ref_min
+#' @param start (`Date`) optional, the date when the package was released
+#' @returns Date. This can be safely used as a snapshot date for the PPM.
+#'
+#' @export
+get_avail_date <- function(remote_ref, start = get_release_date(remote_ref)) {
+  if (is.na(start)) {
+    return(as.Date(NA_real_))
+  }
+  UseMethod("get_avail_date", remote_ref)
+}
+
+#' @rdname get_avail_date
+#'
+#' @importFrom pkgcache ppm_snapshots
+#'
+#' @export
+#'
+#' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
+#' get_avail_date(pkgdepends::parse_pkg_ref("cran::dplyr"))
+#' get_avail_date(pkgdepends::parse_pkg_ref("cran::[email protected]"))
+get_avail_date.remote_ref_cran <- function(remote_ref, start = get_release_date(remote_ref)) {
+  max_iter <- 5
+  i <- 0
+  date <- start
+  while (i <= max_iter) {
+    # there are some gaps in the snapshots so it's important to at first find the closest date
+    ppm_url <- get_ppm_snapshot_by_date(date)
+    date <- `if`(
+      grepl("/latest$", ppm_url),
+      tail(pkgcache::ppm_snapshots(), 1)$date,
+      unname(as.Date(sub(".*/", "", ppm_url)))
+    )
+    if (remote_ref$atleast != "") {
+      data <- available.packages(
+        repos = ppm_url,
+        filters = list(
+          function(db) {
+            db[
+              db[, "Package"] == remote_ref$package &
+                do.call(
+                  # don't use `remote_ref$atleast` and hardcode `>=` instead
+                  # requested version might not be available even in the oldest PPM
+                  # example: `[email protected]` and the oldest PPM has `[email protected]`
+                  ">=",
+                  list(
+                    package_version(db[, "Version"], strict = FALSE),
+                    package_version(remote_ref$version, strict = FALSE)
+                  )
+                ),
+            ]
+          }
+        )
+      )
+    } else {
+      data <- available.packages(
+        repos = ppm_url,
+        filters = list(function(db) db[db[, "Package"] == remote_ref$package, ])
+      )
+    }
+    if (length(data) > 0) {
+      return(date)
+    }
+    date <- date + 1
+    i <- i + 1
+  }
+  warning("No available date found.")
+  as.Date(NA_real_)
+}
+
+#' @rdname get_avail_date
+#' @export
+#'
+#' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
+#' get_avail_date(pkgdepends::parse_pkg_ref("dplyr"))
+#' get_avail_date(pkgdepends::parse_pkg_ref("[email protected]"))
+get_avail_date.remote_ref_standard <- function(remote_ref, start = get_release_date(remote_ref)) {
+  get_avail_date.remote_ref_cran(remote_ref, start = start)
+}
+
+#' @rdname get_avail_date
+#' @export
+#'
+#' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != "" && gh::gh_token() != ""
+#' get_avail_date(pkgdepends::parse_pkg_ref("bioc::MultiAssayExperiment"))
+#' get_avail_date(pkgdepends::parse_pkg_ref("tidyverse/[email protected]"))
+get_avail_date.remote_ref <- function(remote_ref, start = get_release_date(remote_ref)) {
+  start + 1
+}

R/solve.R

@@ -17,7 +17,7 @@ solve_ip.deps_installation_proposal <- function(ip) {
 
 #' Try to solve using min_isolated method. If Error - use [resolve_ignoring_release_remote]
 #'
-#' For each direct dependency, resolve that package using PPM snapshot as of release date + 1.
+#' For each direct dependency, resolve that package using PPM snapshot as of release date.
 #' Finally, combine resolutions and run solve.
 #'
 #' @keywords internal

R/utils.R

@@ -23,33 +23,32 @@ base_pkgs <- function() {
   c("R", rownames(utils::installed.packages(priority = "base")))
 }
 
-#' @importFrom pkgcache ppm_repo_url ppm_snapshots
-#' @importFrom utils head
+#' @importFrom pkgcache ppm_snapshots repo_resolve
 #'
 #' @examplesIf Sys.getenv("R_USER_CACHE_DIR", "") != ""
 #' get_ppm_snapshot_by_date(NA)
 #' get_ppm_snapshot_by_date("2023-08-01")
 #' get_ppm_snapshot_by_date(Sys.Date() + 10)
-get_ppm_snapshot_by_date <- function(date) {
+get_ppm_snapshot_by_date <- function(date = NA) {
+  if (is.na(date)) {
+    return(pkgcache::repo_resolve("PPM@latest"))
+  }
+  if (date >= tail(pkgcache::ppm_snapshots(), 1)$date) {
+    return(pkgcache::repo_resolve("PPM@latest"))
+  }
+  if (date <= head(pkgcache::ppm_snapshots(), 1)$date) {
+    return(pkgcache::repo_resolve(sprintf("PPM@%s", head(pkgcache::ppm_snapshots(), 1)$date)))
+  }
   tryCatch(
-    {
-      # https://github.com/r-lib/pkgcache/issues/110
-      # uncomment this: pkgcache::repo_resolve(sprintf("PPM@%s", as.character(as.Date(date) + 1)))
-      snaps <- pkgcache::ppm_snapshots()
-      date_snap <- as.character(head(snaps[as.Date(snaps$date) > as.Date(date), "date"], 1))
-      if (length(date_snap) == 0) {
-        stop("No PPM snapshot found for the given date.")
-      }
-      file.path(pkgcache::ppm_repo_url(), date_snap)
-      gsub("latest", date_snap, pkgcache::repo_resolve("PPM@latest"))
-    },
+    pkgcache::repo_resolve(sprintf("PPM@%s", as.character(as.Date(date) + 1))),
     error = function(err) {
+      warning("Could not resolve the PPM snapshot by date. Using the latest PPM snapshot.")
       pkgcache::repo_resolve("PPM@latest")
     }
   )
 }
 
-#' Resolve the dependencies of a package based on its release date + 1.
+#' Resolve the dependencies of a package based on its release date.
 #'
 #' @importFrom pkgdepends new_pkg_deps parse_pkg_ref
 #' @keywords internal
@@ -59,8 +58,9 @@ resolve_ppm_snapshot <- function(pkg_ref_str, operator, pkg_version) {
   i_ref_minver <- get_ref_min_incl_cran(i_ref, operator, pkg_version)
 
   i_release_date <- get_release_date(i_ref_minver)
+  i_avail_date <- get_avail_date(i_ref_minver, start = i_release_date)
 
-  ppm_repo <- get_ppm_snapshot_by_date(i_release_date)
+  ppm_repo <- get_ppm_snapshot_by_date(i_avail_date)
 
   i_pkg_deps <- pkgdepends::new_pkg_deps(
     ifelse(

_pkgdown.yml

@@ -36,4 +36,5 @@ reference:
     contents:
       - starts_with("get_ref_")
       - get_release_date
+      - get_avail_date
       - get_version