diff --git a/NAMESPACE b/NAMESPACE index 3bba76ee7..e7b232bde 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 3d21b9072..d33c53be9 100644 --- a/NEWS.md +++ b/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()` diff --git a/R/brace_linter.R b/R/brace_linter.R index 0444546a2..95db1f649 100644 --- a/R/brace_linter.R +++ b/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 diff --git a/R/lintr-package.R b/R/lintr-package.R index cb46d5ad9..7961891ca 100644 --- a/R/lintr-package.R +++ b/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 diff --git a/R/pipe_call_linter.R b/R/pipe_call_linter.R index 534b5c3ac..b58c5c3e7 100644 --- a/R/pipe_call_linter.R +++ b/R/pipe_call_linter.R @@ -23,7 +23,8 @@ pipe_call_linter <- function() { # NB: the text() here shows up as %>% 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>%", "%$%", "%<>%") diff --git a/R/pipe_continuation_linter.R b/R/pipe_continuation_linter.R index 6f6463f5e..e8a91674b 100644 --- a/R/pipe_continuation_linter.R +++ b/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, diff --git a/R/unnecessary_concatenation_linter.R b/R/unnecessary_concatenation_linter.R index 57e82020a..5ae6d44f3 100644 --- a/R/unnecessary_concatenation_linter.R +++ b/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} ])") diff --git a/R/unnecessary_placeholder_linter.R b/R/unnecessary_placeholder_linter.R index 2f58e4b38..061821169 100644 --- a/R/unnecessary_placeholder_linter.R +++ b/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")) { diff --git a/R/yoda_test_linter.R b/R/yoda_test_linter.R index 17c8186b7..9d90b7a5d 100644 --- a/R/yoda_test_linter.R +++ b/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})]") diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index cb67d30ee..b66210eb6 100644 --- a/tests/testthat/helper.R +++ b/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] +} diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index 151d7c5d6..3515e0d8c 100644 --- a/tests/testthat/test-brace_linter.R +++ b/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) diff --git a/tests/testthat/test-pipe_call_linter.R b/tests/testthat/test-pipe_call_linter.R index 6164c0436..96cf2036e 100644 --- a/tests/testthat/test-pipe_call_linter.R +++ b/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() + ) +}) diff --git a/tests/testthat/test-pipe_continuation_linter.R b/tests/testthat/test-pipe_continuation_linter.R index 24b57f788..67ea96383 100644 --- a/tests/testthat/test-pipe_continuation_linter.R +++ b/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 + ) +}) diff --git a/tests/testthat/test-unnecessary_concatenation_linter.R b/tests/testthat/test-unnecessary_concatenation_linter.R index a9f4d9205..ba1e10078 100644 --- a/tests/testthat/test-unnecessary_concatenation_linter.R +++ b/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) ) }) diff --git a/tests/testthat/test-unnecessary_placeholder_linter.R b/tests/testthat/test-unnecessary_placeholder_linter.R index 76e36d91f..229287a12 100644 --- a/tests/testthat/test-unnecessary_placeholder_linter.R +++ b/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 ) diff --git a/tests/testthat/test-yoda_test_linter.R b/tests/testthat/test-yoda_test_linter.R index daf53de50..2cd48fc03 100644 --- a/tests/testthat/test-yoda_test_linter.R +++ b/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", {