improve handling of progress in lint_dir, expose option show_progress (…

…#2133)

NAMESPACE

@@ -161,10 +161,13 @@ importFrom(rex,rex)
 importFrom(stats,na.omit)
 importFrom(utils,capture.output)
 importFrom(utils,getParseData)
+importFrom(utils,getTxtProgressBar)
 importFrom(utils,globalVariables)
 importFrom(utils,head)
 importFrom(utils,relist)
+importFrom(utils,setTxtProgressBar)
 importFrom(utils,tail)
+importFrom(utils,txtProgressBar)
 importFrom(xml2,as_list)
 importFrom(xml2,xml_attr)
 importFrom(xml2,xml_find_all)

NEWS.md

@@ -14,6 +14,7 @@
 * New exclusion sentinel `# nolint next` to signify the next line should skip linting (#1791, @MichaelChirico). The usual rules apply for excluding specific linters, e.g. `# nolint next: assignment_linter.`. The exact string used to match a subsequent-line exclusion is controlled by the `exclude_next` config entry or R option `"lintr.exclude_next"`.
 * New `xp_call_name()` helper to facilitate writing custom linters (#2023, @MichaelChirico). This helper converts a matched XPath to the R function to which it corresponds. This is useful for including the "offending" function in the lint's message.
 * New `make_linter_from_xpath()` to facilitate making simple linters directly from a single XPath (#2064, @MichaelChirico). This is especially helpful for making on-the-fly/exploratory linters, but also extends to any case where the linter can be fully defined from a static lint message and single XPath.
+* Toggle lint progress indicators with argument `show_progress` to `lint_dir()` and `lint_package()` (#972, @MichaelChirico). The default is still to show progress in `interactive()` sessions. Progress is also now shown with a "proper" progress bar (`utils::txtProgressBar()`), which in particular solves the issue of progress `.` spilling well past the width of the screen in large directories.
 * `fixed_regex_linter()`
   + Is pipe-aware, in particular removing false positives arong piping into {stringr} functions like `x |> str_replace(fixed("a"), "b")` (#1811, @MichaelChirico).
   + Gains an option `allow_unescaped` (default `FALSE`) to toggle linting regexes not requiring any escapes or character classes (#1689, @MichaelChirico). Thus `fixed_regex_linter(allow_unescaped = TRUE)` would lint on `grepl("[$]", x)` but not on `grepl("a", x)` since the latter does not use any regex special characters.

R/lint.R

@@ -106,6 +106,9 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings =
 #' @param exclusions exclusions for [exclude()], relative to the package path.
 #' @param pattern pattern for files, by default it will take files with any of the extensions
 #' .R, .Rmd, .qmd, .Rnw, .Rhtml, .Rrst, .Rtex, .Rtxt allowing for lowercase r (.r, ...).
+#' @param show_progress Logical controlling whether to show linting progress with a simple text
+#'   progress bar _via_ [utils::txtProgressBar()]. The default behavior is to show progress in
+#'   [interactive()] sessions not running a testthat suite.
 #'
 #' @examples
 #' if (FALSE) {
@@ -126,7 +129,8 @@ lint_dir <- function(path = ".", ...,
                      relative_path = TRUE,
                      exclusions = list("renv", "packrat"),
                      pattern = rex(".", one_of("Rr"), or("", "html", "md", "nw", "rst", "tex", "txt"), end),
-                     parse_settings = TRUE) {
+                     parse_settings = TRUE,
+                     show_progress = NULL) {
   if (has_positional_logical(list(...))) {
     stop(
       "'relative_path' is no longer available as a positional argument; ",
@@ -141,6 +145,8 @@ lint_dir <- function(path = ".", ...,
     exclusions <- c(exclusions, settings$exclusions)
   }
 
+  if (is.null(show_progress)) show_progress <- interactive() && !identical(Sys.getenv("TESTTHAT"), "true")
+
   exclusions <- normalize_exclusions(
     exclusions,
     root = path,
@@ -159,15 +165,19 @@ lint_dir <- function(path = ".", ...,
   # Remove fully ignored files to avoid reading & parsing
   files <- drop_excluded(files, exclusions)
 
+  pb <- if (isTRUE(show_progress)) {
+    txtProgressBar(max = length(files), style = 3L)
+  }
+
   lints <- flatten_lints(lapply(
     files,
     function(file) {
-      maybe_report_progress()
+      maybe_report_progress(pb)
       lint(file, ..., parse_settings = FALSE, exclusions = exclusions)
     }
   ))
 
-  maybe_report_progress(done = TRUE)
+  if (!is.null(pb)) close(pb)
 
   lints <- reorder_lints(lints)
 
@@ -211,7 +221,8 @@ drop_excluded <- function(files, exclusions) {
 lint_package <- function(path = ".", ...,
                          relative_path = TRUE,
                          exclusions = list("R/RcppExports.R"),
-                         parse_settings = TRUE) {
+                         parse_settings = TRUE,
+                         show_progress = NULL) {
   if (has_positional_logical(list(...))) {
     # nocov start: dead code path
     stop(
@@ -242,7 +253,13 @@ lint_package <- function(path = ".", ...,
   )
 
   r_directories <- file.path(pkg_path, c("R", "tests", "inst", "vignettes", "data-raw", "demo", "exec"))
-  lints <- lint_dir(r_directories, relative_path = FALSE, exclusions = exclusions, parse_settings = FALSE, ...)
+  lints <- lint_dir(r_directories,
+    relative_path = FALSE,
+    exclusions = exclusions,
+    parse_settings = FALSE,
+    show_progress = show_progress,
+    ...
+  )
 
   if (isTRUE(relative_path)) {
     path <- normalizePath(pkg_path, mustWork = FALSE)
@@ -711,16 +728,11 @@ has_positional_logical <- function(dots) {
     !nzchar(names2(dots)[1L])
 }
 
-maybe_report_progress <- function(done = FALSE) {
-  if (interactive() && !identical(Sys.getenv("TESTTHAT"), "true")) {
-    # nocov start
-    if (done) {
-      message()
-    } else {
-      message(".", appendLF = FALSE)
-    }
-    # nocov end
+maybe_report_progress <- function(pb) {
+  if (is.null(pb)) {
+    return(invisible())
   }
+  setTxtProgressBar(pb, getTxtProgressBar(pb) + 1L)
 }
 
 maybe_append_error_lint <- function(lints, error, lint_cache, filename) {

R/lintr-package.R

@@ -12,7 +12,8 @@
 #' @importFrom glue glue glue_collapse
 #' @importFrom rex rex regex re_matches re_substitutes character_class
 #' @importFrom stats na.omit
-#' @importFrom utils capture.output getParseData globalVariables head relist tail
+#' @importFrom utils capture.output getParseData getTxtProgressBar globalVariables head relist
+#'   setTxtProgressBar tail txtProgressBar
 #' @importFrom xml2 as_list
 #'   xml_attr xml_find_all xml_find_chr xml_find_lgl xml_find_num xml_find_first xml_name xml_text
 #' @rawNamespace

tests/testthat/test-dir_linters.R

@@ -10,6 +10,12 @@ test_that("lint all files in a directory", {
 
   expect_s3_class(lints, "lints")
   expect_identical(sort(linted_files), sort(files))
+
+  expect_output(
+    lint_dir(the_dir, parse_settings = FALSE, show_progress = TRUE),
+    "======",
+    fixed = TRUE
+  )
 })
 
 test_that("lint all relevant directories in a package", {