refactor xml_nodes_to_lints() lint location to XPath (#1234)

* refactor xml_nodes_to_lints() lint location to XPath

* add commas_linter() test with location info

* document(), test xml_nodes_to_lints()

* update other tests to unnamed Lint()$line

* remove redundant test

* refactor spaces_inside_linter() to use xml_nodes_to_lints()

* tidy style, default column_number_xpath to range_start_xpath

* codoc

* doc + comments

* accept list<xml_node> in xml_nodes_to_lints() and compact spaces_inside_linter() even more

* test list<xml_node>

* must -> are assumed to

* de-lint

* doc formatting

DESCRIPTION

@@ -141,6 +141,7 @@ Collate:
     'vector_logic_linter.R'
     'with.R'
     'with_id.R'
+    'xml_nodes_to_lints.R'
     'xp_utils.R'
     'yoda_test_linter.R'
     'zzz.R'

R/T_and_F_symbol_linter.R

@@ -50,7 +50,8 @@ T_and_F_symbol_linter <- function() { # nolint: object_name.
           sprintf(fmt, replacement_map[[symbol]], symbol)
         },
         type = "style",
-        match_after_end = TRUE
+        column_number_xpath = "number(./@col2 + 1)", # mark at end
+        range_end_xpath = "number(./@col2 + 1)" # end after T/F for easy fixing
       )
     }
 

R/commas_linter.R

@@ -24,12 +24,16 @@ commas_linter <- function() {
     before_lints <- xml_nodes_to_lints(
       xml2::xml_find_all(xml, xpath_before),
       source_expression = source_expression,
-      lint_message = "Commas should never have a space before."
+      lint_message = "Commas should never have a space before.",
+      range_start_xpath = "number(./preceding-sibling::*[1]/@col2 + 1)", # start after preceding expression
+      range_end_xpath = "number(./@col1 - 1)" # end before comma
     )
     after_lints <- xml_nodes_to_lints(
       xml2::xml_find_all(xml, xpath_after),
       source_expression = source_expression,
-      lint_message = "Commas should always have a space after."
+      lint_message = "Commas should always have a space after.",
+      range_start_xpath = "number(./@col2 + 1)", # start and end after comma
+      range_end_xpath = "number(./@col2 + 1)"
     )
 
     c(before_lints, after_lints)

R/implicit_integer_linter.R

@@ -20,7 +20,8 @@ implicit_integer_linter <- function() {
       source_expression = source_expression,
       lint_message = "Integers should not be implicit. Use the form 1L for integers or 1.0 for doubles.",
       type = "style",
-      match_after_end = TRUE
+      column_number_xpath = "number(./@col2 + 1)", # mark at end
+      range_end_xpath = "number(./@col2 + 1)" # end after number for easy fixing (enter "L" or ".0")
     )
   })
 }

R/spaces_inside_linter.R

@@ -35,43 +35,25 @@ spaces_inside_linter <- function() {
     xml <- source_expression$full_xml_parsed_content
 
     left_expr <- xml2::xml_find_all(xml, left_xpath)
-    left_lints <- lapply(left_expr, function(expr) {
-      line1 <- as.integer(xml2::xml_attr(expr, "line1"))
-      col1 <- as.integer(xml2::xml_attr(expr, "col1")) + 1L
-      col2 <- as.integer(xml2::xml_find_num(expr, "number(./following-sibling::*[1]/@col1)")) - 1L
-      Lint(
-        filename = source_expression$filename,
-        line_number = line1,
-        column_number = col1,
-        message = switch(
-          xml2::xml_text(expr),
-          `[` = "Do not place spaces after square brackets.",
-          `(` = "Do not place spaces after parentheses."
-        ),
-        line = source_expression$file_lines[[line1]],
-        ranges = list(c(col1, col2))
-      )
-    })
+    left_msg <- ifelse(
+      xml2::xml_text(left_expr) == "[",
+      "Do not place spaces after square brackets.",
+      "Do not place spaces after parentheses."
+    )
 
     right_expr <- xml2::xml_find_all(xml, right_xpath)
-    right_lints <- lapply(right_expr, function(expr) {
-      line1 <- as.integer(xml2::xml_attr(expr, "line1"))
-      col1 <- as.integer(xml2::xml_attr(expr, "col2")) + 1L
-      col2 <- as.integer(xml2::xml_find_num(expr, "number(./following-sibling::*[1]/@col1)")) - 1L
-      Lint(
-        filename = source_expression$filename,
-        line_number = line1,
-        column_number = col1,
-        message = switch(
-          xml2::xml_find_chr(expr, "string(./following-sibling::*[1])"),
-          `]` = "Do not place spaces before square brackets.",
-          `)` = "Do not place spaces before parentheses."
-        ),
-        line = source_expression$file_lines[[line1]],
-        ranges = list(c(col1, col2))
-      )
-    })
+    right_msg <- ifelse(
+      xml2::xml_find_chr(right_expr, "string(./following-sibling::*[1])") == "]",
+      "Do not place spaces before square brackets.",
+      "Do not place spaces before parentheses."
+    )
 
-    c(left_lints, right_lints)
+    xml_nodes_to_lints(
+      c(left_expr, right_expr),
+      source_expression = source_expression,
+      lint_message = c(left_msg, right_msg),
+      range_start_xpath = "number(./@col2 + 1)", # start after expression
+      range_end_xpath = "number(./following-sibling::*[1]/@col1 - 1)" # end before following ]
+    )
   })
 }

R/xml_nodes_to_lints.R

@@ -0,0 +1,106 @@
+#' Convert an XML node or nodeset into a Lint
+#'
+#' Convenience function for converting nodes matched by XPath-based
+#'   linter logic into a [Lint()] object to return.
+#'
+#' @details
+#' The location XPaths, `column_number_xpath`, `range_start_xpath` and `range_end_xpath` are evaluated using
+#' [xml2::xml_find_num()] and will usually be of the form `"number(./relative/xpath)"`.
+#' Note that the location line number cannot be changed and lints spanning multiple lines will ignore `range_end_xpath`.
+#' `column_number_xpath` and `range_start_xpath` are assumed to always refer to locations on the starting line of the
+#' `xml` node.
+#'
+#' @inheritParams lint-s3
+#' @param xml An `xml_node` object (to generate one `Lint`) or an
+#'   `xml_nodeset` object (to generate several `Lint`s), e.g. as returned by
+#'   [xml2::xml_find_all()] or [xml2::xml_find_first()] or a
+#'   list of `xml_node` objects.
+#' @param source_expression A source expression object, e.g. as
+#'   returned typically by [lint()], or more generally
+#'   by [get_source_expressions()].
+#' @param lint_message The message to be included as the `message`
+#'   to the `Lint` object. If `lint_message` is a `function`,
+#'   this function is first applied to `xml` (so it should be a
+#'   function taking an `xml_node` as input and must produce a
+#'   length-1 character as output). If `lint_message` is a character vector the same length as `xml`,
+#'   the `i`-th lint will be given the `i`-th message.
+#' @param column_number_xpath XPath expression to return the column number location of the lint.
+#'   Defaults to the start of the range matched by `range_start_xpath`. See details for more information.
+#' @param range_start_xpath XPath expression to return the range start location of the lint.
+#'   Defaults to the start of the expression matched by `xml`. See details for more information.
+#' @param range_end_xpath XPath expression to return the range end location of the lint.
+#'   Defaults to the end of the expression matched by `xml`. See details for more information.
+#'
+#' @return For `xml_node`s, a `lint`. For `xml_nodeset`s, `lints` (a list of `lint`s).
+#' @export
+xml_nodes_to_lints <- function(xml, source_expression, lint_message,
+                               type = c("style", "warning", "error"),
+                               column_number_xpath = range_start_xpath,
+                               range_start_xpath = "number(./@col1)",
+                               range_end_xpath = "number(./@col2)") {
+  if (length(xml) == 0L) {
+    return(list())
+  }
+  if (is_nodeset_like(xml)) {
+    if (is.character(lint_message)) {
+      lints <- .mapply(
+        xml_nodes_to_lints,
+        dots = list(xml = xml, lint_message = lint_message),
+        MoreArgs = list(
+          source_expression = source_expression,
+          type = type,
+          column_number_xpath = column_number_xpath,
+          range_start_xpath = range_start_xpath,
+          range_end_xpath = range_end_xpath
+        )
+      )
+    } else {
+      lints <- lapply(
+        xml, xml_nodes_to_lints,
+        source_expression = source_expression,
+        lint_message = lint_message,
+        type = type,
+        column_number_xpath = column_number_xpath,
+        range_start_xpath = range_start_xpath,
+        range_end_xpath = range_end_xpath
+      )
+    }
+    class(lints) <- "lints"
+    return(lints)
+  } else if (!inherits(xml, "xml_node")) {
+    stop(
+      "Expected an xml_nodeset, a list of xml_nodes or an xml_node, got an object of class(es): ",
+      toString(class(xml))
+    )
+  }
+  type <- match.arg(type, c("style", "warning", "error"))
+  line1 <- xml2::xml_attr(xml, "line1")
+  col1 <- as.integer(xml2::xml_find_num(xml, range_start_xpath))
+
+  lines <- source_expression[["lines"]]
+  if (is.null(lines)) lines <- source_expression[["file_lines"]]
+
+  if (xml2::xml_attr(xml, "line2") == line1) {
+    col2 <- as.integer(xml2::xml_find_num(xml, range_end_xpath))
+  } else {
+    col2 <- nchar(lines[[line1]])
+  }
+
+  column_number <- as.integer(xml2::xml_find_num(xml, column_number_xpath))
+
+  if (is.function(lint_message)) lint_message <- lint_message(xml)
+  Lint(
+    filename = source_expression$filename,
+    line_number = as.integer(line1),
+    column_number = column_number,
+    type = type,
+    message = lint_message,
+    line = lines[[line1]],
+    ranges = list(c(col1, col2))
+  )
+}
+
+is_nodeset_like <- function(xml) {
+  inherits(xml, "xml_nodeset") ||
+    (is.list(xml) && all(vapply(xml, inherits, logical(1L), what = "xml_node")))
+}

R/xp_utils.R

@@ -11,84 +11,6 @@ xp_text_in_table <- function(table) {
   return(paste0("text() = ", table, collapse = " or "))
 }
 
-#' Convert an XML node or nodeset into a Lint
-#'
-#' Convenience function for converting nodes matched by XPath-based
-#'   linter logic into a [Lint()] object to return.
-#'
-#' @inheritParams lint-s3
-#' @param xml An `xml_node` object (to generate one `Lint`) or an
-#'   `xml_nodeset` object (to generate several `Lint`s), e.g. as returned by
-#'   [xml2::xml_find_all()] or [xml2::xml_find_first()].
-#' @param source_expression A source expression object, e.g. as
-#'   returned typically by [lint()], or more generally
-#'   by [get_source_expressions()].
-#' @param lint_message The message to be included as the `message`
-#'   to the `Lint` object. If `lint_message` is a `function`,
-#'   this function is first applied to `xml` (so it should be a
-#'   function taking an `xml_node` as input and must produce a
-#'   length-1 character as output). If `lint_message` is a character vector the same length as `xml`,
-#'   the `i`-th lint will be given the `i`-th message.
-#' @param match_after_end Logical, default `FALSE`. If `TRUE`,
-#'   The output `column_number` and `ranges[2L]` are set to _after_ the matched
-#'   symbol in `xml`. This can be convenient for setting the source marker
-#'   to land the editor's cursor exactly to the spot where corrected code can be
-#'   entered. For example, in [T_and_F_symbol_linter()], in code using `T`, the
-#'   cursor lands _after_ `T` so that `RUE` and be entered without further adjustment.
-#' @return For `xml_node`s, a `lint`. For `xml_nodeset`s, `lints` (a list of `lint`s).
-#' @export
-xml_nodes_to_lints <- function(xml, source_expression, lint_message,
-                               type = c("style", "warning", "error"),
-                               match_after_end = FALSE) {
-  if (length(xml) == 0L) {
-    return(list())
-  }
-  if (inherits(xml, "xml_nodeset")) {
-    if (is.character(lint_message)) {
-      lints <- .mapply(
-        xml_nodes_to_lints,
-        dots = list(xml = xml, lint_message = lint_message),
-        MoreArgs = list(source_expression = source_expression, type = type, match_after_end = match_after_end)
-      )
-    } else {
-      lints <- lapply(xml, xml_nodes_to_lints, source_expression, lint_message, type, match_after_end)
-    }
-    class(lints) <- "lints"
-    return(lints)
-  } else if (!inherits(xml, "xml_node")) {
-    stop("Expected an xml_nodeset or xml_node, got an object of class(es): ", toString(class(xml)))
-  }
-  type <- match.arg(type, c("style", "warning", "error"))
-  line1 <- xml2::xml_attr(xml, "line1")
-  col1 <- as.integer(xml2::xml_attr(xml, "col1"))
-
-  lines <- source_expression[["lines"]]
-  if (is.null(lines)) lines <- source_expression[["file_lines"]]
-
-  if (xml2::xml_attr(xml, "line2") == line1) {
-    col2 <- as.integer(xml2::xml_attr(xml, "col2"))
-  } else {
-    col2 <- unname(nchar(lines[line1]))
-  }
-
-  if (match_after_end) {
-    column_number <- col2 <- col2 + 1L
-  } else {
-    column_number <- col1
-  }
-
-  if (is.function(lint_message)) lint_message <- lint_message(xml)
-  Lint(
-    filename = source_expression$filename,
-    line_number = as.integer(line1),
-    column_number = column_number,
-    type = type,
-    message = lint_message,
-    line = lines[line1],
-    ranges = list(c(col1, col2))
-  )
-}
-
 paren_wrap <- function(..., sep) {
   sep <- paste(")", sep, "(")
   dots <- list(...)

tests/testthat/test-commas_linter.R

@@ -36,4 +36,13 @@ test_that("returns the correct linting", {
   expect_lint("switch(op , x = foo, y = bar)", msg_before, linter)
   expect_lint("switch(op, x = foo, y = bar(a = 4 , b = 5))", msg_before, linter)
   expect_lint("fun(op, x = foo , y = switch(bar, a = 4, b = 5))", msg_before, linter)
+
+  expect_lint(
+    "fun(op    ,bar)",
+    list(
+      list(message = msg_before, column_number = 7L, ranges = list(c(7L, 10L))),
+      list(message = msg_after, column_number = 12L, ranges = list(c(12L, 12L)))
+    ),
+    linter
+  )
 })

tests/testthat/test-namespace_linter.R

@@ -85,7 +85,7 @@ test_that("returns the correct linting", {
 
   expect_lint(
     "stats::sd(c(1,2,3))\nstats::sdd(c(1,2,3))",
-    list(line = c("2" = "stats::sdd(c(1,2,3))")),
+    list(line = "stats::sdd(c(1,2,3))"),
     namespace_linter()
   )
 })

tests/testthat/test-paren_body_linter.R

@@ -28,7 +28,7 @@ testthat::test_that("paren_body_linter returns correct lints", {
       line_number = 1L,
       column_number = 11L,
       type = "style",
-      line = c("1" = "function()test"),
+      line = "function()test",
       ranges = list(c(11L, 14L))
     ),
     linter