From 9952d0f2d994deccee64d43031f6bae784bc1617 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 17 Nov 2023 20:02:03 +0000 Subject: [PATCH 1/7] New nested_pipe_linter --- DESCRIPTION | 3 +- NAMESPACE | 1 + NEWS.md | 1 + R/nested_pipe_linter.R | 37 +++++++++ inst/lintr/linters.csv | 1 + man/consistency_linters.Rd | 1 + man/linters.Rd | 5 +- man/nested_pipe_linter.Rd | 32 +++++++ man/readability_linters.Rd | 1 + tests/testthat/test-inner_comparison_linter.R | 60 ++++++++++++++ tests/testthat/test-nested_pipe.R | 83 +++++++++++++++++++ 11 files changed, 222 insertions(+), 3 deletions(-) create mode 100644 R/nested_pipe_linter.R create mode 100644 man/nested_pipe_linter.Rd create mode 100644 tests/testthat/test-inner_comparison_linter.R create mode 100644 tests/testthat/test-nested_pipe.R diff --git a/DESCRIPTION b/DESCRIPTION index 7e0f6250d..7afd79fdc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -137,6 +137,8 @@ Collate: 'namespace.R' 'namespace_linter.R' 'nested_ifelse_linter.R' + 'shared_constants.R' + 'nested_pipe_linter.R' 'nonportable_path_linter.R' 'numeric_leading_zero_linter.R' 'object_length_linter.R' @@ -163,7 +165,6 @@ Collate: 'seq_linter.R' 'settings.R' 'settings_utils.R' - 'shared_constants.R' 'sort_linter.R' 'spaces_inside_linter.R' 'spaces_left_parentheses_linter.R' diff --git a/NAMESPACE b/NAMESPACE index 8be33824d..2995e17fa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -98,6 +98,7 @@ export(missing_package_linter) export(modify_defaults) export(namespace_linter) export(nested_ifelse_linter) +export(nested_pipe_linter) export(no_tab_linter) export(nonportable_path_linter) export(numeric_leading_zero_linter) diff --git a/NEWS.md b/NEWS.md index 477b8e61c..341745283 100644 --- a/NEWS.md +++ b/NEWS.md @@ -15,6 +15,7 @@ * `comparison_negation_linter()` for discouraging negated comparisons when a direct negation is preferable, e.g. `!(x == y)` could be `x != y` (part of #884, @MichaelChirico). * `terminal_close_linter()` for discouraging using `close()` to end functions (part of #884, @MichaelChirico). Such usages are not robust to errors, where `close()` will not be run as intended. Put `close()` in an `on.exit()` hook, or use {withr} to manage connections with proper cleanup. * `print_linter()` for discouraging usage of `print()` on string literals like `print("Reached here")` or `print(paste("Found", nrow(DF), "rows."))` (#1894, @MichaelChirico). +* `nested_pipe_linter()` for discouraging pipes within pipes, e.g. `df1 %>% inner_join(df2 %>% select(a, b))` (part of #884, @MichaelChirico). ### Lint accuracy fixes: removing false positives diff --git a/R/nested_pipe_linter.R b/R/nested_pipe_linter.R new file mode 100644 index 000000000..74a21e3ca --- /dev/null +++ b/R/nested_pipe_linter.R @@ -0,0 +1,37 @@ +#' Block usage of pipes nested inside other calls +#' +#' Nesting pipes harms readability; extract sub-steps to separate variables, +#' append further pipeline steps, or otherwise refactor such usage away. +#' +#' @examples +#' # will produce lints +#' lint( +#' text = "df1 %>% inner_join(df2 %>% select(a, b))", +#' linters = nested_pipe_linter() +#' ) +#' +#' # okay +#' lint( +#' text = "tryCatch(x %>% filter(grp == 'a'), error = identity)", +#' linters = nested_pipe_linter() +#' ) +#' +#' @evalRd rd_tags("nested_pipe_linter") +#' @seealso [linters] for a complete list of linters available in lintr. +#' @include shared_constants.R +#' @export +nested_pipe_linter <- make_linter_from_xpath( + xpath = glue(" + (//PIPE | //SPECIAL[{ xp_text_in_table(magrittr_pipes) }]) + /parent::expr[preceding-sibling::expr[SYMBOL_FUNCTION_CALL[ + not(text() = 'try' or text() = 'tryCatch') + and ( + text() != 'switch' + or parent::expr + /following-sibling::expr[1] + /*[self::PIPE or self::SPECIAL[{ xp_text_in_table(magrittr_pipes) }]] + ) + ]]] + "), + lint_message = "Don't nest pipes inside other calls." +) diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 334f6167d..5f5f307d5 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -55,6 +55,7 @@ missing_argument_linter,correctness common_mistakes configurable missing_package_linter,robustness common_mistakes namespace_linter,correctness robustness configurable executing nested_ifelse_linter,efficiency readability +nested_pipe_linter,readability consistency no_tab_linter,style consistency deprecated nonportable_path_linter,robustness best_practices configurable numeric_leading_zero_linter,style consistency readability diff --git a/man/consistency_linters.Rd b/man/consistency_linters.Rd index 7d8a609c6..27ed67188 100644 --- a/man/consistency_linters.Rd +++ b/man/consistency_linters.Rd @@ -26,6 +26,7 @@ The following linters are tagged with 'consistency': \item{\code{\link{keyword_quote_linter}}} \item{\code{\link{length_levels_linter}}} \item{\code{\link{literal_coercion_linter}}} +\item{\code{\link{nested_pipe_linter}}} \item{\code{\link{numeric_leading_zero_linter}}} \item{\code{\link{object_name_linter}}} \item{\code{\link{paste_linter}}} diff --git a/man/linters.Rd b/man/linters.Rd index 91d035bb0..c6bb08b7a 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -20,7 +20,7 @@ The following tags exist: \item{\link[=best_practices_linters]{best_practices} (56 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (8 linters)} \item{\link[=configurable_linters]{configurable} (34 linters)} -\item{\link[=consistency_linters]{consistency} (24 linters)} +\item{\link[=consistency_linters]{consistency} (25 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} \item{\link[=deprecated_linters]{deprecated} (8 linters)} @@ -28,7 +28,7 @@ The following tags exist: \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} \item{\link[=pkg_testthat_linters]{pkg_testthat} (12 linters)} -\item{\link[=readability_linters]{readability} (57 linters)} +\item{\link[=readability_linters]{readability} (58 linters)} \item{\link[=robustness_linters]{robustness} (16 linters)} \item{\link[=style_linters]{style} (38 linters)} } @@ -90,6 +90,7 @@ The following linters exist: \item{\code{\link{missing_package_linter}} (tags: common_mistakes, robustness)} \item{\code{\link{namespace_linter}} (tags: configurable, correctness, executing, robustness)} \item{\code{\link{nested_ifelse_linter}} (tags: efficiency, readability)} +\item{\code{\link{nested_pipe_linter}} (tags: consistency, readability)} \item{\code{\link{nonportable_path_linter}} (tags: best_practices, configurable, robustness)} \item{\code{\link{numeric_leading_zero_linter}} (tags: consistency, readability, style)} \item{\code{\link{object_length_linter}} (tags: configurable, default, executing, readability, style)} diff --git a/man/nested_pipe_linter.Rd b/man/nested_pipe_linter.Rd new file mode 100644 index 000000000..1f06bb494 --- /dev/null +++ b/man/nested_pipe_linter.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nested_pipe_linter.R +\name{nested_pipe_linter} +\alias{nested_pipe_linter} +\title{Block usage of pipes nested inside other calls} +\usage{ +nested_pipe_linter() +} +\description{ +Nesting pipes harms readability; extract sub-steps to separate variables, +append further pipeline steps, or otherwise refactor such usage away. +} +\examples{ +# will produce lints +lint( + text = "df1 \%>\% inner_join(df2 \%>\% select(a, b))", + linters = nested_pipe_linter() +) + +# okay +lint( + text = "tryCatch(x \%>\% filter(grp == 'a'), error = identity)", + linters = nested_pipe_linter() +) + +} +\seealso{ +\link{linters} for a complete list of linters available in lintr. +} +\section{Tags}{ +\link[=consistency_linters]{consistency}, \link[=readability_linters]{readability} +} diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd index 06deb9233..7bff2396b 100644 --- a/man/readability_linters.Rd +++ b/man/readability_linters.Rd @@ -42,6 +42,7 @@ The following linters are tagged with 'readability': \item{\code{\link{line_length_linter}}} \item{\code{\link{matrix_apply_linter}}} \item{\code{\link{nested_ifelse_linter}}} +\item{\code{\link{nested_pipe_linter}}} \item{\code{\link{numeric_leading_zero_linter}}} \item{\code{\link{object_length_linter}}} \item{\code{\link{object_usage_linter}}} diff --git a/tests/testthat/test-inner_comparison_linter.R b/tests/testthat/test-inner_comparison_linter.R new file mode 100644 index 000000000..e54091abe --- /dev/null +++ b/tests/testthat/test-inner_comparison_linter.R @@ -0,0 +1,60 @@ +test_that("inner_comparison_linter skips allowed usages", { + # lapply returns a list, so not the same, though as.list is probably + # a better choice + expect_lint( + "lapply(x, function(xi) foo(xi) == 2)", + NULL, + inner_comparison_linter() + ) + + # this _may_ return a matrix, though outer is probably a better choice if so + expect_lint( + "sapply(x, function(xi) foo(xi) == y)", + NULL, + inner_comparison_linter() + ) +}) + +test_that("inner_comparison_linter blocks simple disallowed usages", { + expect_lint( + "sapply(x, function(xi) foo(xi) == 2)", + R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", + inner_comparison_linter() + ) + expect_lint( + "sapply(x, function(xi) foo(xi) == 'a')", + R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", + inner_comparison_linter() + ) + expect_lint( + "sapply(x, function(xi) foo(xi) == 1 + 2i)", + R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", + inner_comparison_linter() + ) + + # vapply counts as well + # NB: we ignore the FUN.VALUE argument, for now + expect_lint( + "vapply(x, function(xi) foo(xi) == 2, logical(1L))", + R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", + inner_comparison_linter() + ) +}) + +test_that("inner_comparison_linter blocks other comparators as well", { + expect_lint( + "sapply(x, function(xi) foo(xi) >= 2)", + R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", + inner_comparison_linter() + ) + expect_lint( + "sapply(x, function(xi) foo(xi) != 'a')", + R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", + inner_comparison_linter() + ) + expect_lint( + "sapply(x, function(xi) foo(xi) < 1 + 2i)", + R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", + inner_comparison_linter() + ) +}) diff --git a/tests/testthat/test-nested_pipe.R b/tests/testthat/test-nested_pipe.R new file mode 100644 index 000000000..1f31a02da --- /dev/null +++ b/tests/testthat/test-nested_pipe.R @@ -0,0 +1,83 @@ +test_that("nested_pipe_linter skips allowed usages", { + linter <- nested_pipe_linter() + + expect_lint("a %>% b() %>% c()", NULL, linter) + + expect_lint( + trim_some(" + foo <- function(x) { + out <- a %>% b() + return(out) + } + "), + NULL, + linter + ) + + # switch outputs are OK + expect_lint("switch(x, a = x %>% foo())", NULL, linter) + # final position is an output position + expect_lint("switch(x, a = x, x %>% foo())", NULL, linter) + + # try/tryCatch must be evaluated inside the call + expect_lint("try(x %>% foo())", NULL, linter) + expect_lint("tryCatch(x %>% foo(), error = identity)", NULL, linter) +}) + +test_that("nested_pipe_linter blocks simple disallowed usages", { + linter <- nested_pipe_linter() + lint_msg <- rex::rex("Don't nest pipes inside other calls.") + + expect_lint( + "bind_rows(a %>% select(b), c %>% select(b))", + list(lint_msg, lint_msg), + linter + ) + + expect_lint( + trim_some(" + print( + a %>% + filter(b > c) + ) + "), + lint_msg, + linter + ) + + # switch inputs are linted + expect_lint( + trim_some(" + switch( + x %>% foo(), + a = x + ) + "), + lint_msg, + linter + ) +}) + +test_that("Native pipes are handled as well", { + skip_if_not_r_version("4.1.0") + + linter <- nested_pipe_linter() + lint_msg <- rex::rex("Don't nest pipes inside other calls.") + + expect_lint( + "bind_rows(a |> select(b), c |> select(b))", + list(lint_msg, lint_msg), + linter + ) + + expect_lint( + trim_some(" + print( + a |> + filter(b > c) + ) + "), + lint_msg, + linter + ) +}) From 030673ac78177d9f78fc31cead6ce0a684d36f08 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 17 Nov 2023 20:06:21 +0000 Subject: [PATCH 2/7] remove fromwrong branch --- tests/testthat/test-inner_comparison_linter.R | 60 ------------------- 1 file changed, 60 deletions(-) delete mode 100644 tests/testthat/test-inner_comparison_linter.R diff --git a/tests/testthat/test-inner_comparison_linter.R b/tests/testthat/test-inner_comparison_linter.R deleted file mode 100644 index e54091abe..000000000 --- a/tests/testthat/test-inner_comparison_linter.R +++ /dev/null @@ -1,60 +0,0 @@ -test_that("inner_comparison_linter skips allowed usages", { - # lapply returns a list, so not the same, though as.list is probably - # a better choice - expect_lint( - "lapply(x, function(xi) foo(xi) == 2)", - NULL, - inner_comparison_linter() - ) - - # this _may_ return a matrix, though outer is probably a better choice if so - expect_lint( - "sapply(x, function(xi) foo(xi) == y)", - NULL, - inner_comparison_linter() - ) -}) - -test_that("inner_comparison_linter blocks simple disallowed usages", { - expect_lint( - "sapply(x, function(xi) foo(xi) == 2)", - R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", - inner_comparison_linter() - ) - expect_lint( - "sapply(x, function(xi) foo(xi) == 'a')", - R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", - inner_comparison_linter() - ) - expect_lint( - "sapply(x, function(xi) foo(xi) == 1 + 2i)", - R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", - inner_comparison_linter() - ) - - # vapply counts as well - # NB: we ignore the FUN.VALUE argument, for now - expect_lint( - "vapply(x, function(xi) foo(xi) == 2, logical(1L))", - R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", - inner_comparison_linter() - ) -}) - -test_that("inner_comparison_linter blocks other comparators as well", { - expect_lint( - "sapply(x, function(xi) foo(xi) >= 2)", - R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", - inner_comparison_linter() - ) - expect_lint( - "sapply(x, function(xi) foo(xi) != 'a')", - R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", - inner_comparison_linter() - ) - expect_lint( - "sapply(x, function(xi) foo(xi) < 1 + 2i)", - R"[Compare to a constant after calling sapply\(\)/vapply\(\)]", - inner_comparison_linter() - ) -}) From fb4376f1c1e3da8a86a52309220f3236e2361d83 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 10:01:09 -0800 Subject: [PATCH 3/7] allow_inline parameter --- DESCRIPTION | 2 +- R/nested_pipe_linter.R | 54 +++++++++++++++++++++++++------ inst/lintr/linters.csv | 2 +- man/nested_pipe_linter.Rd | 28 ++++++++++++++-- tests/testthat/test-nested_pipe.R | 44 +++++++++++++++++++++++-- 5 files changed, 113 insertions(+), 17 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2d1650568..65af2f85b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -138,7 +138,6 @@ Collate: 'namespace.R' 'namespace_linter.R' 'nested_ifelse_linter.R' - 'shared_constants.R' 'nested_pipe_linter.R' 'nonportable_path_linter.R' 'numeric_leading_zero_linter.R' @@ -167,6 +166,7 @@ Collate: 'seq_linter.R' 'settings.R' 'settings_utils.R' + 'shared_constants.R' 'sort_linter.R' 'spaces_inside_linter.R' 'spaces_left_parentheses_linter.R' diff --git a/R/nested_pipe_linter.R b/R/nested_pipe_linter.R index 74a21e3ca..0f13c55e9 100644 --- a/R/nested_pipe_linter.R +++ b/R/nested_pipe_linter.R @@ -3,27 +3,47 @@ #' Nesting pipes harms readability; extract sub-steps to separate variables, #' append further pipeline steps, or otherwise refactor such usage away. #' +#' When [try()] or [tryCatch()] are the "outer" call, no lint is thrown, +#' since the "unnested" version of such usage may not work as intended +#' due to how evaluation happens in such cases. +#' +#' @param allow_inline Logical, default `TRUE`, in which case only "inner" +#' pipelines which span more than one line are linted. If `FALSE`, even +#' "inner" pipelines that fit in one line are linted. +#' #' @examples #' # will produce lints +#' code <- "df1 %>%\n inner_join(df2 %>%\n select(a, b)\n )" +#' writeLines(code) #' lint( -#' text = "df1 %>% inner_join(df2 %>% select(a, b))", +#' text = code, #' linters = nested_pipe_linter() #' ) #' +#' lint( +#' text = "df1 %>% inner_join(df2 %>% select(a, b))", +#' linters = nested_pipe_linter(allow_inline = FALSE) +#' ) +#' #' # okay #' lint( +#' text = "df1 %>% inner_join(df2 %>% select(a, b))", +#' linters = nested_pipe_linter() +#' ) +#' +#' lint( #' text = "tryCatch(x %>% filter(grp == 'a'), error = identity)", #' linters = nested_pipe_linter() #' ) #' #' @evalRd rd_tags("nested_pipe_linter") #' @seealso [linters] for a complete list of linters available in lintr. -#' @include shared_constants.R #' @export -nested_pipe_linter <- make_linter_from_xpath( - xpath = glue(" +nested_pipe_linter <- function(allow_inline = TRUE) { + multiline_and <- if (allow_inline) "@line1 != @line2 and" else "" + xpath <- glue(" (//PIPE | //SPECIAL[{ xp_text_in_table(magrittr_pipes) }]) - /parent::expr[preceding-sibling::expr[SYMBOL_FUNCTION_CALL[ + /parent::expr[{multiline_and} preceding-sibling::expr/SYMBOL_FUNCTION_CALL[ not(text() = 'try' or text() = 'tryCatch') and ( text() != 'switch' @@ -31,7 +51,23 @@ nested_pipe_linter <- make_linter_from_xpath( /following-sibling::expr[1] /*[self::PIPE or self::SPECIAL[{ xp_text_in_table(magrittr_pipes) }]] ) - ]]] - "), - lint_message = "Don't nest pipes inside other calls." -) + ]] + ") + + 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) + + xml_nodes_to_lints( + bad_expr, + source_expression = source_expression, + lint_message = "Don't nest pipes inside other calls.", + type = "warning" + ) + }) +} diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 23bb91c3a..215bcfcc8 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -56,7 +56,7 @@ missing_argument_linter,correctness common_mistakes configurable missing_package_linter,robustness common_mistakes namespace_linter,correctness robustness configurable executing nested_ifelse_linter,efficiency readability -nested_pipe_linter,readability consistency +nested_pipe_linter,readability consistency configurable no_tab_linter,style consistency deprecated nonportable_path_linter,robustness best_practices configurable numeric_leading_zero_linter,style consistency readability diff --git a/man/nested_pipe_linter.Rd b/man/nested_pipe_linter.Rd index 1f06bb494..a3144aeec 100644 --- a/man/nested_pipe_linter.Rd +++ b/man/nested_pipe_linter.Rd @@ -4,20 +4,42 @@ \alias{nested_pipe_linter} \title{Block usage of pipes nested inside other calls} \usage{ -nested_pipe_linter() +nested_pipe_linter(allow_inline = TRUE) +} +\arguments{ +\item{allow_inline}{Logical, default \code{TRUE}, in which case only "inner" +pipelines which span more than one line are linted. If \code{FALSE}, even +"inner" pipelines that fit in one line are linted.} } \description{ Nesting pipes harms readability; extract sub-steps to separate variables, append further pipeline steps, or otherwise refactor such usage away. } +\details{ +When \code{\link[=try]{try()}} or \code{\link[=tryCatch]{tryCatch()}} are the "outer" call, no lint is thrown, +since the "unnested" version of such usage may not work as intended +due to how evaluation happens in such cases. +} \examples{ # will produce lints +code <- "df1 \%>\%\n inner_join(df2 \%>\%\n select(a, b)\n )" +writeLines(code) lint( - text = "df1 \%>\% inner_join(df2 \%>\% select(a, b))", + text = code, linters = nested_pipe_linter() ) +lint( + text = "df1 \%>\% inner_join(df2 \%>\% select(a, b))", + linters = nested_pipe_linter(allow_inline = FALSE) +) + # okay +lint( + text = "df1 \%>\% inner_join(df2 \%>\% select(a, b))", + linters = nested_pipe_linter() +) + lint( text = "tryCatch(x \%>\% filter(grp == 'a'), error = identity)", linters = nested_pipe_linter() @@ -28,5 +50,5 @@ lint( \link{linters} for a complete list of linters available in lintr. } \section{Tags}{ -\link[=consistency_linters]{consistency}, \link[=readability_linters]{readability} +\link[=configurable_linters]{configurable}, \link[=consistency_linters]{consistency}, \link[=readability_linters]{readability} } diff --git a/tests/testthat/test-nested_pipe.R b/tests/testthat/test-nested_pipe.R index 1f31a02da..27788aa97 100644 --- a/tests/testthat/test-nested_pipe.R +++ b/tests/testthat/test-nested_pipe.R @@ -14,11 +14,30 @@ test_that("nested_pipe_linter skips allowed usages", { linter ) + # pipes fitting on one line can be ignored + expect_lint( + "bind_rows(a %>% select(b), c %>% select(b))", + NULL, + linter + ) + # switch outputs are OK expect_lint("switch(x, a = x %>% foo())", NULL, linter) # final position is an output position expect_lint("switch(x, a = x, x %>% foo())", NULL, linter) + # inline switch inputs are not linted + expect_lint( + trim_some(" + switch( + x %>% foo(), + a = x + ) + "), + NULL, + linter + ) + # try/tryCatch must be evaluated inside the call expect_lint("try(x %>% foo())", NULL, linter) expect_lint("tryCatch(x %>% foo(), error = identity)", NULL, linter) @@ -26,12 +45,13 @@ test_that("nested_pipe_linter skips allowed usages", { test_that("nested_pipe_linter blocks simple disallowed usages", { linter <- nested_pipe_linter() + linter_inline <- nested_pipe_linter(allow_inline = FALSE) lint_msg <- rex::rex("Don't nest pipes inside other calls.") expect_lint( "bind_rows(a %>% select(b), c %>% select(b))", list(lint_msg, lint_msg), - linter + linter_inline ) expect_lint( @@ -49,26 +69,44 @@ test_that("nested_pipe_linter blocks simple disallowed usages", { expect_lint( trim_some(" switch( - x %>% foo(), + x %>% + foo(), a = x ) "), lint_msg, linter ) + + expect_lint( + trim_some(" + switch( + x %>% foo(), + a = x + ) + "), + lint_msg, + linter_inline + ) }) test_that("Native pipes are handled as well", { skip_if_not_r_version("4.1.0") linter <- nested_pipe_linter() + linter_inline <- nested_pipe_linter(allow_inline = FALSE) lint_msg <- rex::rex("Don't nest pipes inside other calls.") expect_lint( "bind_rows(a |> select(b), c |> select(b))", - list(lint_msg, lint_msg), + NULL, linter ) + expect_lint( + "bind_rows(a |> select(b), c |> select(b))", + list(lint_msg, lint_msg), + linter_inline + ) expect_lint( trim_some(" From f32138f50d2f0eada4a40fff7027540c3cbca6dd Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 10:01:24 -0800 Subject: [PATCH 4/7] (not staged?) --- man/configurable_linters.Rd | 1 + man/linters.Rd | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/man/configurable_linters.Rd b/man/configurable_linters.Rd index 19899dd62..cdf6d647c 100644 --- a/man/configurable_linters.Rd +++ b/man/configurable_linters.Rd @@ -30,6 +30,7 @@ The following linters are tagged with 'configurable': \item{\code{\link{line_length_linter}}} \item{\code{\link{missing_argument_linter}}} \item{\code{\link{namespace_linter}}} +\item{\code{\link{nested_pipe_linter}}} \item{\code{\link{nonportable_path_linter}}} \item{\code{\link{object_length_linter}}} \item{\code{\link{object_name_linter}}} diff --git a/man/linters.Rd b/man/linters.Rd index de60dcc3f..9f5cd80ff 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -19,7 +19,7 @@ The following tags exist: \itemize{ \item{\link[=best_practices_linters]{best_practices} (58 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (9 linters)} -\item{\link[=configurable_linters]{configurable} (34 linters)} +\item{\link[=configurable_linters]{configurable} (35 linters)} \item{\link[=consistency_linters]{consistency} (27 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} @@ -92,7 +92,7 @@ The following linters exist: \item{\code{\link{missing_package_linter}} (tags: common_mistakes, robustness)} \item{\code{\link{namespace_linter}} (tags: configurable, correctness, executing, robustness)} \item{\code{\link{nested_ifelse_linter}} (tags: efficiency, readability)} -\item{\code{\link{nested_pipe_linter}} (tags: consistency, readability)} +\item{\code{\link{nested_pipe_linter}} (tags: configurable, consistency, readability)} \item{\code{\link{nonportable_path_linter}} (tags: best_practices, configurable, robustness)} \item{\code{\link{numeric_leading_zero_linter}} (tags: consistency, readability, style)} \item{\code{\link{nzchar_linter}} (tags: best_practices, consistency, efficiency)} From ce6ef5dc96aa23c4a6be3046ee63fede8b7d8ab9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 10:02:01 -0800 Subject: [PATCH 5/7] missing _linter in filename --- tests/testthat/{test-nested_pipe.R => test-nested_pipe_linter.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename tests/testthat/{test-nested_pipe.R => test-nested_pipe_linter.R} (100%) diff --git a/tests/testthat/test-nested_pipe.R b/tests/testthat/test-nested_pipe_linter.R similarity index 100% rename from tests/testthat/test-nested_pipe.R rename to tests/testthat/test-nested_pipe_linter.R From 695d23be7d0f36d5c0c98c22aae0e59dcd5224b2 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 10:05:13 -0800 Subject: [PATCH 6/7] vectorization+metadata --- tests/testthat/test-nested_pipe_linter.R | 35 ++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/tests/testthat/test-nested_pipe_linter.R b/tests/testthat/test-nested_pipe_linter.R index 27788aa97..b53701baa 100644 --- a/tests/testthat/test-nested_pipe_linter.R +++ b/tests/testthat/test-nested_pipe_linter.R @@ -119,3 +119,38 @@ test_that("Native pipes are handled as well", { linter ) }) + +test_that("lints vectorize", { + lint_msg <- rex::rex("Don't nest pipes inside other calls.") + + lines <- trim_some("{ + bind_rows( + a %>% select(b), + c %>% + select(d), + e %>% + select(f) %>% + filter(g > 0), + h %>% filter(i < 0) + ) + }") + expect_lint( + lines, + list( + list(lint_msg, line_number = 4L), + list(lint_msg, line_number = 6L) + ), + nested_pipe_linter() + ) + + expect_lint( + lines, + list( + list(lint_msg, line_number = 3L), + list(lint_msg, line_number = 4L), + list(lint_msg, line_number = 6L), + list(lint_msg, line_number = 9L) + ), + nested_pipe_linter(allow_inline = FALSE) + ) +}) From b46211933a9e4b9e928ebc3d4ed3e2262ac482b9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 17:24:34 -0800 Subject: [PATCH 7/7] New allow_outer_calls argument --- R/nested_pipe_linter.R | 25 ++++++++++---- man/nested_pipe_linter.Rd | 26 ++++++++++---- tests/testthat/test-nested_pipe_linter.R | 44 +++++++++++++++++++++--- 3 files changed, 79 insertions(+), 16 deletions(-) diff --git a/R/nested_pipe_linter.R b/R/nested_pipe_linter.R index 0f13c55e9..d53c9a16b 100644 --- a/R/nested_pipe_linter.R +++ b/R/nested_pipe_linter.R @@ -3,13 +3,12 @@ #' Nesting pipes harms readability; extract sub-steps to separate variables, #' append further pipeline steps, or otherwise refactor such usage away. #' -#' When [try()] or [tryCatch()] are the "outer" call, no lint is thrown, -#' since the "unnested" version of such usage may not work as intended -#' due to how evaluation happens in such cases. -#' #' @param allow_inline Logical, default `TRUE`, in which case only "inner" #' pipelines which span more than one line are linted. If `FALSE`, even #' "inner" pipelines that fit in one line are linted. +#' @param allow_outer_calls Character vector dictating which "outer" +#' calls to exempt from the requirement to unnest (see examples). Defaults +#' to [try()], [tryCatch()], and [withCallingHandlers()]. #' #' @examples #' # will produce lints @@ -25,12 +24,24 @@ #' linters = nested_pipe_linter(allow_inline = FALSE) #' ) #' +#' lint( +#' text = "tryCatch(x %>% filter(grp == 'a'), error = identity)", +#' linters = nested_pipe_linter(allow_outer_calls = character()) +#' ) +#' #' # okay #' lint( #' text = "df1 %>% inner_join(df2 %>% select(a, b))", #' linters = nested_pipe_linter() #' ) #' +#' code <- "df1 %>%\n inner_join(df2 %>%\n select(a, b)\n )" +#' writeLines(code) +#' lint( +#' text = code, +#' linters = nested_pipe_linter(allow_outer_calls = "inner_join") +#' ) +#' #' lint( #' text = "tryCatch(x %>% filter(grp == 'a'), error = identity)", #' linters = nested_pipe_linter() @@ -39,12 +50,14 @@ #' @evalRd rd_tags("nested_pipe_linter") #' @seealso [linters] for a complete list of linters available in lintr. #' @export -nested_pipe_linter <- function(allow_inline = TRUE) { +nested_pipe_linter <- function( + allow_inline = TRUE, + allow_outer_calls = c("try", "tryCatch", "withCallingHandlers")) { multiline_and <- if (allow_inline) "@line1 != @line2 and" else "" xpath <- glue(" (//PIPE | //SPECIAL[{ xp_text_in_table(magrittr_pipes) }]) /parent::expr[{multiline_and} preceding-sibling::expr/SYMBOL_FUNCTION_CALL[ - not(text() = 'try' or text() = 'tryCatch') + not({ xp_text_in_table(allow_outer_calls) }) and ( text() != 'switch' or parent::expr diff --git a/man/nested_pipe_linter.Rd b/man/nested_pipe_linter.Rd index a3144aeec..1f5eb03e3 100644 --- a/man/nested_pipe_linter.Rd +++ b/man/nested_pipe_linter.Rd @@ -4,22 +4,24 @@ \alias{nested_pipe_linter} \title{Block usage of pipes nested inside other calls} \usage{ -nested_pipe_linter(allow_inline = TRUE) +nested_pipe_linter( + allow_inline = TRUE, + allow_outer_calls = c("try", "tryCatch", "withCallingHandlers") +) } \arguments{ \item{allow_inline}{Logical, default \code{TRUE}, in which case only "inner" pipelines which span more than one line are linted. If \code{FALSE}, even "inner" pipelines that fit in one line are linted.} + +\item{allow_outer_calls}{Character vector dictating which "outer" +calls to exempt from the requirement to unnest (see examples). Defaults +to \code{\link[=try]{try()}}, \code{\link[=tryCatch]{tryCatch()}}, and \code{\link[=withCallingHandlers]{withCallingHandlers()}}.} } \description{ Nesting pipes harms readability; extract sub-steps to separate variables, append further pipeline steps, or otherwise refactor such usage away. } -\details{ -When \code{\link[=try]{try()}} or \code{\link[=tryCatch]{tryCatch()}} are the "outer" call, no lint is thrown, -since the "unnested" version of such usage may not work as intended -due to how evaluation happens in such cases. -} \examples{ # will produce lints code <- "df1 \%>\%\n inner_join(df2 \%>\%\n select(a, b)\n )" @@ -34,12 +36,24 @@ lint( linters = nested_pipe_linter(allow_inline = FALSE) ) +lint( + text = "tryCatch(x \%>\% filter(grp == 'a'), error = identity)", + linters = nested_pipe_linter(allow_outer_calls = character()) +) + # okay lint( text = "df1 \%>\% inner_join(df2 \%>\% select(a, b))", linters = nested_pipe_linter() ) +code <- "df1 \%>\%\n inner_join(df2 \%>\%\n select(a, b)\n )" +writeLines(code) +lint( + text = code, + linters = nested_pipe_linter(allow_outer_calls = "inner_join") +) + lint( text = "tryCatch(x \%>\% filter(grp == 'a'), error = identity)", linters = nested_pipe_linter() diff --git a/tests/testthat/test-nested_pipe_linter.R b/tests/testthat/test-nested_pipe_linter.R index b53701baa..1e1679238 100644 --- a/tests/testthat/test-nested_pipe_linter.R +++ b/tests/testthat/test-nested_pipe_linter.R @@ -37,12 +37,24 @@ test_that("nested_pipe_linter skips allowed usages", { NULL, linter ) - - # try/tryCatch must be evaluated inside the call - expect_lint("try(x %>% foo())", NULL, linter) - expect_lint("tryCatch(x %>% foo(), error = identity)", NULL, linter) }) +patrick::with_parameters_test_that( + "allow_outer_calls defaults are ignored by default", + expect_lint( + trim_some(sprintf(outer_call, fmt = " + %s( + x %%>%% + foo() + ) + ")), + NULL, + nested_pipe_linter() + ), + .test_name = c("try", "tryCatch", "withCallingHandlers"), + outer_call = c("try", "tryCatch", "withCallingHandlers") +) + test_that("nested_pipe_linter blocks simple disallowed usages", { linter <- nested_pipe_linter() linter_inline <- nested_pipe_linter(allow_inline = FALSE) @@ -90,6 +102,30 @@ test_that("nested_pipe_linter blocks simple disallowed usages", { ) }) +test_that("allow_outer_calls= argument works", { + expect_lint( + trim_some(" + try( + x %>% + foo() + ) + "), + rex::rex("Don't nest pipes inside other calls."), + nested_pipe_linter(allow_outer_calls = character()) + ) + + expect_lint( + trim_some(" + print( + x %>% + foo() + ) + "), + NULL, + nested_pipe_linter(allow_outer_calls = "print") + ) +}) + test_that("Native pipes are handled as well", { skip_if_not_r_version("4.1.0")