Consistent logic around magrittr pipes (#2046)

* catch all relevant pipes in pipe_call_linter()

* also in brace_linter()

* pipe_continuation_linter

* unnecessary_concatenation_linter

* unnecessary_placeholder_linter

* yoda_test_linter

* NEWS

* tidy up

* consistency in tests, remove %<>% from yoda_test

* use local()

* another test

Author: MichaelChirico

NAMESPACE

@@ -157,3 +157,5 @@ importFrom(utils,relist)
 importFrom(utils,tail)
 importFrom(xml2,as_list)
 importFrom(xml2,xml_find_all)
+importFrom(xml2,xml_find_first)
+importFrom(xml2,xml_text)

NEWS.md

@@ -8,6 +8,12 @@
 ## New and improved features
 
 * `library_call_linter()` can detect if all library calls are not at the top of your script (#2027, @nicholas-masel).
+* Linters with logic around the magrittr pipe `%>%` consistently apply it to the other pipes `%!>%`, `%T>%`, `%<>%` (and possibly `%$%`) where appropriate (#2008, @MichaelChirico).
+  + `brace_linter()`
+  + `pipe_call_linter()`
+  + `pipe_continuation_linter()`
+  + `unnecessary_concatenation_linter()`
+  + `unnecessary_placeholder_linter()`
 * Several linters avoiding false positives in `$` extractions get the same exceptions for `@` extractions, e.g. `S4@T` will no longer throw a `T_and_F_symbol_linter()` hit (#2039, @MichaelChirico).
   + `T_and_F_symbol_linter()`
   + `for_loop_index_linter()`

R/brace_linter.R

@@ -65,13 +65,13 @@ brace_linter <- function(allow_single_line = FALSE) {
     #
     # note that '{' is not supported in RHS call of base-R's native pipe (`|>`),
     # so no exception needs to be made for this operator
-    "not(
+    glue("not(
       @line1 > parent::expr/preceding-sibling::*[not(self::COMMENT)][1][
         self::OP-LEFT-PAREN
         or self::OP-COMMA
-        or (self::SPECIAL and text() = '%>%')
+        or (self::SPECIAL and ({xp_text_in_table(magrittr_pipes)}) )
       ]/@line2
-    )"
+    )")
   ))
 
   # TODO (AshesITR): if c_style_braces is TRUE, invert the preceding-sibling condition

R/lintr-package.R

@@ -12,7 +12,7 @@
 #' @importFrom rex rex regex re_matches re_substitutes character_class
 #' @importFrom stats na.omit
 #' @importFrom utils capture.output head getParseData relist
-#' @importFrom xml2 xml_find_all as_list
+#' @importFrom xml2 xml_find_all xml_find_first xml_text as_list
 #' @importFrom cyclocomp cyclocomp
 #' @importFrom utils tail
 #' @rawNamespace

R/pipe_call_linter.R

@@ -23,7 +23,8 @@ pipe_call_linter <- function() {
   # NB: the text() here shows up as %&gt;% but that's not matched, %>% is
   # NB: use *[1][self::SYMBOL] to ensure the first element is SYMBOL, otherwise
   #       we include expressions like x %>% .$col
-  xpath <- "//SPECIAL[text() = '%>%']/following-sibling::expr[*[1][self::SYMBOL]]"
+  pipes <- setdiff(magrittr_pipes, "%$%")
+  xpath <- glue("//SPECIAL[{ xp_text_in_table(pipes) }]/following-sibling::expr[*[1][self::SYMBOL]]")
 
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {
@@ -33,12 +34,16 @@ pipe_call_linter <- function() {
     xml <- source_expression$xml_parsed_content
 
     bad_expr <- xml2::xml_find_all(xml, xpath)
+    pipe <- xml_text(xml_find_first(bad_expr, "preceding-sibling::SPECIAL[1]"))
 
     xml_nodes_to_lints(
       bad_expr,
       source_expression = source_expression,
-      lint_message = "Use explicit calls in magrittr pipes, i.e., `a %>% foo` should be `a %>% foo()`.",
+      lint_message =
+        sprintf("Use explicit calls in magrittr pipes, i.e., `a %1$s foo` should be `a %1$s foo()`.", pipe),
       type = "warning"
     )
   })
 }
+
+magrittr_pipes <- c("%>%", "%!>%", "%T>%", "%$%", "%<>%")

R/pipe_continuation_linter.R

@@ -53,9 +53,10 @@ pipe_continuation_linter <- function() {
   # Where a single-line pipeline is nested inside a larger expression
   #   e.g. inside a function definition), the outer expression can span multiple lines
   #   without throwing a lint.
-  preceding_pipe <- "preceding-sibling::expr[1]/descendant::*[self::SPECIAL[text() = '%>%'] or self::PIPE]"
-  xpath <- glue::glue("
-  (//PIPE | //SPECIAL[text() = '%>%'])[
+  pipe_node <- glue("SPECIAL[{ xp_text_in_table(magrittr_pipes) }]")
+  preceding_pipe <- glue("preceding-sibling::expr[1]/descendant::*[self::{pipe_node} or self::PIPE]")
+  xpath <- glue("
+  (//PIPE | //{pipe_node})[
     parent::expr[@line1 < @line2]
     and {preceding_pipe}
     and (
@@ -73,7 +74,7 @@ pipe_continuation_linter <- function() {
     xml <- source_expression$full_xml_parsed_content
 
     pipe_exprs <- xml2::xml_find_all(xml, xpath)
-    pipe_text <- ifelse(xml2::xml_name(pipe_exprs) == "PIPE", "|>", "%>%")
+    pipe_text <- xml_text(pipe_exprs)
 
     xml_nodes_to_lints(
       pipe_exprs,

R/unnecessary_concatenation_linter.R

@@ -67,12 +67,13 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { #
 
   non_constant_cond <- "SYMBOL or (expr and not(OP-COLON and count(expr[SYMBOL or expr]) != 2))"
 
-  to_pipe_xpath <- "
+  pipes <- setdiff(magrittr_pipes, "%$%")
+  to_pipe_xpath <- glue("
     ./preceding-sibling::*[1][
       self::PIPE or
-      self::SPECIAL[text() = '%>%']
+      self::SPECIAL[{ xp_text_in_table(pipes) }]
     ]
-  "
+  ")
   if (allow_single_expression) {
     zero_arg_cond <-
       glue::glue("count(expr) = 1 and not( {to_pipe_xpath} / preceding-sibling::expr[ {non_constant_cond} ])")

R/unnecessary_placeholder_linter.R

@@ -34,8 +34,8 @@
 #' @export
 unnecessary_placeholder_linter <- function() {
   # TODO(michaelchirico): handle R4.2.0 native placeholder _ as well
-  xpath <- "
-  //SPECIAL[text() = '%>%' or text() = '%T>%' or text() = '%<>%']
+  xpath <- glue("
+  //SPECIAL[{ xp_text_in_table(magrittr_pipes) }]
     /following-sibling::expr[
       expr/SYMBOL_FUNCTION_CALL
       and not(expr[
@@ -47,7 +47,7 @@ unnecessary_placeholder_linter <- function() {
       SYMBOL[text() = '.']
       and not(preceding-sibling::*[1][self::EQ_SUB])
     ]
-  "
+  ")
 
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {

R/yoda_test_linter.R

@@ -45,11 +45,12 @@ yoda_test_linter <- function() {
     or (STR_CONST and not(OP-DOLLAR or OP-AT))
     or ((OP-PLUS or OP-MINUS) and count(expr[NUM_CONST]) = 2)
   "
-  xpath <- glue::glue("
+  pipes <- setdiff(magrittr_pipes, c("%$%", "%<>%"))
+  xpath <- glue("
   //SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical' or text() = 'expect_setequal']
     /parent::expr
     /following-sibling::expr[1][ {const_condition} ]
-    /parent::expr[not(preceding-sibling::*[self::PIPE or self::SPECIAL[text() = '%>%']])]
+    /parent::expr[not(preceding-sibling::*[self::PIPE or self::SPECIAL[{ xp_text_in_table(pipes) }]])]
   ")
 
   second_const_xpath <- glue::glue("expr[position() = 3 and ({const_condition})]")

tests/testthat/helper.R

@@ -61,3 +61,16 @@ skip_if_not_r_version <- function(min_version) {
 skip_if_not_utf8_locale <- function() {
   testthat::skip_if_not(l10n_info()[["UTF-8"]], "Not a UTF-8 locale")
 }
+
+pipes <- function(exclude = NULL) {
+  if (getRversion() < "4.1.0") exclude <- unique(c(exclude, "|>"))
+  all_pipes <- c(
+    standard = "%>%",
+    greedy = "%!>%",
+    tee = "%T>%",
+    assignment = "%<>%",
+    extraction = "%$%",
+    native = "|>"
+  )
+  all_pipes[!all_pipes %in% exclude]
+}

tests/testthat/test-brace_linter.R

@@ -470,7 +470,7 @@ test_that("code with pipes is handled correctly", {
 
   expect_lint(
     trim_some("
-      1:4 %>% {
+      1:4 %!>% {
           sum(.)
         }
     "),
@@ -481,7 +481,7 @@ test_that("code with pipes is handled correctly", {
   # %>%\n{ is allowed
   expect_lint(
     trim_some("
-      1:4 %>%
+      1:4 %T>%
         {
           sum(.)
         }
@@ -492,7 +492,7 @@ test_that("code with pipes is handled correctly", {
 
   expect_lint(
     trim_some("
-      1:4 %>% { sum(.)
+      xx %<>% { sum(.)
         }
     "),
     list(
@@ -503,9 +503,9 @@ test_that("code with pipes is handled correctly", {
 
   expect_lint(
     trim_some("
-      1:4 %>%
+      x %>%
         {
-          sum(.) }
+          uvwxyz }
     "),
     list(
       list(message = lint_msg_closed, line_number = 3L, column_number = 12L)

tests/testthat/test-pipe_call_linter.R

@@ -26,6 +26,9 @@ test_that("pipe_call_linter skips allowed usages", {
   }
   ")
   expect_lint(lines, NULL, linter)
+
+  # extraction pipe uses RHS symbols
+  expect_lint("a %$% b", NULL, linter)
 })
 
 test_that("pipe_call_linter blocks simple disallowed usages", {
@@ -58,3 +61,31 @@ test_that("pipe_call_linter blocks simple disallowed usages", {
     pipe_call_linter()
   )
 })
+
+local({
+  pipes <- pipes(exclude = c("%$%", "|>"))
+  linter <- pipe_call_linter()
+  patrick::with_parameters_test_that(
+    "All pipe operators are caught",
+    {
+      expect_lint(sprintf("a %s foo()", pipe), NULL, linter)
+      expect_lint(sprintf("a %s foo", pipe), sprintf("`a %s foo`", pipe), linter)
+    },
+    pipe = pipes,
+    .test_name = names(pipes)
+  )
+})
+
+test_that("Multiple lints give custom messages", {
+  expect_lint(
+    trim_some("
+      a %>% b
+      c %T>% d
+    "),
+    list(
+      list(message = "%>%", line_number = 1L),
+      list(message = "%T>%", line_number = 2L)
+    ),
+    pipe_call_linter()
+  )
+})

tests/testthat/test-pipe_continuation_linter.R

@@ -188,3 +188,21 @@ local({
     code_string = valid_code
   )
 })
+
+local({
+  linter <- pipe_continuation_linter()
+  pipes <- pipes()
+  cases <- expand.grid(pipe1 = pipes, pipe2 = pipes, stringsAsFactors = FALSE)
+  cases <- within(cases, {
+    .test_name <- sprintf("(%s, %s)", pipe1, pipe2)
+  })
+  patrick::with_parameters_test_that(
+    "Various pipes are linted correctly",
+    expect_lint(
+      sprintf("a %s b() %s\n  c()", pipe1, pipe2),
+      rex::rex(sprintf("`%s` should always have a space before it", pipe2)),
+      linter
+    ),
+    .cases = cases
+  )
+})

tests/testthat/test-unnecessary_concatenation_linter.R

@@ -45,34 +45,26 @@ test_that("unnecessary_concatenation_linter blocks disallowed usages", {
   )
 })
 
-test_that("Correctly handles concatenation within magrittr pipes", {
+local({
+  pipes <- pipes(exclude = "%$%")
   linter <- unnecessary_concatenation_linter()
-  expect_lint('"a" %>% c("b")', NULL, linter)
-  expect_lint(
-    '"a" %>% c()',
-    "Unneeded concatenation of a constant",
-    linter
-  )
-  expect_lint(
-    '"a" %>% list("b", c())',
-    "Unneeded concatenation without arguments",
-    linter
-  )
-})
-
-test_that("Correctly handles concatenation within native pipes", {
-  skip_if_not_r_version("4.1.0")
-  linter <- unnecessary_concatenation_linter()
-  expect_lint('"a" |> c("b")', NULL, linter)
-  expect_lint(
-    '"a" |> c()',
-    "Unneeded concatenation of a constant",
-    linter
-  )
-  expect_lint(
-    '"a" |> list("b", c())',
-    "Unneeded concatenation without arguments",
-    linter
+  patrick::with_parameters_test_that(
+    "Correctly handles concatenation within magrittr pipes",
+    {
+      expect_lint(sprintf('"a" %s c("b")', pipe), NULL, linter)
+      expect_lint(
+        sprintf('"a" %s c()', pipe),
+        "Unneeded concatenation of a constant",
+        linter
+      )
+      expect_lint(
+        sprintf('"a" %s list("b", c())', pipe),
+        "Unneeded concatenation without arguments",
+        linter
+      )
+    },
+    pipe = pipes,
+    .test_name = names(pipes)
   )
 })
 

tests/testthat/test-unnecessary_placeholder_linter.R

@@ -1,8 +1,9 @@
+linter <- unnecessary_placeholder_linter()
+pipes <- pipes(exclude = "|>")
+
 patrick::with_parameters_test_that(
   "unnecessary_placeholder_linter skips allowed usages",
   {
-    linter <- unnecessary_placeholder_linter()
-
     # . used in position other than first --> ok
     expect_lint(sprintf("x %s foo(y, .)", pipe), NULL, linter)
     # ditto for nested usage
@@ -14,14 +15,13 @@ patrick::with_parameters_test_that(
     # . used inside a scope --> ok
     expect_lint(sprintf("x %s { foo(arg = .) }", pipe), NULL, linter)
   },
-  .test_name = c("forward", "assignment", "tee"),
-  pipe = c("%>%", "%<>%", "%T>%")
+  .test_name = names(pipes),
+  pipe = pipes
 )
 
 patrick::with_parameters_test_that(
   "unnecessary_placeholder_linter blocks simple disallowed usages",
   {
-    linter <- unnecessary_placeholder_linter()
     expect_lint(
       sprintf("x %s sum(.)", pipe),
       rex::rex("Don't use the placeholder (`.`) when it's not needed"),
@@ -34,6 +34,6 @@ patrick::with_parameters_test_that(
       unnecessary_placeholder_linter()
     )
   },
-  .test_name = c("forward", "assignment", "tee"),
-  pipe = c("%>%", "%<>%", "%T>%")
+  .test_name = names(pipes),
+  pipe = pipes
 )

tests/testthat/test-yoda_test_linter.R

@@ -38,10 +38,15 @@ test_that("yoda_test_linter ignores strings in $ expressions", {
 })
 
 # if we only inspect the first argument & ignore context, get false positives
-test_that("yoda_test_linter ignores usage in pipelines", {
-  expect_lint("foo() %>% expect_identical(2)", NULL, yoda_test_linter())
-  skip_if_not_r_version("4.1.0")
-  expect_lint("bar() |> expect_equal('a')", NULL, yoda_test_linter())
+local({
+  pipes <- pipes(exclude = c("%<>%", "%$%"))
+  linter <- yoda_test_linter()
+  patrick::with_parameters_test_that(
+    "yoda_test_linter ignores usage in pipelines",
+    expect_lint(sprintf("foo() %s expect_identical(2)", pipe), NULL, linter),
+    pipe = pipes,
+    .test_name = names(pipes)
+  )
 })
 
 test_that("yoda_test_linter throws a special message for placeholder tests", {