[R] [ci] move linting code out of package (#8545)

.github/workflows/r_tests.yml

@@ -43,10 +43,9 @@ jobs:
 
     - name: Run lintr
       run: |
-        cd R-package
-        MAKEFLAGS="-j$(nproc)" R CMD INSTALL .
+        MAKEFLAGS="-j$(nproc)" R CMD INSTALL R-package/
         # Disable lintr errors for now: https://github.com/dmlc/xgboost/issues/8012
-        Rscript tests/helper_scripts/run_lint.R || true
+        Rscript tests/ci_build/lint_r.R $(pwd) || true
 
   test-R-on-Windows:
     runs-on: ${{ matrix.config.os }}

R-package/DESCRIPTION

@@ -54,10 +54,8 @@ Suggests:
     Ckmeans.1d.dp (>= 3.3.1),
     vcd (>= 1.3),
     testthat,
-    lintr,
     igraph (>= 1.0.1),
     float,
-    crayon,
     titanic
 Depends:
     R (>= 3.3.0)

R-package/tests/helper_scripts/install_deps.R

@@ -14,11 +14,10 @@ pkgs <- c(
   "DiagrammeR",
   "Ckmeans.1d.dp",
   "vcd",
-  "testthat",
   "lintr",
+  "testthat",
   "igraph",
   "float",
-  "crayon",
   "titanic",
   ## imports
   "Matrix",

R-package/tests/helper_scripts/run_lint.R

@@ -1,71 +0,0 @@
-library(lintr)
-library(crayon)
-
-my_linters <- list(
-  absolute_path_linter = lintr::absolute_path_linter,
-  assignment_linter = lintr::assignment_linter,
-  closed_curly_linter = lintr::closed_curly_linter,
-  commas_linter = lintr::commas_linter,
-  equals_na = lintr::equals_na_linter,
-  infix_spaces_linter = lintr::infix_spaces_linter,
-  line_length_linter = lintr::line_length_linter,
-  no_tab_linter = lintr::no_tab_linter,
-  object_usage_linter = lintr::object_usage_linter,
-  object_length_linter = lintr::object_length_linter,
-  open_curly_linter = lintr::open_curly_linter,
-  semicolon = lintr::semicolon_terminator_linter(semicolon = c("compound", "trailing")),
-  seq = lintr::seq_linter,
-  spaces_inside_linter = lintr::spaces_inside_linter,
-  spaces_left_parentheses_linter = lintr::spaces_left_parentheses_linter,
-  trailing_blank_lines_linter = lintr::trailing_blank_lines_linter,
-  trailing_whitespace_linter = lintr::trailing_whitespace_linter,
-  true_false = lintr::T_and_F_symbol_linter,
-  unneeded_concatenation = lintr::unneeded_concatenation_linter
-)
-
-results <- lapply(
-  list.files(path = '.', pattern = '\\.[Rr]$', recursive = TRUE),
-  function (r_file) {
-    cat(sprintf("Processing %s ...\n", r_file))
-    list(r_file = r_file,
-         output = lintr::lint(filename = r_file, linters = my_linters))
-  })
-num_issue <- Reduce(sum, lapply(results, function (e) length(e$output)))
-
-lint2str <- function(lint_entry) {
-  color <- function(type) {
-    switch(type,
-      "warning" = crayon::magenta,
-      "error" = crayon::red,
-      "style" = crayon::blue,
-      crayon::bold
-    )
-  }
-
-  paste0(
-    lapply(lint_entry$output,
-      function (lint_line) {
-        paste0(
-          crayon::bold(lint_entry$r_file, ":",
-          as.character(lint_line$line_number), ":",
-          as.character(lint_line$column_number), ": ", sep = ""),
-          color(lint_line$type)(lint_line$type, ": ", sep = ""),
-          crayon::bold(lint_line$message), "\n",
-          lint_line$line, "\n",
-          lintr:::highlight_string(lint_line$message, lint_line$column_number, lint_line$ranges),
-          "\n",
-          collapse = "")
-      }),
-    collapse = "")
-}
-
-if (num_issue > 0) {
-  cat(sprintf('R linters found %d issues:\n', num_issue))
-  for (entry in results) {
-    if (length(entry$output)) {
-      cat(paste0('**** ', crayon::bold(entry$r_file), '\n'))
-      cat(paste0(lint2str(entry), collapse = ''))
-    }
-  }
-  quit(save = 'no', status = 1)  # Signal error to parent shell
-}

tests/ci_build/lint_r.R

@@ -0,0 +1,72 @@
+library(lintr)
+
+args <- commandArgs(
+    trailingOnly = TRUE
+)
+SOURCE_DIR <- args[[1L]]
+
+FILES_TO_LINT <- list.files(
+    path = SOURCE_DIR
+    , pattern = "\\.r$|\\.rmd$"
+    , all.files = TRUE
+    , ignore.case = TRUE
+    , full.names = TRUE
+    , recursive = TRUE
+    , include.dirs = FALSE
+)
+
+my_linters <- list(
+  absolute_path_linter = lintr::absolute_path_linter(),
+  assignment_linter = lintr::assignment_linter(),
+  brace_linter = lintr::brace_linter(),
+  commas_linter = lintr::commas_linter(),
+  equals_na = lintr::equals_na_linter(),
+  infix_spaces_linter = lintr::infix_spaces_linter(),
+  line_length_linter = lintr::line_length_linter(),
+  no_tab_linter = lintr::no_tab_linter(),
+  object_usage_linter = lintr::object_usage_linter(),
+  object_length_linter = lintr::object_length_linter(),
+  semicolon = lintr::semicolon_linter(),
+  seq = lintr::seq_linter(),
+  spaces_inside_linter = lintr::spaces_inside_linter(),
+  spaces_left_parentheses_linter = lintr::spaces_left_parentheses_linter(),
+  trailing_blank_lines_linter = lintr::trailing_blank_lines_linter(),
+  trailing_whitespace_linter = lintr::trailing_whitespace_linter(),
+  true_false = lintr::T_and_F_symbol_linter(),
+  unneeded_concatenation = lintr::unneeded_concatenation_linter()
+)
+
+noquote(paste0(length(FILES_TO_LINT), " R files need linting"))
+
+results <- NULL
+
+for (r_file in FILES_TO_LINT) {
+
+    this_result <- lintr::lint(
+        filename = r_file
+        , linters = my_linters
+        , cache = FALSE
+    )
+
+    print(
+        sprintf(
+            "Found %i linting errors in %s"
+            , length(this_result)
+            , r_file
+        )
+        , quote = FALSE
+    )
+
+    results <- c(results, this_result)
+
+}
+
+issues_found <- length(results)
+
+noquote(paste0("Total linting issues found: ", issues_found))
+
+if (issues_found > 0L) {
+    print(results)
+}
+
+quit(save = "no", status = 1L)