Extend library_call_linter for character.only usage

DESCRIPTION

@@ -73,6 +73,7 @@ Collate:
     'boolean_arithmetic_linter.R'
     'brace_linter.R'
     'cache.R'
+    'character_only_linter.R'
     'class_equals_linter.R'
     'commas_linter.R'
     'comment_linters.R'

NAMESPACE

@@ -30,6 +30,7 @@ export(available_tags)
 export(backport_linter)
 export(boolean_arithmetic_linter)
 export(brace_linter)
+export(character_only_linter)
 export(checkstyle_output)
 export(class_equals_linter)
 export(clear_cache)

NEWS.md

@@ -10,6 +10,7 @@
 * `stopifnot_all_linter()` discourages tests with `all()` like `stopifnot(all(x > 0))`; `stopifnot()` runs `all()` itself, and uses a better error message (part of #884, @MichaelChirico).
 * `comparison_negation_linter()` for discouraging negated comparisons when a direct negation is preferable, e.g. `!(x == y)` could be `x != y` (part of #884, @MichaelChirico).
 * `terminal_close_linter()` for discouraging using `close()` to end functions (part of #884, @MichaelChirico). Such usages are not robust to errors, where `close()` will not be run as intended. Put `close()` in an `on.exit()` hook, or use {withr} to manage connections with proper cleanup.
+* `character_only_linter()` for encouraging all attached packages to be included with `library(symbol)`, not `library("symbol", character.only = TRUE)` or "vectorized" approaches looping over package names (part of #884, @MichaelChirico).
 
 ### Lint accuracy fixes: removing false positives
 

R/character_only_linter.R

@@ -0,0 +1,80 @@
+#' Enforce library calls using symbols
+#'
+#' R packages should be imported as symbols, like `library(lintr)`,
+#'   and *not* via strings like `library("lintr", character.only = TRUE)`,
+#'   with few exceptions.
+#'
+#' @evalRd rd_tags("character_only_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+character_only_linter <- function() {
+  # STR_CONST: block library|require("..."), i.e., supplying a string literal
+  # ancestor::expr[FUNCTION]: Skip usages inside functions a la {knitr}
+  direct_xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'library' or text() = 'require']
+    /parent::expr
+    /parent::expr[
+      expr[2][STR_CONST]
+      or (
+        SYMBOL_SUB[text() = 'character.only']
+        and not(ancestor::expr[FUNCTION])
+      )
+    ]
+  "
+
+  bad_indirect_funs <- c("do.call", "lapply", "sapply", "map", "walk")
+  call_symbol_cond <- "
+  SYMBOL[text() = 'library' or text() = 'require']
+    or STR_CONST[text() = '\"library\"' or text() = '\"require\"']
+  "
+  indirect_xpath <- glue("
+  //SYMBOL_FUNCTION_CALL[{ xp_text_in_table(bad_indirect_funs) }]
+    /parent::expr
+    /parent::expr[
+      not(ancestor::expr[FUNCTION])
+      and expr[{ call_symbol_cond }]
+    ]
+  ")
+  call_symbol_path <- glue("./expr[{call_symbol_cond}]")
+
+  Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+
+    xml <- source_expression$xml_parsed_content
+
+    direct_expr <- xml_find_all(xml, direct_xpath)
+    direct_calls <- xp_call_name(direct_expr)
+    character_only <-
+      xml_find_first(direct_expr, "./SYMBOL_SUB[text() = 'character.only']")
+    direct_msg_fmt <- ifelse(
+      is.na(character_only),
+      "Use symbols, not strings, in %s calls.",
+      "Use symbols in %s calls to avoid the need for 'character.only'."
+    )
+    direct_msg <- sprintf(as.character(direct_msg_fmt), direct_calls)
+    direct_lints <- xml_nodes_to_lints(
+      direct_expr,
+      source_expression = source_expression,
+      lint_message = direct_msg,
+      type = "warning"
+    )
+
+    indirect_expr <- xml_find_all(xml, indirect_xpath)
+    indirect_lib_calls <- get_r_string(indirect_expr, call_symbol_path)
+    indirect_loop_calls <- xp_call_name(indirect_expr)
+    indirect_msg <- sprintf(
+      "Call %s() directly, not vectorized with %s().",
+      indirect_lib_calls, indirect_loop_calls
+    )
+    indirect_lints <- xml_nodes_to_lints(
+      indirect_expr,
+      source_expression = source_expression,
+      lint_message = indirect_msg,
+      type = "warning"
+    )
+
+    c(direct_lints, indirect_lints)
+  })
+}

inst/lintr/linters.csv

@@ -6,6 +6,7 @@ assignment_linter,style consistency default configurable
 backport_linter,robustness configurable package_development
 boolean_arithmetic_linter,efficiency best_practices readability
 brace_linter,style readability default configurable
+character_only_linter,consistency best_practices readability
 class_equals_linter,best_practices robustness consistency
 closed_curly_linter,style readability deprecated configurable
 commas_linter,style readability default configurable

tests/testthat/test-character_only_linter.R

@@ -0,0 +1,92 @@
+test_that("character_only_linter skips allowed usages", {
+  linter <- character_only_linter()
+
+  expect_lint("library(data.table)", NULL, linter)
+  expect_lint("function(pkg) library(pkg, character.only = TRUE)", NULL, linter)
+  expect_lint("function(pkgs) sapply(pkgs, require, character.only = TRUE)", NULL, linter)
+})
+
+test_that("character_only_linter blocks disallowed usages", {
+  linter <- character_only_linter()
+
+  expect_lint(
+    'library("data.table")',
+    rex::rex("Use symbols, not strings, in library calls."),
+    linter
+  )
+
+  expect_lint(
+    'library("data.table", character.only = TRUE)',
+    rex::rex("Use symbols in library calls", anything, "character.only"),
+    linter
+  )
+
+  expect_lint(
+    'suppressWarnings(library("data.table", character.only = TRUE))',
+    rex::rex("Use symbols in library calls", anything, "character.only"),
+    linter
+  )
+
+  expect_lint(
+    "do.call(library, list(data.table))",
+    rex::rex("Call library() directly, not vectorized with do.call()"),
+    linter
+  )
+
+  expect_lint(
+    'do.call("library", list(data.table))',
+    rex::rex("Call library() directly, not vectorized with do.call()"),
+    linter
+  )
+
+  expect_lint(
+    'lapply("data.table", library, character.only = TRUE)',
+    rex::rex("Call library() directly, not vectorized with lapply()"),
+    linter
+  )
+
+  expect_lint(
+    'purr::map("data.table", library, character.only = TRUE)',
+    rex::rex("Call library() directly, not vectorized with map()"),
+    linter
+  )
+})
+
+test_that("Printing character_only_linter works with multiple-line source", {
+  expect_lint(
+    trim_some('
+      suppressWarnings(library(
+        "data.table",
+        character.only = TRUE
+      ))
+    '),
+    rex::rex("Use symbols in library calls", anything, "character.only"),
+    character_only_linter()
+  )
+})
+
+test_that("character_only_linter catches purrr::walk as well", {
+  expect_lint(
+    'purr::walk("data.table", library, character.only = TRUE)',
+    rex::rex("Call library() directly, not vectorized with walk()"),
+    character_only_linter()
+  )
+})
+
+test_that("multiple lints are generated correctly", {
+  expect_lint(
+    trim_some('{
+      library("dplyr", character.only = TRUE)
+      require("gfile")
+      sapply(pkg_list, "library", character.only = TRUE)
+      purrr::walk(extra_list, require, character.only = TRUE)
+    }'),
+    list(
+      list(message = rex::rex("library calls", anything, "character.only")),
+      list(message = "symbols, not strings, in require calls"),
+      list(message = rex::rex("library() directly", anything, "vectorized with sapply()")),
+      list(message = rex::rex("require() directly", anything, "vectorized with walk()"))
+    ),
+    character_only_linter()
+  )
+})