Try untar-listing to check if the format is valid

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: revdepcheck
 Title: Automated Reverse Dependency Checking
-Version: 1.0.0.9001
+Version: 1.0.0.9003
 Authors@R: c(
     person("Gábor", "Csárdi", , "[email protected]", c("cre", "aut", "cph")),
     person("Hadley", "Wickham", role = "aut"),
@@ -30,6 +30,7 @@ Imports:
     httr,
     jsonlite,
     knitr,
+    memoise,
     pkgbuild,
     prettyunits,
     processx (>= 3.3.0),

NAMESPACE

@@ -20,6 +20,7 @@ export(cloud_fetch_results)
 export(cloud_job)
 export(cloud_job_mapping)
 export(cloud_plot)
+export(cloud_problems)
 export(cloud_report)
 export(cloud_report_cran)
 export(cloud_report_failures)
@@ -118,7 +119,6 @@ importFrom(prettyunits,vague_dt)
 importFrom(processx,process)
 importFrom(progress,progress_bar)
 importFrom(rcmdcheck,check_details)
-importFrom(rcmdcheck,compare_checks)
 importFrom(rcmdcheck,rcmdcheck_process)
 importFrom(remotes,bioc_install_repos)
 importFrom(remotes,install_local)

R/cloud.R

@@ -123,14 +123,51 @@ cloud_fetch_results <- function(job_name = cloud_job(pkg = pkg), pkg = ".") {
   cli_progress_done(id = pb)
 
   to_extract <- file.exists(out_files) & !dir.exists(file.path(out_dir, packages))
+  if (!any(to_extract) && cloud_has_results_cache(job_name, pkg)) {
+    return()
+  }
+
+  cloud_write_results_cache(NULL, job_name, pkg)
 
   pb2 <- cli_progress_bar(format = "Extracting package results: {pb_percent}", total = sum(to_extract))
   for (i in which(to_extract)) {
     out_file <- out_files[[i]]
-    utils::untar(out_file, exdir = out_dir)
+    files <- suppressWarnings(utils::untar(out_file, exdir = out_dir, list = TRUE))
+    if (length(files) == 0) {
+      # Retry downloading next time
+      unlink(out_file)
+    } else {
+      utils::untar(out_file, exdir = out_dir)
+    }
     cli_progress_update(id = pb2)
   }
   cli_progress_done(id = pb2)
+
+  results <- cloud_compute_results(job_name, pkg)
+  cloud_write_results_cache(results, job_name, pkg)
+}
+
+cloud_has_results_cache <- function(job_name, pkg) {
+  cloud <- dir_find(pkg, "cloud")
+  path <- file.path(cloud, paste0(job_name, ".rds"))
+  file.exists(path)
+}
+
+cloud_read_results_cache <- function(job_name, pkg) {
+  cloud <- dir_find(pkg, "cloud")
+  path <- file.path(cloud, paste0(job_name, ".rds"))
+  readRDS(path)
+}
+
+cloud_write_results_cache <- function(results, job_name, pkg) {
+  cloud <- dir_find(pkg, "cloud")
+  path <- file.path(cloud, paste0(job_name, ".rds"))
+
+  if (is.null(results)) {
+    unlink(path, force = TRUE)
+  } else {
+    saveRDS(results, path, compress = FALSE)
+  }
 }
 
 #' Submit a reverse dependency checking job to the cloud
@@ -376,9 +413,11 @@ cloud_compare <- function(pkg) {
     res$version <- description$get("Version")[[1]]
     return(res)
   }
-  rcmdcheck::compare_checks(old, new)
+  compare_checks(old, new)
 }
 
+compare_checks <- NULL
+
 #' Display revdep results
 #'
 #' Displays nicely formatted results of processed packages run in the cloud.
@@ -518,9 +557,13 @@ cloud_report_cran <- function(job_name = cloud_job(pkg = pkg), pkg = ".", result
 #' @export
 cloud_results <- function(job_name = cloud_job(pkg = pkg), pkg = ".") {
   pkg <- pkg_check(pkg)
-  cloud <- dir_find(pkg, "cloud")
 
   cloud_fetch_results(job_name, pkg = pkg)
+  cloud_read_results_cache(job_name, pkg)
+}
+
+cloud_compute_results <- function(job_name, pkg) {
+  cloud <- dir_find(pkg, "cloud")
 
   cli_alert_info("Comparing results")
   pkgs <- list.dirs(file.path(cloud, job_name), full.names = TRUE, recursive = FALSE)
@@ -731,6 +774,20 @@ cloud_failed <- function(job_name = cloud_job(pkg = pkg), pkg = ".") {
   unlist(cloud_job_status(job_name, status = "FAILED")$packages)
 }
 
+#' @rdname cloud_broken
+#' @export
+cloud_problems <- function(job_name = cloud_job(pkg = pkg), pkg = ".") {
+  ## We show the packages that are newly broken
+  is_problem <- function(x) {
+    any(x$cmp$change == 1)
+  }
+
+  results <- cloud_results(job_name = job_name, pkg = pkg)
+  problem <- map_lgl(results, is_problem)
+
+  map_chr(results[problem], `[[`, "package")
+}
+
 #' Browse to the AWS url for the job
 #'
 #' This is useful for closer inspection of individual jobs while they are

R/compare.R

@@ -1,6 +1,4 @@
 
-#' @importFrom rcmdcheck compare_checks
-
 try_compare_checks <- function(package, old, new) {
   if (!inherits(old, "rcmdcheck") || !inherits(new, "rcmdcheck")) {
     rcmdcheck_error(package, old, new)

R/zzz.R

@@ -0,0 +1,6 @@
+# nolint start
+.onLoad <- function(libname, pkgname) {
+  # nolint end
+  compare_checks <<- memoise::memoise(rcmdcheck::compare_checks)
+  cloud_check_result <<- memoise::memoise(cloud_check_result)
+}