Add options support

Author: maksymiuks

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: checked
 Title: Systematically Run R CMD Checks
-Version: 0.2.3.9004
+Version: 0.2.3.9005
 Authors@R:
     c(
       person(
@@ -36,6 +36,7 @@ Imports:
     cli,
     igraph,
     jsonlite,
+    options,
     R6,
     rcmdcheck,
     utils (>= 3.6.2),

NAMESPACE

@@ -75,6 +75,7 @@ export(run)
 export(source_check_tasks_df)
 export(task_spec)
 import(cli)
+import(options)
 importFrom(R6,R6Class)
 importFrom(callr,r_process)
 importFrom(cli,make_spinner)

NEWS.md

@@ -21,6 +21,10 @@
 
 * Prettify output by stripping excessive new lines.
 
+* `checked` now depends on `options`
+
+* Expose `...` allowing customization of check subprocesses when creating checks df.
+
 # checked 0.2.3
 
 * Use custom `checked` `finisher`'s instead of the `processx` `finalizer`'s

R/check.R

@@ -19,10 +19,7 @@
 #'   to pull sources for reverse dependencies. In some cases, for instance using
 #'   binaries on Linux, we want to use different repositories when pulling
 #'   sources to check and different when installing dependencies.
-#' @param restore `logical` indicating whether output directory should be
-#'   unlinked before running checks. If `FALSE`, an attempt will me made to
-#'   restore previous progress from the same `output`
-#' @param ... Additional arguments passed to [`run()`]
+#' @param ... Additional arguments passed to [`checked-task-df`] and [`run()`]
 #'
 #' @return
 #'   [`check_design()`] R6 class storing all the details
@@ -48,6 +45,7 @@ NULL
 #' identify changes in reverse dependency behaviors.
 #'
 #' @inheritParams check_functions
+#' @inheritParams options_params
 #' @inheritParams run
 #'
 #' @inherit check_functions return
@@ -61,10 +59,15 @@ check_rev_deps <- function(
     lib.loc = .libPaths(), # nolint object_name_linter
     repos = getOption("repos"),
     reverse_repos = repos,
-    restore = TRUE,
+    restore = options::opt("restore"),
     reporter = reporter_default(),
     ...) {
-  checks <- rev_dep_check_tasks_df(path = path, repos = reverse_repos)
+  
+  checks <- rev_dep_check_tasks_df(
+    path = path,
+    repos = reverse_repos,
+    ...
+  )
 
   plan <- check_design$new(
     checks,
@@ -87,6 +90,7 @@ check_rev_deps <- function(
 #' as a `Suggests` dependency.
 #'
 #' @inheritParams check_functions
+#' @inheritParams options_params
 #' @inheritParams run
 #'
 #' @inherit check_functions return
@@ -99,9 +103,15 @@ check_dev_rev_deps <- function(
     output = tempfile(paste(utils::packageName(), Sys.Date(), sep = "-")),
     lib.loc = .libPaths(), # nolint object_name_linter
     repos = getOption("repos"),
-    restore = TRUE,
+    restore = options::opt("restore"),
     ...) {
-  checks <- rev_dep_check_tasks_df(path = path, repos = repos, versions = "dev")
+  
+  checks <- rev_dep_check_tasks_df(
+    path = path,
+    repos = repos,
+    versions = "dev",
+    ...
+  )
 
   plan <- check_design$new(
     checks,
@@ -123,6 +133,7 @@ check_dev_rev_deps <- function(
 #' `path` directory
 #'
 #' @inheritParams check_functions
+#' @inheritParams options_params
 #' @inheritParams run
 #'
 #' @inherit check_functions return
@@ -135,9 +146,10 @@ check_pkgs <- function(
     output = tempfile(paste(utils::packageName(), Sys.Date(), sep = "-")),
     lib.loc = .libPaths(), # nolint object_name_linter
     repos = getOption("repos"),
-    restore = TRUE,
+    restore = options::opt("restore"),
     ...) {
-  checks <- source_check_tasks_df(path)
+  
+  checks <- source_check_tasks_df(path, ...)
 
   plan <- check_design$new(
     checks,
@@ -158,6 +170,7 @@ check_pkgs <- function(
 #' (non-recursively) and passes them to the [`check_pkgs()`]
 #'
 #' @inheritParams check_functions
+#' @inheritParams options_params
 #' @inheritParams run
 #'
 #' @inherit check_functions return
@@ -170,7 +183,7 @@ check_dir <- function(
     output = tempfile(paste(utils::packageName(), Sys.Date(), sep = "-")),
     lib.loc = .libPaths(), # nolint object_name_linter
     repos = getOption("repos"),
-    restore = TRUE,
+    restore = options::opt("restore"),
     ...) {
   dirs <- list.dirs(path, full.names = TRUE, recursive = FALSE)
   r_packages <- dirs[vlapply(dirs, path_is_pkg)]

R/check_design.R

@@ -86,7 +86,7 @@ check_design <- R6::R6Class( # nolint cyclocomp_linter
       output = tempfile(paste(packageName(), Sys.Date(), sep = "-")),
       lib.loc = .libPaths(), # nolint object_name_linter
       repos = getOption("repos"),
-      restore = TRUE,
+      restore = options::opt("restore"),
       ...
     ) {
       # Make sure all aliases are unique
@@ -98,10 +98,25 @@ check_design <- R6::R6Class( # nolint cyclocomp_linter
         "Custom package aliases cannot be duplicates of check aliases" =
           !any(uulist(drlapply(df$custom, `[[`, "alias")) %in% df$alias)
       )
-
-      if (!restore) unlink(output, recursive = TRUE, force = TRUE)
+      
+      if (dir.exists(output)) {
+        if (is.na(restore))
+          restore <- switch(
+            menu(
+              c("Yes", "No"),
+              title = "Do you want to restore previous results?"
+            ),
+            "1" = TRUE,
+            "2" = FALSE
+        )
+        
+        if (!restore) {
+          unlink(output, recursive = TRUE, force = TRUE)
+        }
+      }
+      
       dir_create(output)
-
+      
       self$input <- df
       self$output <- output
       private$n <- n

R/checks_df.R

@@ -21,6 +21,8 @@ empty_checks_df <- data.frame(
 #' @param path path to the package source. Can be either a single source
 #'   code directory or a directory containing multiple package source code
 #'   directories.
+#' @param ... parameters passed to the task specs allowing to customize
+#'   subprocesses.
 #'
 #' @return The check schedule `data.frame` with the following columns:
 #'
@@ -61,7 +63,8 @@ NULL
 rev_dep_check_tasks_df <- function(
   path,
   repos = getOption("repos"),
-  versions = c("dev", "release")
+  versions = c("dev", "release"),
+  ...
 ) {
   stopifnot(
     "rev_dep_check_tasks_df requires path argument of length 1" =
@@ -113,7 +116,7 @@ rev_dep_check_tasks_df <- function(
 
   if ("dev" %in% versions) {
     df_dev$alias <- paste0(df_dev$alias, " (dev)")
-    df_dev$package <- task_specs_function(revdeps, repos, df_dev$alias, "new")
+    df_dev$package <- task_specs_function(revdeps, repos, df_dev$alias, "new", ...)
     df_dev$custom <- rep(list(custom_install_task_spec(
       alias = paste0(package, " (dev)"),
       package_spec = package_spec_source(name = package, path = path),
@@ -124,7 +127,7 @@ rev_dep_check_tasks_df <- function(
   if ("release" %in% versions) {
     package_v <- ap[package, "Version"]
     df_rel$alias <- paste0(df_rel$alias, " (v", package_v, ")")
-    df_rel$package <- task_specs_function(revdeps, repos, df_rel$alias, "old")
+    df_rel$package <- task_specs_function(revdeps, repos, df_rel$alias, "old", ...)
     df_rel$custom <- rep(list(custom_install_task_spec(
       alias = paste0(package, " (release)"),
       package_spec = package_spec(name = package, repos = repos),
@@ -147,45 +150,60 @@ rev_dep_check_tasks_df <- function(
   df
 }
 
-rev_dep_check_tasks_specs <- function(packages, repos, aliases, revdep) {
+rev_dep_check_tasks_specs <- function(packages, repos, aliases, revdep, ...) {
   list_of_task_spec(mapply(
-    function(p, a) {
+    function(
+      p,
+      a,
+      env = NULL,
+      args = NULL,
+      build_args = NULL
+    ) {
       revdep_check_task_spec(
         alias = a,
         package_spec = package_spec(name = p, repos = repos),
-        env = DEFAULT_R_CMD_CHECK_VARIABLES,
-        args = DEFAULT_CHECK_ARGS,
-        build_args = DEFAULT_BUILD_ARGS,
+        env = env,
+        args = args,
+        build_args = build_args,
         revdep = revdep
       )
     },
     packages,
     aliases,
     SIMPLIFY = FALSE,
-    USE.NAMES = FALSE
+    USE.NAMES = FALSE,
+    MoreArgs = list(...)
   ))
 }
 
 rev_dep_check_tasks_specs_development <- function(
   packages,
   repos,
   aliases,
+  revdep,
   ...
 ) {
   list_of_task_spec(mapply(
-    function(p, a) {
+    function(
+      p,
+      a,
+      env = NULL,
+      args = NULL,
+      build_args = NULL
+    ) {
       check_task_spec(
         alias = a,
         package_spec = package_spec(name = p, repos = repos),
-        env = DEFAULT_R_CMD_CHECK_VARIABLES,
-        args = DEFAULT_CHECK_ARGS,
-        build_args = DEFAULT_BUILD_ARGS
+        env = env,
+        args = args,
+        build_args = build_args
       )
     },
     packages,
     aliases,
     SIMPLIFY = FALSE,
-    USE.NAMES = FALSE
+    USE.NAMES = FALSE,
+    MoreArgs = list(...)
   ))
 }
 
@@ -196,7 +214,7 @@ rev_dep_check_tasks_specs_development <- function(
 #'
 #' @family tasks
 #' @export
-source_check_tasks_df <- function(path) {
+source_check_tasks_df <- function(path, ...) {
   name <- names(path)
   path <- vcapply(path, check_path_is_pkg_source, USE.NAMES = FALSE)
   package <- vcapply(path, get_package_name)
@@ -230,21 +248,29 @@ source_check_tasks_df <- function(path) {
   df
 }
 
-source_check_tasks_specs <- function(packages, path, aliases) {
+source_check_tasks_specs <- function(packages, path, aliases, ...) {
   list_of_task_spec(mapply(
-    function(p, path, a) {
+    function(
+      p,
+      path,
+      a,
+      env = NULL,
+      args = NULL,
+      build_args = NULL) {
+      
       check_task_spec(
         alias = a,
         package_spec = package_spec_source(name = p, path = path, repos = NULL),
-        env = DEFAULT_R_CMD_CHECK_VARIABLES,
-        args = DEFAULT_CHECK_ARGS,
-        build_args = DEFAULT_BUILD_ARGS
+        env = env,
+        args = args,
+        build_args = build_args
       )
     },
     packages,
     path,
     aliases,
     SIMPLIFY = FALSE,
-    USE.NAMES = FALSE
+    USE.NAMES = FALSE,
+    MoreArgs = list(...)
   ))
 }

R/options.R

@@ -1,4 +1,35 @@
-default_tty_tick_interval <- function() {
-  # refresh interval in milliseconds
-  getOption(paste0(utils::packageName(), ".tty_tick_interval"), 100) / 1000
-}
+#' @import options
+options::define_options(
+  "tty refresh interval when reporting results in miliseconds",
+  tty_tick_interval = 100,
+  
+  "character vector indicating whether R error should be thrown when issues
+   are discovered when generating results. \"never\" means that no errors
+   are thrown. If \"issues\" then errors are emitted only on issues, whereas
+   \"potential issues\" stands for error on both issues and potential issues.",
+  error_on = "never",
+  
+  "character vector indicating which packages should be included in the results.
+   \"all\" means that all packages are kept. If \"issues\" then only packages 
+   with issues identified, whereas \"potential_issues\" stands for keeping
+   packages with both \"issues\" and \"potential_issues\".",
+  keep = "all",
+  
+  "`logical` indicating whether output directory should be unlinked before
+   running checks. If `FALSE`, an attempt will me made to restore previous
+   progress from the same `output`",
+  restore = NA,
+  
+  "`logical` indicating whether default R CMD check variables, build args or
+   check args should be appended whenever custom user ones were provided.",
+  add_default_configuration = TRUE
+)
+
+#' @eval options::as_roxygen_docs()
+NULL
+
+#' Checked Options
+#' @eval options::as_params()
+#' @name options_params
+#'
+NULL

R/reporter_ansi_tty.R

@@ -71,7 +71,7 @@ format_status_line_ansi.default <- function(
 report_sleep.reporter_ansi_tty <- function(
     reporter,
     design,
-    sleep = default_tty_tick_interval()) {
+    sleep = options::opt("tty_tick_interval")) {
   Sys.sleep(sleep)
 }