export xp_call_name() for downstream use

NAMESPACE

@@ -143,6 +143,7 @@ export(whitespace_linter)
 export(with_defaults)
 export(with_id)
 export(xml_nodes_to_lints)
+export(xp_call_name)
 export(yoda_test_linter)
 importFrom(cyclocomp,cyclocomp)
 importFrom(glue,glue)

NEWS.md

@@ -30,6 +30,7 @@
 * `conjunct_test_linter()` also lints usage like `dplyr::filter(x, A & B)` in favor of using `dplyr::filter(x, A, B)` (part of #884, @MichaelChirico).
 * `sort_linter()` checks for code like `x == sort(x)` which is better served by using the function `is.unsorted()` (part of #884, @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 `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 linters
 

R/xp_utils.R

@@ -44,7 +44,41 @@ xp_and <- function(...) paren_wrap(..., sep = "and")
 #' @noRd
 xp_or <- function(...) paren_wrap(..., sep = "or")
 
+#' Get the name of the function matched by an XPath
+#'
+#' Often, it is more helpful to custom-tailer the `message` of a lint to record
+#'   which function was matched by the lint logic. This function encapsualtes
+#'   the logic to pull out the matched call in common situations.
+#'
+#' @param expr An `xml_node` or `xml_nodeset`, e.g. from [xml2::xml_find_all()].
+#' @param depth Integer, default `1L`. How deep in the AST represented by `expr`
+#'   should we look to find the call? By default, we assume `expr` is matched
+#'   to an `<expr>` node under which the corresponding `<SYMBOL_FUNCTION_CALL>`
+#'   node is found directly. `depth = 0L` means `expr` is matched directly
+#'   to the `SYMBOL_FUNCTION_CALL`; `depth > 1L` means `depth` total `<expr>`
+#'   nodes must be traversed before finding the call.
+#' @param condition An additional (XPath condition on the `SYMBOL_FUNCTION_CALL`
+#'   required for a match. The default (`NULL`) is no condition. See examples.
+#'
+#' @examples
+#' xml_from_code <- function(str) {
+#'   xml2::read_xml(xmlparsedata::xml_parse_data(parse(text = str, keep.source = TRUE)))
+#' }
+#' xml <- xml_from_code("sum(1:10)")
+#' xp_call_name(xml, depth = 2L)
+#'
+#' xp_call_name(xml2::xml_find_first(xml, "expr"))
+#'
+#' xml <- xml_from_code(c("sum(1:10)", "sd(1:10)"))
+#' xp_call_name(xml, depth = 2L, condition = "text() = 'sum'")
+#'
+#' @export
 xp_call_name <- function(expr, depth = 1L, condition = NULL) {
+  stopifnot(
+    inherits(expr, c("xml_node", "xml_nodeset")),
+    is.numeric(depth), depth >= 0L,
+    is.null(condition) || is.character(condition)
+  )
   if (is.null(condition)) {
     node <- "SYMBOL_FUNCTION_CALL"
   } else {

_pkgdown.yaml

@@ -41,6 +41,7 @@ reference:
       - get_r_string
       - use_lintr
       - xml_nodes_to_lints
+      - xp_call_name
 
   - title: Meta-tooling
     contents:

tests/testthat/test-xp_utils.R

@@ -0,0 +1,21 @@
+test_that("xp_call_name works", {
+  xml_from_code <- function(str) {
+    xml2::read_xml(xmlparsedata::xml_parse_data(parse(text = str, keep.source = TRUE)))
+  }
+  xml <- xml_from_code("sum(1:10)")
+  expect_identical(xp_call_name(xml, depth = 2L), "sum")
+
+  expect_identical(xp_call_name(xml2::xml_find_first(xml, "expr")), "sum")
+
+  xml <- xml_from_code(c("sum(1:10)", "sd(1:10)"))
+  expect_identical(xp_call_name(xml, depth = 2L, condition = "text() = 'sum'"), "sum")
+})
+
+test_that("xp_call_name input validation works", {
+  expect_error(xp_call_name(2L), "inherits(expr", fixed = TRUE)
+
+  xml <- xml2::read_xml("<a></a>")
+  expect_error(xp_call_name(xml, depth = -1L), "depth >= 0", fixed = TRUE)
+  expect_error(xp_call_name(xml, depth = "1"), "is.numeric(depth)", fixed = TRUE)
+  expect_error(xp_call_name(xml, condition = 1L), "is.character(condition)", fixed = TRUE)
+})