allow_preamble in library_call_linter() to skip setup code

NEWS.md

@@ -58,7 +58,7 @@
 
 ### New linters
 
-* `library_call_linter()` can detect if all library/require calls are not at the top of your script (#2027, #2043, and #2163, @nicholas-masel and @MichaelChirico).
+* `library_call_linter()` can detect if all library/require calls are not at the top of your script (#2027, #2043, #2163, and #2170, @nicholas-masel and @MichaelChirico).
 * `keyword_quote_linter()` for finding unnecessary or discouraged quoting of symbols in assignment, function arguments, or extraction (part of #884, @MichaelChirico). Quoting is unnecessary when the target is a valid R name, e.g. `c("a" = 1)` can be `c(a = 1)`. The same goes to assignment (`"a" <- 1`) and extraction (`x$"a"`). Where quoting is necessary, the linter encourages doing so with backticks (e.g. `` x$`a b` `` instead of `x$"a b"`).
 * `length_levels_linter()` for using the specific function `nlevels()` instead of checking `length(levels(x))` (part of #884, @MichaelChirico).
 * `scalar_in_linter()` for discouraging `%in%` when the right-hand side is a scalar, e.g. `x %in% 1` (part of #884, @MichaelChirico).

R/library_call_linter.R

@@ -2,6 +2,10 @@
 #'
 #' Force library calls to all be at the top of the script.
 #'
+#' @param allow_preamble Logical, default `TRUE`. If `FALSE`,
+#'   no code is allowed to precede the first `library()` call,
+#'   otherwise some setup code is allowed, but all `library()`
+#'   calls must follow consecutively after the first one.
 #' @examples
 #' # will produce lints
 #' lint(
@@ -43,12 +47,19 @@
 #' @evalRd rd_tags("library_call_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
-library_call_linter <- function() {
+library_call_linter <- function(allow_preamble = TRUE) {
   attach_call <- "text() = 'library' or text() = 'require'"
+  unsuppressed_call <- glue("not( {attach_call} or starts-with(text(), 'suppress'))")
+  if (allow_preamble) {
+    unsuppressed_call <- xp_and(
+      unsuppressed_call,
+      glue("@line1 > //SYMBOL_FUNCTION_CALL[{ attach_call }][1]/@line1")
+    )
+  }
   xpath <- glue("
     //SYMBOL_FUNCTION_CALL[{ attach_call }][last()]
       /preceding::expr
-      /SYMBOL_FUNCTION_CALL[not({ attach_call } or starts-with(text(), 'suppress'))][last()]
+      /SYMBOL_FUNCTION_CALL[{ unsuppressed_call }][last()]
       /following::expr[SYMBOL_FUNCTION_CALL[{ attach_call }]]
       /parent::expr
   ")

inst/lintr/linters.csv

@@ -46,7 +46,7 @@ keyword_quote_linter,readability consistency style
 length_levels_linter,readability best_practices consistency
 length_test_linter,common_mistakes efficiency
 lengths_linter,efficiency readability best_practices
-library_call_linter,style best_practices readability
+library_call_linter,style best_practices readability configurable
 line_length_linter,style readability default configurable
 literal_coercion_linter,best_practices consistency efficiency
 matrix_apply_linter,readability efficiency

tests/testthat/test-library_call_linter.R

@@ -110,16 +110,6 @@ test_that("library_call_linter warns on disallowed usages", {
     linter
   )
 
-  expect_lint(
-    trim_some("
-      fun()
-      library(moreFun)
-      oops()
-    "),
-    lint_message,
-    linter
-  )
-
   expect_lint(
     trim_some("
       library(dplyr)
@@ -170,3 +160,59 @@ test_that("require() treated the same as library()", {
     linter
   )
 })
+
+test_that("allow_preamble applies as intended", {
+  linter_preamble <- library_call_linter(allow_preamble = TRUE)
+  linter_no_preamble <- library_call_linter(allow_preamble = FALSE)
+  lint_msg <- rex::rex("Move all library calls to the top of the script.")
+
+  lines <- trim_some("
+    opts_chunk$set(eval = FALSE)
+    library(dplyr)
+    library(knitr)
+
+    print(letters)
+  ")
+  expect_lint(lines, NULL, linter_preamble)
+  expect_lint(lines, list(list(line_number = 2L), list(line_number = 3L)), linter_no_preamble)
+
+  lines <- trim_some("
+    opts_chunk$set(eval = FALSE)
+    suppressPackageStartupMessages({
+      library(dplyr)
+      library(knitr)
+    })
+
+    print(letters)
+  ")
+  expect_lint(lines, NULL, linter_preamble)
+  expect_lint(lines, list(list(line_number = 3L), list(line_number = 4L)), linter_no_preamble)
+
+  lines <- trim_some("
+    opts_chunk$set(eval = FALSE)
+    suppressPackageStartupMessages(library(dplyr))
+    library(knitr)
+
+    print(letters)
+  ")
+  expect_lint(lines, NULL, linter_preamble)
+  expect_lint(lines, list(list(line_number = 2L), list(line_number = 3L)), linter_no_preamble)
+
+  lines <- trim_some("
+    opts_chunk$set(eval = FALSE)
+    library(dplyr)
+    suppressPackageStartupMessages(library(knitr))
+
+    print(letters)
+  ")
+  expect_lint(lines, NULL, linter_preamble)
+  expect_lint(lines, list(list(line_number = 2L), list(line_number = 3L)), linter_no_preamble)
+
+  lines <- trim_some("
+    fun()
+    library(moreFun)
+    oops()
+  ")
+  expect_lint(lines, NULL, linter_preamble)
+  expect_lint(lines, lint_msg, linter_no_preamble)
+})