New make_linter_from_xpath() (#2126)

* New make_linter_from_xpath

* warning by default

* more tests

* delint

* fix example

* pkgdown entry

* robust to old stopifnot

---------

Co-authored-by: Indrajeet Patil <[email protected]>

DESCRIPTION

@@ -126,6 +126,7 @@ Collate:
     'lintr-package.R'
     'literal_coercion_linter.R'
     'make_linter_from_regex.R'
+    'make_linter_from_xpath.R'
     'matrix_apply_linter.R'
     'methods.R'
     'missing_argument_linter.R'

NAMESPACE

@@ -89,6 +89,7 @@ export(lint_package)
 export(linters_with_defaults)
 export(linters_with_tags)
 export(literal_coercion_linter)
+export(make_linter_from_xpath)
 export(matrix_apply_linter)
 export(missing_argument_linter)
 export(missing_package_linter)

NEWS.md

@@ -12,6 +12,8 @@
 ## New and improved features
 
 * New exclusion sentinel `# nolint next` to signify the next line should skip linting (#1791, @MichaelChirico). The usual rules apply for excluding specific linters, e.g. `# nolint next: assignment_linter.`. The exact string used to match a subsequent-line exclusion is controlled by the `exclude_next` config entry or R option `"lintr.exclude_next"`.
+* New `xp_call_name()` helper to facilitate writing custom linters (#2023, @MichaelChirico). This helper converts a matched XPath to the R function to which it corresponds. This is useful for including the "offending" function in the lint's message.
+* New `make_linter_from_xpath()` to facilitate making simple linters directly from a single XPath (#2064, @MichaelChirico). This is especially helpful for making on-the-fly/exploratory linters, but also extends to any case where the linter can be fully defined from a static lint message and single XPath.
 * `fixed_regex_linter()`
   + Is pipe-aware, in particular removing false positives arong piping into {stringr} functions like `x |> str_replace(fixed("a"), "b")` (#1811, @MichaelChirico).
   + Gains an option `allow_unescaped` (default `FALSE`) to toggle linting regexes not requiring any escapes or character classes (#1689, @MichaelChirico). Thus `fixed_regex_linter(allow_unescaped = TRUE)` would lint on `grepl("[$]", x)` but not on `grepl("a", x)` since the latter does not use any regex special characters.
@@ -36,7 +38,6 @@
 * `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, #2082, @MichaelChirico). What exactly gets linted here can be fine-tuned with the `allow_file_path` option (`"double_slash"` by default, with alternatives `"never"` and `"always"`). When `"always"`, these rules are ignored. When `"double_slash"`, paths appearing to construct a URL that have consecutive forward slashes (`/`) are skipped. When `"never"`, even URLs should be construced with `file.path()`.
 * `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).
 * `seq_linter()` recommends `rev()` in the lint message for lints like `nrow(x):1` (#1542, @MichaelChirico).
-* New `xp_call_name()` helper to facilitate writing custom linters (#2023, @MichaelChirico). This helper converts a matched XPath to the R function to which it corresponds. This is useful for including the "offending" function in the lint's message.
 * `function_argument_linter()` detects usage of `missing()` for the linted argument (#1546, @MichaelChirico). The simplest fix for `function_argument_linter()` lints is typically to set that argument to `NULL` by default, in which case it's usually preferable to update function logic checking `missing()` to check `is.null()` instead.
 * `equals_na_linter()` checks for `x %in% NA`, which is a more convoluted form of `is.na(x)` (#2088, @MichaelChirico).
 * `commas_linter()` gains an option `allow_trailing` (default `FALSE`) to allow trailing commas while indexing. (#2104, @MEO265)

R/make_linter_from_xpath.R

@@ -0,0 +1,43 @@
+#' Create a linter from an XPath
+#'
+#' @inheritParams xml_nodes_to_lints
+#' @inheritParams is_lint_level
+#' @param xpath Character string, an XPath identifying R code to lint.
+#'   See [xmlparsedata::xml_parse_data()] and [get_source_expressions()].
+#'
+#' @examples
+#' number_linter <- make_linter_from_xpath("//NUM_CONST", "This is a number.")
+#' lint(text = "1 + 2", linters = number_linter())
+#' @export
+make_linter_from_xpath <- function(xpath,
+                                   lint_message,
+                                   type = c("warning", "style", "error"),
+                                   level = c("expression", "file")) {
+  type <- match.arg(type)
+  level <- match.arg(level)
+
+  stopifnot(
+    "xpath should be a character string" = is.character(xpath) && length(xpath) == 1L && !is.na(xpath)
+  )
+
+  xml_key <- if (level == "expression") "xml_parsed_content" else "full_xml_parsed_content"
+
+  function() {
+    Linter(function(source_expression) {
+      if (!is_lint_level(source_expression, level)) {
+        return(list())
+      }
+
+      xml <- source_expression[[xml_key]]
+
+      expr <- xml_find_all(xml, xpath)
+
+      xml_nodes_to_lints(
+        expr,
+        source_expression = source_expression,
+        lint_message = lint_message,
+        type = type
+      )
+    })
+  }
+}

_pkgdown.yaml

@@ -40,6 +40,7 @@ reference:
       - is_lint_level
       - get_r_string
       - use_lintr
+      - make_linter_from_xpath
       - xml_nodes_to_lints
       - xp_call_name
 

tests/testthat/test-make_linter_from_xpath.R

@@ -0,0 +1,29 @@
+test_that("basic usage works", {
+  linter <- make_linter_from_xpath("//NUM_CONST", "Number")
+  expect_type(linter, "closure")
+  expect_lint("1", list("Number", type = "warning"), linter())
+
+  expect_lint("'a'", "Letter", make_linter_from_xpath("//STR_CONST", "Letter")())
+  expect_lint("'a'", "Letter", make_linter_from_xpath("//STR_CONST", "Letter", level = "file")())
+  expect_lint("'a'", list("Letter", type = "style"), make_linter_from_xpath("//STR_CONST", "Letter", type = "style")())
+})
+
+test_that("input validation works", {
+  expect_error(
+    make_linter_from_xpath("//NUM_CONST", "Number", type = "x"),
+    'one of "warning", "style", "error"',
+    fixed = TRUE
+  )
+
+  expect_error(
+    make_linter_from_xpath("//NUM_CONST", "Number", level = "x"),
+    'one of "expression", "file"',
+    fixed = TRUE
+  )
+
+  err_msg <- if (getRversion() < "4.0.0") "is.character(xpath)" else "xpath should be a character string"
+  expect_error(make_linter_from_xpath(FALSE), err_msg, fixed = TRUE)
+  expect_error(make_linter_from_xpath(letters), err_msg, fixed = TRUE)
+  expect_error(make_linter_from_xpath(NA_character_), err_msg, fixed = TRUE)
+  expect_error(make_linter_from_xpath(character()), err_msg, fixed = TRUE)
+})