New system_file_linter (#1006)

DESCRIPTION

@@ -120,6 +120,7 @@ Collate:
     'spaces_inside_linter.R'
     'spaces_left_parentheses_linter.R'
     'sprintf_linter.R'
+    'system_file_linter.R'
     'trailing_blank_lines_linter.R'
     'trailing_whitespace_linter.R'
     'tree-utils.R'

NAMESPACE

@@ -83,6 +83,7 @@ export(single_quotes_linter)
 export(spaces_inside_linter)
 export(spaces_left_parentheses_linter)
 export(sprintf_linter)
+export(system_file_linter)
 export(todo_comment_linter)
 export(trailing_blank_lines_linter)
 export(trailing_whitespace_linter)

NEWS.md

@@ -109,6 +109,7 @@ function calls. (#850, #851, @renkun-ken)
    * `unreachable_code_linter()` Prevent code after `return()` and `stop()` statements that will never be reached
    * `regex_subset_linter()` Require usage of `grep(ptn, x, value = TRUE)` over `x[grep(ptn, x)]` and similar
    * `consecutive_stopifnot_linter()` Require consecutive calls to `stopifnot()` to be unified into one
+   * `system_file_linter()` Require file paths to be constructed by `system.file()` instead of calling `file.path()` directly
 * `assignment_linter()` now lints right assignment (`->` and `->>`) and gains two arguments. `allow_cascading_assign` (`TRUE` by default) toggles whether to lint `<<-` and `->>`; `allow_right_assign` toggles whether to lint `->` and `->>` (#915, @michaelchirico)
 * `infix_spaces_linter()` gains argument `exclude_operators` to disable lints on selected infix operators. By default, all "low-precedence" operators throw lints; see `?infix_spaces_linter` for an enumeration of these. (#914 @michaelchirico)
 * `infix_spaces_linter()` now throws a lint on `a~b` and `function(a=1) {}` (#930, @michaelchirico)

R/system_file_linter.R

@@ -0,0 +1,48 @@
+#' Block usage of file.path() with system.file()
+#'
+#' [system.file()] has a `...` argument which, internally, is passed to
+#'   [file.path()], so including it in user code is repetitive.
+#'
+#' @evalRd rd_tags("system_file_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+system_file_linter <- function() {
+  Linter(function(source_file) {
+    if (length(source_file$xml_parsed_content) == 0L) {
+      return(list())
+    }
+
+    xml <- source_file$xml_parsed_content
+
+    xpath <- "//expr[
+      (
+        expr/SYMBOL_FUNCTION_CALL[text() = 'system.file']
+        and expr/expr/SYMBOL_FUNCTION_CALL[text() = 'file.path']
+      ) or (
+        expr/SYMBOL_FUNCTION_CALL[text() = 'file.path']
+        and expr/expr/SYMBOL_FUNCTION_CALL[text() = 'system.file']
+      )
+    ]"
+    bad_expr <- xml2::xml_find_all(xml, xpath)
+
+    return(lapply(
+      bad_expr,
+      xml_nodes_to_lint,
+      source_file = source_file,
+      lint_message = function(expr) {
+        outer_call <- xml2::xml_text(xml2::xml_find_first(expr, "expr/SYMBOL_FUNCTION_CALL"))
+        if (outer_call == "system.file") {
+          bad_usage <- 'system.file(file.path("data", "model.csv"), package = "myrf")'
+        } else {
+          bad_usage <- 'file.path(system.file(package = "myrf"), "data", "model.csv")'
+        }
+        paste(
+          "Use the `...` argument of system.file() to expand paths,",
+          'e.g. system.file("data", "model.csv", package = "myrf") instead of',
+          bad_usage
+        )
+      },
+      type = "warning"
+    ))
+  })
+}

inst/lintr/linters.csv

@@ -56,6 +56,7 @@ single_quotes_linter,style consistency readability default
 spaces_inside_linter,style readability default
 spaces_left_parentheses_linter,style readability default
 sprintf_linter,correctness common_mistakes
+system_file_linter,consistency readability best_practices
 T_and_F_symbol_linter,style readability robustness consistency best_practices default
 todo_comment_linter,style configurable
 trailing_blank_lines_linter,style default

tests/testthat/test-system_file_linter.R

@@ -0,0 +1,18 @@
+test_that("system_file_linter skips allowed usages", {
+  expect_lint("system.file('a', 'b', 'c')", NULL, system_file_linter())
+  expect_lint("file.path('a', 'b', 'c')", NULL, system_file_linter())
+})
+
+test_that("system_file_linter blocks simple disallowed usages", {
+  expect_lint(
+    "system.file(file.path('path', 'to', 'data'), package = 'foo')",
+    rex::rex("Use the `...` argument of system.file() to expand paths"),
+    system_file_linter()
+  )
+
+  expect_lint(
+    "file.path(system.file(package = 'foo'), 'path', 'to', 'data')",
+    rex::rex("Use the `...` argument of system.file() to expand paths"),
+    system_file_linter()
+  )
+})