New one_call_pipe_linter

DESCRIPTION

@@ -142,6 +142,7 @@ Collate:
     'object_length_linter.R'
     'object_name_linter.R'
     'object_usage_linter.R'
+    'one_call_pipe_linter.R'
     'outer_negation_linter.R'
     'package_hooks_linter.R'
     'paren_body_linter.R'

NAMESPACE

@@ -104,6 +104,7 @@ export(numeric_leading_zero_linter)
 export(object_length_linter)
 export(object_name_linter)
 export(object_usage_linter)
+export(one_call_pipe_linter)
 export(open_curly_linter)
 export(outer_negation_linter)
 export(package_hooks_linter)

R/one_call_pipe_linter.R

@@ -0,0 +1,63 @@
+#' Block single-call magrittr pipes
+#'
+#' Prefer using a plain call instead of a pipe with only one call,
+#'   i.e. `1:10 %>% sum()` should instead be `sum(1:10)`. Note that
+#'   calls in the first `%>%` argument count. `rowSums(x) %>% max()` is OK
+#'   because there are two total calls (`rowSums()` and `max()`).
+#'
+#' Note also that un-"called" steps are *not* counted, since they should
+#'   be calls (see [pipe_call_linter()]).
+#'
+#' @evalRd rd_tags("one_call_pipe_linter")
+#' @seealso
+#' - [linters] for a complete list of linters available in lintr.
+#' - <https://style.tidyverse.org/pipes.html#short-pipes>
+#' @export
+one_call_pipe_linter <- function() {
+  pipes_cond <- xp_text_in_table(c("%>%", "%$%", "%T>%"))
+
+  # preceding-sibling::SPECIAL: if there are ever two pipes, don't lint
+  # OP-LEFT-BRACKET/LBB: accept DT[...] %>% .[...] as a two-call pipe,
+  #   (but not DT %>% .[...])
+  # parent::expr/SPECIAL: make sure we are at the top of a pipeline
+  # count(): any call anywhere else in the AST within the pipe expression
+  # TODO(michaelchirico): Add support for native pipe |> like DT |> _[...]
+  xpath <- glue("
+  //SPECIAL[
+    ({ pipes_cond })
+    and not(preceding-sibling::expr[1]/SPECIAL[{ xp_text_in_table(magrittr_pipes) }])
+    and (
+      not(following-sibling::expr[OP-LEFT-BRACKET or LBB])
+      or not(preceding-sibling::expr[OP-LEFT-BRACKET or LBB])
+    )
+  ]
+    /parent::expr[
+      not(parent::expr/SPECIAL[{ pipes_cond }])
+      and count(.//SYMBOL_FUNCTION_CALL) <= 1
+    ]
+  |
+  //PIPE[not(preceding-sibling::expr[1]/PIPE)]
+    /parent::expr[
+      not(parent::expr/PIPE)
+      and count(.//SYMBOL_FUNCTION_CALL) <= 1
+    ]
+  ")
+
+  Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+
+    xml <- source_expression$xml_parsed_content
+
+    bad_expr <- xml_find_all(xml, xpath)
+    pipe <- xml_find_chr(bad_expr, "string(SPECIAL | PIPE)")
+
+    xml_nodes_to_lints(
+      bad_expr,
+      source_expression = source_expression,
+      lint_message = paste0("Expressions with only a single call shouldn't use pipe ", pipe, "."),
+      type = "warning"
+    )
+  })
+}

inst/lintr/linters.csv

@@ -61,6 +61,7 @@ numeric_leading_zero_linter,style consistency readability
 object_length_linter,style readability default configurable executing
 object_name_linter,style consistency default configurable executing
 object_usage_linter,style readability correctness default executing configurable
+one_call_pipe_linter,style readability
 open_curly_linter,style readability deprecated configurable
 outer_negation_linter,readability efficiency best_practices
 package_hooks_linter,style correctness package_development

tests/testthat/test-one_call_pipe_linter.R

@@ -0,0 +1,97 @@
+test_that("one_call_pipe_linter skips allowed usages", {
+  linter <- one_call_pipe_linter()
+
+  # two pipe steps is OK
+  expect_lint("x %>% foo() %>% bar()", NULL, linter)
+  # call in first step --> OK
+  expect_lint("foo(x) %>% bar()", NULL, linter)
+  # both calls in second step --> OK
+  expect_lint("x %>% foo(bar(.))", NULL, linter)
+})
+
+test_that("one_call_pipe_linter blocks simple disallowed usages", {
+  linter <- one_call_pipe_linter()
+  lint_msg <- rex::rex("Expressions with only a single call shouldn't use pipe %>%.")
+
+  expect_lint("x %>% foo()", lint_msg, linter)
+
+  # new lines don't matter
+  expect_lint("x %>%\n  foo()", lint_msg, linter)
+
+  # catch the "inner" pipe chain, not the "outer" one
+  # TODO(michaelchirico): actually, this should lint twice -- we're too aggressive
+  #   in counting _all_ nested calls.
+  expect_lint("x %>% inner_join(y %>% filter(is_treatment))", lint_msg, linter)
+})
+
+test_that("one_call_pipe_linter skips data.table chains", {
+  linter <- one_call_pipe_linter()
+  lint_msg <- rex::rex("Expressions with only a single call shouldn't use pipe %>%.")
+
+  expect_lint("DT[x > 5, sum(y), by = keys] %>% .[, .SD[1], by = key1]", NULL, linter)
+
+  # lint here: instead of a pipe, use DT[x > 5, sum(y), by = keys]
+  expect_lint("DT %>% .[x > 5, sum(y), by = keys]", lint_msg, linter)
+
+  # ditto for [[
+  expect_lint("DT %>% rowSums() %>% .[[idx]]", NULL, linter)
+
+  expect_lint("DT %>% .[[idx]]", lint_msg, linter)
+})
+
+test_that("one_call_pipe_linter treats all pipes equally", {
+  linter <- one_call_pipe_linter()
+
+  expect_lint("foo %>% bar() %$% col", NULL, linter)
+  expect_lint(
+    "x %T>% foo()",
+    rex::rex("Expressions with only a single call shouldn't use pipe %T>%."),
+    linter
+  )
+  expect_lint(
+    "x %$%\n  foo()",
+    rex::rex("Expressions with only a single call shouldn't use pipe %$%."),
+    linter
+  )
+  expect_lint(
+    'data %>% filter(type == "console") %$% obscured_gaia_id %>% unique()',
+    NULL,
+    linter
+  )
+})
+
+test_that("multiple lints are generated correctly", {
+  expect_lint(
+    trim_some("{
+      a %>% b()
+      c %$% d()
+      e %T>% f()
+    }"),
+    list(
+      list(message = "pipe %>%"),
+      list(message = "pipe %\\$%"),
+      list(message = "pipe %T>%")
+    ),
+    one_call_pipe_linter()
+  )
+})
+
+test_that("Native pipes are handled as well", {
+  expect_lint(
+    "x |> foo()",
+    rex::rex("Expressions with only a single call shouldn't use pipe |>."),
+    one_call_pipe_linter()
+  )
+
+  expect_lint(
+    trim_some("{
+      a %>% b()
+      c |> d()
+    }"),
+    list(
+      list(message = "pipe %>%"),
+      list(message = "pipe |>")
+    ),
+    one_call_pipe_linter()
+  )
+})