Detect sprintf() argument mistakes in R (>= 4.1.0)

scan_examples.R

#' Condition Handler Detecting Sprintf Mistakes
#'
#' @param w A condition
#'
#' @param action Should the sprintf mistake be escalated to an error,
#' or should it display the warning and prompt the user?
#'
#' @examples
#' globalCallingHandlers(warning = handle_sprintf_warning)
#'
#' @seealso
#' [base::globalCallingHandlers()]
#' 
#' @export
handle_sprintf_warning <- function(w, action = c("error", "pause")) {
  action <- match.arg(action)
  if (grepl("arguments? not used by format", conditionMessage(w))) {
    if (action == "error") {
      stop(w)
    } else if (action == "pause") {
      message("SPRINTF WARNING: ", sQuote(conditionMessage(w)))
      message("- call: ", deparse(conditionCall(w), width.cutoff = 400L))
      stopifnot(interactive())
      readline(prompt = "Press ENTER to continue: ")
    }
  }
}


#' Scan a Single Package Example with Custom Condition Handlers
#'
#' @param topic,package The topic and package of the example to scan
#'
#' @param ask If FALSE, the examples are run without prompting when
#' opening graphics.
#'
#' @param \ldots Additional arguments passed to [utils::example()].
#'
#' @examples
#' handlers <- list(
#'   warning = function(w) handle_sprintf_warning(w, action = "pause")
#' )
#' scan_example("hpaste", package = "R.utils", handlers = handlers)
#'
#' @importFrom utils example
#' @export
scan_example <- function(topic, package, ask = FALSE, handlers = list(), ...) {
  expr <- quote({
    example(topic = topic, character.only = TRUE,
            package = package, ask = ask, ...)
  })
  args <- c(list(expr), handlers)
  do.call(tryCatch, args = args)
}


#' Scan all Package Examples with Custom Condition Handlers
#'
#' @param package The package whose examples to scan
#'
#' @param ask If FALSE, the examples are run without prompting when
#' opening graphics.
#'
#' @param skip A non-negative integer specifying how many of the
#' examples to skip.
#'
#' @param \ldots Additional arguments passed to [utils::example()].
#'
#' @examples
#'
#' handlers <- list(
#'   warning = function(w) handle_sprintf_warning(w, action = "pause")
#' )
#' scan_examples("R.utils", handlers = handlers)
#'
#' @export
scan_examples <- function(package, skip = 0L, ask = FALSE, ...) {
  library(package, character.only = TRUE)
  rd <- readRDS(system.file(package = package, "Meta", "Rd.rds"))
  topics <- rd[, "Name"]
  for (kk in seq_along(topics)) {
    if (kk < skip) next
    message(sprintf("%d/%d: Scanning example %s",
            kk, length(topics), sQuote(topics[kk])))
    scan_example(topic = topics[kk], package = package, ask = ask, ...)
  }
}


#' @export
sprintf_scan_examples <- function(...) {
  handlers <- list(
    warning = function(w) handle_sprintf_warning(w, action = "pause")
  )
  scan_examples(..., handlers = handlers)
}