make deadline optional

DESCRIPTION

@@ -30,7 +30,8 @@ Suggests:
     knitr,
     progress,
     rmarkdown,
-    testthat
+    testthat,
+    withr
 VignetteBuilder: 
     knitr
 Config/testthat/edition: 3

NEWS.md

@@ -2,9 +2,12 @@
 
 ## New Features
 
-* The output of `cran_results()` and `summary_cran_results()` now include the
-  deadline fixed by CRAN. This deadline is the date by which requested changes
-  need to be implemented before the package gets archived.
+* The output of `cran_results()` and `summary_cran_results()` can now include
+  the deadline fixed by CRAN. This deadline is the date by which requested
+  changes need to be implemented before the package gets archived. By default,
+  this is turned off. To see any deadline that might have been set by CRAN
+  Maintainers, set the `include_deadline` argument to `TRUE`. The value for this
+  argument can also be set using the local option `foghorn_include_deadline`.
 * The `cran_results()` function gains the `max_requests` argument that limits
   the number of requests that are performed against the CRAN website in a single
   query. 

R/cran_results.R

@@ -1,19 +1,25 @@
-cran_results_web <- function(email, pkg, max_requests, ...) {
+cran_results_web <- function(email, pkg, include_deadline, max_requests, ...) {
   res <- NULL
   check_n_requests(email, pkg, max_requests = max_requests)
   if (!is.null(email)) {
     res_email <- read_cran_web_from_email(email, ...)
     res <- cran_checks_table(res_email)
     res <- add_other_issues(res, res_email)
-    to_fix <- fix_before_pkg_web(pkg_with_issues(res), max_requests = max_requests)
-    res <- add_fix_before(res, to_fix)
-
-}
+    to_fix <- deadline_pkg_web(
+      pkg_with_issues(res),
+      include_deadline = include_deadline,
+      max_requests = max_requests
+    )
+    res <- add_deadline(res, to_fix)
+  }
   if (!is.null(pkg)) {
     res_pkg <- read_cran_web_from_pkg(pkg, ...)
     tbl_pkg <- cran_checks_table(res_pkg)
     res_pkg <- add_other_issues(tbl_pkg, res_pkg)
-    res_pkg <- add_fix_before(res_pkg, fix_before_pkg_web(pkg, max_requests = max_requests))
+    res_pkg <- add_deadline(
+      res_pkg,
+      deadline_pkg_web(pkg, include_deadline = include_deadline, max_requests = max_requests)
+    )
     res <- rbind(res, res_pkg)
   }
   res
@@ -26,13 +32,13 @@ cran_results_crandb <- function(email, pkg, ...) {
     res_email <- read_crandb_from_email(email, ...)
     res <- cran_checks_table(res_email)
     res <- add_other_issues_crandb(res)
-    res <- add_fix_before(res, fix_before_email_crandb(email))
+    res <- add_deadline(res, deadline_email_crandb(email))
   }
   if (!is.null(pkg)) {
     res_pkg <- read_crandb_from_pkg(pkg, ...)
     tbl_pkg <- cran_checks_table(res_pkg)
     res_pkg <- add_other_issues_crandb(tbl_pkg)
-    res_pkg <- add_fix_before(res_pkg, fix_before_pkg_crandb(pkg))
+    res_pkg <- add_deadline(res_pkg, deadline_pkg_crandb(pkg))
     res <- rbind(res_pkg, res)
   }
   res
@@ -54,27 +60,35 @@ cran_results_crandb <- function(email, pkg, ...) {
 ##' @param pkg package names (character vector)
 ##' @param show columns of the data frame to show (all are shown by default)
 ##' @template src
+##' @param include_deadline if `TRUE`, the output will display the deadline set
+##'   by CRAN to fix the check results before the package gets archived. (See
+##'   Details).
 ##' @param max_requests maximum number of requests allowed to be performed,
 ##'   ignored when using `src = "crandb"`. Use `Inf` to skip this check. (See
-##'   Details)
+##'   Details).
 ##' @template dots
 ##' @template details
 ##' @return a data frame that tabulates the number of CRAN flavors that return
-##'   errors, warnings, notes, or OK for the packages.
+##'   errors, warnings, notes, or OK for the packages. See 'Details' section for
+##'   more information about the `Deadline` column.
 ##' @examples
 ##'   \dontrun{
 ##'     cran_results(pkg="MASS")
 ##'   }
 cran_results <- function(email = NULL, pkg = NULL,
                          show = c("error", "fail", "warn", "note", "ok"),
                          src = c("website", "crandb"),
+                         include_deadline = getOption("foghorn_include_deadline", TRUE),
                          max_requests = 50, ...) {
+
   show <- tolower(show)
   show <- match.arg(show, several.ok = TRUE)
-  show <- c("package", show, "has_other_issues", "fix_before")
+  show <- c("package", show, "has_other_issues", "deadline")
 
   src <- match.arg(src, c("website", "crandb"))
 
+  stopifnot(rlang::is_scalar_logical(include_deadline) && !is.na(include_deadline))
+
   if (is.null(email) && is.null(pkg)) {
     stop(
       "You need to provide at least one value for ", sQuote("email"),
@@ -83,7 +97,13 @@ cran_results <- function(email = NULL, pkg = NULL,
   }
 
   if (identical(src, "website")) {
-    res <- cran_results_web(email, pkg, max_requests = max_requests, ...)
+    res <- cran_results_web(
+      email,
+      pkg,
+      include_deadline = include_deadline,
+      max_requests = max_requests,
+      ...
+    )
   } else if (identical(src, "crandb")) {
     res <- cran_results_crandb(email, pkg, ...)
   }

R/fix_before.R

@@ -32,43 +32,56 @@ read_pkg_pages <- function(pkg) {
   res
 }
 
-extract_fix_before <- function(parsed, ...)  {
-  lapply(parsed, function(x) {
+extract_deadline <- function(parsed, ...)  {
+  vapply(parsed, function(x) {
     needs_fix <- xml2::xml_find_all(x, ".//tr//td//span[@style]")
     needs_fix <- xml2::xml_text(needs_fix)
     if (identical(length(needs_fix), 0L)) {
-      return(NA_character_)
+      return(character(1))
     }
     if (!grepl("issues need fixing before", needs_fix)) {
-      warning("Unrecognized value: ", needs_fix)
-      return(NA_character_)
+      warning("Unrecognized value: ", needs_fix, call. = FALSE)
+      return(character(1))
     }
     date_match <- regexpr("\\d{4}-\\d{2}-\\d{2}", needs_fix)
     regmatches(needs_fix, date_match)
-  })
+  }, character(1))
 }
 
-fix_before_pkg_web <- function(pkg, max_requests) {
+deadline_pkg_web <- function(pkg, include_deadline, max_requests) {
+  if (!include_deadline) {
+    return(
+      tibble(
+        package = pkg,
+        deadline = rep(NA_character_, length(pkg))
+      )
+    )
+  }
   check_n_requests(pkg, max_requests = max_requests)
   res <- read_pkg_pages(pkg)
-  res <- extract_fix_before(res)
+  res <- extract_deadline(res)
   res <- .mapply(function(.pkg, .res) {
-    tibble(
+    tibble::tibble(
       package = .pkg,
-      fix_before = .res
+      deadline = .res
     )
   }, list(pkg, res), NULL)
-  Reduce(rbind, res)
+  do.call("rbind", res)
 }
 
 ##' @importFrom tibble tibble
-fix_before_pkg_crandb <- function(pkg, ...) {
+deadline_pkg_crandb <- function(pkg, ...) {
   pkgs <- as.data.frame(get_cran_rds_file("packages", ...), stringsAsFactors = FALSE)
   res <- pkgs[pkgs$Package %in% pkg, c("Package", "Deadline")]
 
+  ## we overwrite CRAN's content to match foghorn's logic
+  ## NA means that we didn't check if there is a deadline when using the website data;
+  ## "" means that we checked and there is no deadline set.
+  res$Deadline[is.na(res$Deadline)] <- ""
+
   tibble::tibble(
     package = res$Package,
-    fix_before = res$Deadline
+    deadline = res$Deadline
   )
 }
 
@@ -80,7 +93,7 @@ check_no_email_match <- function(idx, email) {
 }
 
 ##' @importFrom tibble tibble
-fix_before_email_crandb <- function(email, ...) {
+deadline_email_crandb <- function(email, ...) {
   pkgs <- as.data.frame(get_cran_rds_file("packages", ...), stringsAsFactors = FALSE)
   maintainer <- tolower(pkgs$Maintainer)
   idx <- lapply(tolower(email), function(x) {
@@ -93,10 +106,10 @@ fix_before_email_crandb <- function(email, ...) {
   res <- pkgs[as.logical(idx), c("Package", "Deadline")]
   tibble::tibble(
     package = res$Package,
-    fix_before = res$Deadline
+    deadline = res$Deadline
   )
 }
 
-add_fix_before <- function(res, fix) {
-  tibble::as_tibble(merge(res, fix, by = "package"))
+add_deadline <- function(res, fix) {
+  tibble::as_tibble(merge(res, fix, by = "package", all = TRUE))
 }

R/foghorn.R

@@ -238,12 +238,12 @@ get_pkg_with_results <- function(tbl_pkg,
       sptr <- c("  - ", "\n")
     }
     cond <- !is.na(tbl_pkg[[what]]) & tbl_pkg[[what]] > 0
-    fix_before_date <- tbl_pkg$fix_before[cond]
-    fix_before_date[is.na(fix_before_date)] <- ""
-    fix_before_date <- ifelse(nzchar(fix_before_date), paste0(" [Fix before: ", fix_before_date, "]"), "")
+    deadline_date <- tbl_pkg$deadline[cond]
+    deadline_date[is.na(deadline_date)] <- ""
+    deadline_date <- ifelse(nzchar(deadline_date), paste0(" [Fix before: ", deadline_date, "]"), "")
     res <- paste0(sptr[1], tbl_pkg$package[cond],
       n,
-      fix_before_date,
+      deadline_date,
       collapse = sptr[2]
     )
   } else {

R/zzz.R

@@ -0,0 +1,10 @@
+.onLoad <- function(libname, pkgname) {
+  opts <- options()
+  opts_foghorn <- list(
+    foghorn_include_deadline = TRUE
+  )
+  toset <- !(names(opts_foghorn) %in% names(opts))
+  if (any(toset)) options(opts_foghorn[toset])
+
+  invisible()
+}

man-roxygen/details.R

@@ -18,6 +18,20 @@
 ##' number of requests that will be performed and there will be situations where
 ##' more requests than this limit will be performed to retrieve the results.
 ##'
+##' The `deadline` column contains the date set by CRAN to fix issues with the
+##' CRAN checks before the package gets archived. To limit the number of
+##' requests to the CRAN mirror, the existence of a deadline is checked only for
+##' packages where issues have been detected. If the dealine is not checked
+##' (either because the argument `include_deadline` is set to `FALSE`, or
+##' because there is no issues detected with the CRAN checks), the content of
+##' the `deadline` column for the package will be set to `NA`. If the existence
+##' of a deadline has been checked but no date has been set by the CRAN
+##' Maintainers, the `deadline` column for the pacakge will be set to `""`. If
+##' there is a deadline, the content will be a date stored as `character`.
+##'
+##' The value of the argument `include_deadline` can be set using the
+##' local option `foghorn_include_deadline`.
+##'
 ##' When choosing `src = "crandb"` you can also specify the
 ##' following options:
 ##'