file path detection in paste_linter

NEWS.md

@@ -23,6 +23,7 @@
   + `yoda_test_linter()`
 * `sprintf_linter()` is pipe-aware, so that `x %>% sprintf(fmt = "%s")` no longer lints (#1943, @MichaelChirico).
 * `line_length_linter()` helpfully includes the line length in the lint message (#2057, @MichaelChirico).
+* `paste_linter()` gains detection for file paths that are better constructed with `file.path()`, e.g. `paste0(dir, "/", file)` would be better as `file.path(dir, file)` (part of #884, @MichaelChirico).
 
 ### New linters
 

R/paste_linter.R

@@ -21,6 +21,8 @@
 #'   `paste()` with `sep = ""` is not linted.
 #' @param allow_to_string Logical, default `FALSE`. If `TRUE`, usage of
 #'   `paste()` and `paste0()` with `collapse = ", "` is not linted.
+#' @param allow_file_path Logical, default `FALSE`. If `TRUE`, usage of
+#'   `paste()` and `paste0()` to construct file paths is not linted.
 #'
 #' @examples
 #' # will produce lints
@@ -44,6 +46,11 @@
 #'   linters = paste_linter()
 #' )
 #'
+#' lint(
+#'   text = 'paste0(dir, "/", file)',
+#'   linters = paste_linter()
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = 'paste0("a", "b")',
@@ -75,9 +82,14 @@
 #'   linters = paste_linter()
 #' )
 #'
+#' lint(
+#'   text = 'paste0(year, "/", month, "/", day)',
+#'   linters = paste_linter(allow_file_path = TRUE)
+#' )
+#'
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
-paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) {
+paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE, allow_file_path = FALSE) {
   sep_xpath <- "
   //SYMBOL_FUNCTION_CALL[text() = 'paste']
     /parent::expr
@@ -111,6 +123,76 @@ paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) {
     /parent::expr
   "
 
+  slash_str <- sprintf("STR_CONST[%s]", xp_text_in_table(c("'/'", '"/"')))
+  str_not_start_with_slash <-
+    "STR_CONST[not(substring(text(), 2, 1) = '/')]"
+  str_not_end_with_slash <-
+    "STR_CONST[not(substring(text(), string-length(text()) - 1, 1) = '/')]"
+  non_str <- "SYMBOL or expr"
+
+  # Type I: paste(..., sep = "/")
+  paste_file_path_xpath <- glue("
+  //SYMBOL_FUNCTION_CALL[text() = 'paste']
+    /parent::expr
+    /parent::expr[
+      SYMBOL_SUB[text() = 'sep']/following-sibling::expr[1][{slash_str}]
+      and not(SYMBOL_SUB[text() = 'collapse'])
+    ]
+  ")
+
+  # Type II: paste0(x, "/", y, "/", z)
+  #   more specifically, paste0 need not be replaced by file.path when
+  #   (1) there are consecutive SYMBOL|expr (like paste0(x, y))
+  #   (2) a STR_CONST precedes a SYMBOL|expr, but doesn't end with /
+  #   (3) a STR_CONST follows a SYMBOL|expr, but doesn't start with /
+  #   (4) there are consecutive STR_CONSTs but neither
+  #       the first ends with / nor the second starts with /
+  #   (5) there is only one argument
+  #   (6) there is any NUM_CONST
+  #   (7) collapse is used
+  #   (8) / is the first character in an initial STR_CONST or the
+  #       last character in a terminal STR_CONST, where file.path
+  #       replacement would somewhat awkwardly look like
+  #       file.path("", ...) and/or file.path(..., "")
+  #   (9) a STR_CONST beginning or ending with >1 slashes (like "//x")
+  # use count() to exclude paste0(x)
+  # don't use starts-with() -- (1) there's no ends-with() in XPath 1.0 and
+  #   (2) we need to cater for both ' and " quotations which ^ complexity
+  # NB: XPath's substring() signature is (text, initial_index, n_characters)
+  # an expression matching any of the not(...) conditions is _not_ a path
+  paste0_file_path_xpath <- glue("
+  //SYMBOL_FUNCTION_CALL[text() = 'paste0']
+    /parent::expr
+    /parent::expr[
+      count(expr) > 2
+      and not(
+        expr/NUM_CONST
+        or SYMBOL_SUB[text() = 'collapse']
+        or expr[2][{slash_str}]
+        or expr[last()][{slash_str}]
+        or expr/STR_CONST[
+          substring(text(), 2, 2) = '//'
+          or substring(text(), string-length(text()) - 2, 2) = '//'
+        ]
+        or expr[({non_str}) and following-sibling::expr[1][{non_str}]]
+        or expr[
+          {str_not_end_with_slash}
+          and following-sibling::expr[1][
+            {non_str}
+            or {str_not_start_with_slash}
+          ]
+        ]
+        or expr[
+          {str_not_start_with_slash}
+          and preceding-sibling::expr[1][{non_str}]
+        ]
+      )
+    ]
+  ")
+
+  empty_paste_note <-
+    'Note well that paste() converts empty inputs to "", whereas file.path() leaves it empty.'
+
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {
       return(list())
@@ -170,6 +252,32 @@ paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) {
       type = "warning"
     )
 
+    if (!allow_file_path) {
+      paste_file_path_expr <- xml_find_all(xml, paste_file_path_xpath)
+      optional_lints <- c(optional_lints, xml_nodes_to_lints(
+        paste_file_path_expr,
+        source_expression = source_expression,
+        lint_message = paste(
+          'Construct file paths with file.path(...) instead of paste(..., sep = "/").',
+          'If you are using paste(sep = "/") to construct a date,',
+          "consider using format() or lubridate helpers instead.",
+          empty_paste_note
+        ),
+        type = "warning"
+      ))
+
+      paste0_file_path_expr <- xml_find_all(xml, paste0_file_path_xpath)
+      optional_lints <- c(optional_lints, xml_nodes_to_lints(
+        paste0_file_path_expr,
+        source_expression = source_expression,
+        lint_message = paste(
+          'Construct file paths with file.path(...) instead of paste0(x, "/", y, "/", z).',
+          empty_paste_note
+        ),
+        type = "warning"
+      ))
+    }
+
     c(optional_lints, paste0_sep_lints, paste_strrep_lints)
   })
 }

tests/testthat/test-paste_linter.R

@@ -113,3 +113,95 @@ test_that("paste_linter blocks simple disallowed usages", {
   expect_lint("paste0(rep('*', 20L), collapse='')", lint_msg, linter)
   expect_lint("paste(rep('#', width), collapse='')", lint_msg, linter)
 })
+
+test_that("paste_linter skips allowed usages for file paths", {
+  linter <- paste_linter()
+
+  expect_lint("paste('a', 'b', 'c')", NULL, linter)
+  expect_lint("paste('a', 'b', 'c', sep = ',')", NULL, linter)
+  expect_lint("paste('a', 'b', collapse = '/')", NULL, linter)
+  expect_lint("cat(paste('a', 'b'), sep = '/')", NULL, linter)
+  expect_lint("sep <- '/'; paste('a', sep)", NULL, linter)
+  expect_lint("paste(sep = ',', '/', 'a')", NULL, linter)
+
+  # paste(..., sep='/', collapse=collapse) is not a trivial swap to file.path
+  expect_lint("paste(x, y, sep = '/', collapse = ':')", NULL, linter)
+
+  expect_lint("file.path('a', 'b', 'c')", NULL, linter)
+
+  # testing the sep starts with / is not enough
+  expect_lint("paste('a', 'b', sep = '//')", NULL, linter)
+})
+
+test_that("paste_linter blocks simple disallowed usages for file paths", {
+  linter <- paste_linter()
+  lint_msg <- rex::rex("Construct file paths with file.path(...) instead of")
+
+  expect_lint("paste(sep = '/', 'a', 'b')", lint_msg, linter)
+  expect_lint("paste('a', 'b', sep = '/')", lint_msg, linter)
+})
+
+test_that("paste_linter ignores non-path cases with paste0", {
+  linter <- paste_linter()
+
+  expect_lint("paste0(x, y)", NULL, linter)
+  expect_lint("paste0('abc', 'def')", NULL, linter)
+  expect_lint("paste0('/abc', 'def/')", NULL, linter)
+  expect_lint("paste0(x, 'def/')", NULL, linter)
+  expect_lint("paste0('/abc', y)", NULL, linter)
+  expect_lint("paste0(foo(x), y)", NULL, linter)
+  expect_lint("paste0(foo(x), 'def')", NULL, linter)
+
+  # these might be a different lint (as.character instead, e.g.) but not here
+  expect_lint("paste0(x)", NULL, linter)
+  expect_lint("paste0('a')", NULL, linter)
+  expect_lint("paste0('a', 1)", NULL, linter)
+
+  # paste0(..., collapse=collapse) not directly mapped to file.path
+  expect_lint("paste0(x, collapse = '/')", NULL, linter)
+})
+
+test_that("paste_linter detects paths built with '/' and paste0", {
+  linter <- paste_linter()
+  lint_msg <- rex::rex("Construct file paths with file.path(...) instead of")
+
+  expect_lint("paste0(x, '/', y)", lint_msg, linter)
+  expect_lint("paste0(x, '/', y, '/', z)", lint_msg, linter)
+  expect_lint("paste0(x, '/abc/', 'def/', y)", lint_msg, linter)
+  expect_lint("paste0(foo(x), '/abc/', 'def/', bar(y))", lint_msg, linter)
+})
+
+test_that("paste_linter skips initial/terminal '/' and repeated '/' for paths", {
+  linter <- paste_linter()
+
+  expect_lint("paste0('/', x)", NULL, linter)
+  expect_lint("paste0(x, '/')", NULL, linter)
+  expect_lint("paste0(x, '//hey/', y)", NULL, linter)
+  expect_lint("paste0(x, '/hey//', y)", NULL, linter)
+})
+
+test_that("paste_linter doesn't skip all initial/terminal '/' for paths", {
+  linter <- paste_linter()
+  lint_msg <- rex::rex("Construct file paths with file.path(...) instead of")
+
+  expect_lint('paste0("/abc/", "def")', lint_msg, linter)
+  expect_lint('paste0("abc/", "def/")', lint_msg, linter)
+})
+
+test_that("multiple path lints are generated correctly", {
+  expect_lint(
+    trim_some("{
+      paste(x, y, sep = '/')
+      paste0(x, '/', y)
+    }"),
+    list(
+      rex::rex('paste(..., sep = "/")'),
+      rex::rex('paste0(x, "/", y, "/", z)')
+    ),
+    paste_linter()
+  )
+})
+
+test_that("allow_file_path argument works", {
+  expect_lint("paste(x, y, sep = '/')", NULL, paste_linter(allow_file_path = TRUE))
+})