Add pipe consistency linter

DESCRIPTION

@@ -147,6 +147,7 @@ Collate:
     'paste_linter.R'
     'path_utils.R'
     'pipe_call_linter.R'
+    'pipe_consistency_linter.R'
     'pipe_continuation_linter.R'
     'quotes_linter.R'
     'redundant_equals_linter.R'

NAMESPACE

@@ -110,6 +110,7 @@ export(paren_body_linter)
 export(paren_brace_linter)
 export(paste_linter)
 export(pipe_call_linter)
+export(pipe_consistency_linter)
 export(pipe_continuation_linter)
 export(quotes_linter)
 export(redundant_equals_linter)

R/pipe_consistency_linter.R

@@ -0,0 +1,82 @@
+#' Pipe consistency linter
+#'
+#' Check that pipe operators are used consistently by file, or optionally
+#' specify one valid pipe operator.
+#'
+#' @param pipe Which pipe operator is valid (either `"%>%"` or `"|>"`). By default
+#' (`"auto"`), the linter has no preference but will check that each file uses
+#' only one type of pipe operator.
+#'
+#' @examples
+#' # will produce lints
+#' lint(
+#'   text = "1:3 |> mean() %>% as.character()",
+#'   linters = pipe_consistency_linter()
+#' )
+#'
+#' lint(
+#'   text = "1:3 %>% mean() %>% as.character()",
+#'   linters = pipe_consistency_linter("|>")
+#' )
+#'
+#' # okay
+#' lint(
+#'   text = "1:3 %>% mean() %>% as.character()",
+#'   linters = pipe_consistency_linter()
+#' )
+#'
+#' lint(
+#'  text = "1:3 |> mean() |> as.character()",
+#'  linters = pipe_consistency_linter()
+#' )
+#' @evalRd rd_tags("pipe_consistency_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+pipe_consistency_linter <- function(pipe = c("auto", "%>%", "|>")) {
+  pipe <- match.arg(pipe)
+
+  xpath_magrittr <- glue("//SPECIAL[{ xp_text_in_table(magrittr_pipes) }]")
+  xpath_native <- "//PIPE"
+
+  Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "file")) {
+      return(list())
+    }
+
+    xml <- source_expression$full_xml_parsed_content
+
+    match_magrittr <- xml_find_all(xml, xpath_magrittr)
+    match_native <- xml_find_all(xml, xpath_native)
+
+    n_magrittr <- length(match_magrittr)
+    n_native <- length(match_native)
+
+    if (pipe == "auto" && n_magrittr > 0L && n_native > 0L) {
+      xml_nodes_to_lints(
+        xml = c(match_magrittr, match_native),
+        source_expression = source_expression,
+        lint_message = glue(
+          "Found {n_magrittr} instances of %>% and {n_native} instances of |>. ",
+          "Stick to one pipe operator."
+        ),
+        type = "style"
+      )
+    } else if (pipe == "%>%" && n_native > 0L) {
+      xml_nodes_to_lints(
+        xml = match_native,
+        source_expression = source_expression,
+        lint_message = "Use the %>% pipe operator instead of the |> pipe operator.",
+        type = "style"
+      )
+    } else if (pipe == "|>" && n_magrittr > 0L) {
+      xml_nodes_to_lints(
+        xml = match_magrittr,
+        source_expression = source_expression,
+        lint_message = "Use the |> pipe operator instead of the %>% pipe operator.",
+        type = "style"
+      )
+    } else {
+      list()
+    }
+  })
+}

inst/lintr/linters.csv

@@ -67,6 +67,7 @@ paren_body_linter,style readability default
 paren_brace_linter,style readability deprecated
 paste_linter,best_practices consistency configurable
 pipe_call_linter,style readability
+pipe_consistency_linter,style readability configurable
 pipe_continuation_linter,style readability default
 quotes_linter,style consistency readability default configurable
 redundant_equals_linter,best_practices readability efficiency common_mistakes

tests/testthat/test-pipe-consistency-linter.R

@@ -0,0 +1,168 @@
+test_that("pipe_consistency skips allowed usage", {
+  skip_if_not_r_version("4.1.0")
+  linter <- pipe_consistency_linter()
+
+  expect_lint("1:3 %>% mean() %>% as.character()", NULL, linter)
+  expect_lint("1:3 |> mean() |> as.character()", NULL, linter)
+  # With no pipes
+  expect_lint("x <- 1:5", NULL, linter)
+  # Across multiple lines
+  expect_lint(
+    trim_some("
+      1:3 %>%
+        mean() %>%
+        as.character()
+    "),
+    NULL,
+    linter
+  )
+})
+
+test_that("pipe_consistency lints inconsistent usage", {
+  skip_if_not_r_version("4.1.0")
+  linter <- pipe_consistency_linter()
+  expected_msg <- rex("Found 1 instances of %>% and 1 instances of |>. Stick to one pipe operator.")
+
+  expect_lint(
+    "1:3 |> mean() %>% as.character()",
+    list(
+      list(message = expected_msg, line_number = 1L, column_number = 5L),
+      list(message = expected_msg, line_number = 1L, column_number = 15L)
+    ),
+    linter
+  )
+
+  expect_lint(
+    "1:3 %>% mean() |> as.character()",
+    list(
+      list(message = expected_msg, line_number = 1L, column_number = 5L),
+      list(message = expected_msg, line_number = 1L, column_number = 16L)
+    ),
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      1:3 %>%
+        mean() |>
+        as.character()
+    "),
+    list(
+      list(message = expected_msg, line_number = 1L, column_number = 5L),
+      list(message = expected_msg, line_number = 2L, column_number = 10L)
+    ),
+    linter
+  )
+
+  expected_msg_multi <- rex("Found 1 instances of %>% and 2 instances of |>. Stick to one pipe operator.")
+  expect_lint(
+    "1:3 |> sort() |> mean() %>% as.character()",
+    list(
+      list(message = expected_msg_multi, line_number = 1L, column_number = 5L),
+      list(message = expected_msg_multi, line_number = 1L, column_number = 15L),
+      list(message = expected_msg_multi, line_number = 1L, column_number = 25L)
+    ),
+    linter
+  )
+})
+
+
+test_that("pipe_consistency_linter works with |> argument", {
+  skip_if_not_r_version("4.1.0")
+
+  linter <- pipe_consistency_linter(pipe = "|>")
+  expected_message <- rex("Use the |> pipe operator instead of the %>% pipe operator.")
+
+  expect_lint(
+    trim_some("
+      1:3 %>%
+        mean() %>%
+        as.character()
+    "),
+    list(
+      list(message = expected_message, line_number = 1L, column_number = 5L),
+      list(message = expected_message, line_number = 2L, column_number = 10L)
+    ),
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      1:3 |>
+        mean() %>%
+        as.character()
+    "),
+    list(message = expected_message, line_number = 2L, column_number = 10L),
+    linter
+  )
+
+  expect_lint(
+    "1:3 |> mean() |> as.character()",
+    NULL,
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      1:3 |>
+        mean() %>%
+        as.character()
+    "),
+    list(message = expected_message, line_number = 2L, column_number = 10L),
+    linter
+  )
+})
+
+test_that("pipe_consistency_linter works with %>% argument", {
+  skip_if_not_r_version("4.1.0")
+
+  linter <- pipe_consistency_linter(pipe = "%>%")
+  expected_message <- rex("Use the %>% pipe operator instead of the |> pipe operator.")
+
+  expect_lint(
+    "1:3 |> mean() |> as.character()",
+    list(
+      list(message = expected_message, line_number = 1L, column_number = 5L),
+      list(message = expected_message, line_number = 1L, column_number = 15L)
+    ),
+    linter
+  )
+
+  expect_lint(
+    "1:3 %>% mean() |> as.character()",
+    list(message = expected_message, line_number = 1L, column_number = 16L),
+    linter
+  )
+
+  expect_lint(
+    "1:3 %>% mean() %>% as.character()",
+    NULL,
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      1:3 %>%
+        mean() |> 
+        as.character()
+    "),
+    list(message = expected_message, line_number = 2L, column_number = 10L),
+    linter
+  )
+})
+
+test_that("pipe_consistency_linter works with other magrittr pipes", {
+  skip_if_not_r_version("4.1.0")
+  linter <- pipe_consistency_linter()
+  expected_message <- rex("Found 1 instances of %>% and 1 instances of |>. Stick to one pipe operator.")
+
+  expect_lint("1:3 %>% mean() %T% print()", NULL, linter)
+  expect_lint(
+    "1:3 |> mean() %T>% print()",
+    list(
+      list(message = expected_message, line_number = 1L, column_number = 5L),
+      list(message = expected_message, line_number = 1L, column_number = 15L)
+    ),
+    linter
+  )
+})