New nested_pipe_linter

DESCRIPTION

@@ -138,6 +138,7 @@ Collate:
     'namespace.R'
     'namespace_linter.R'
     'nested_ifelse_linter.R'
+    'nested_pipe_linter.R'
     'nonportable_path_linter.R'
     'nrow_subset_linter.R'
     'numeric_leading_zero_linter.R'

NAMESPACE

@@ -99,6 +99,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(nrow_subset_linter)

NEWS.md

@@ -31,6 +31,7 @@
 * `which_grepl_linter()` for discouraging `which(grepl(ptn, x))` in favor of directly using `grep(ptn, x)` (part of #884, @MichaelChirico).
 * `list_comparison_linter()` for discouraging comparisons on the output of `lapply()`, e.g. `lapply(x, sum) > 10` (part of #884, @MichaelChirico).
 * `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).
 * `nrow_subset_linter()` for discouraging usage like `nrow(subset(x, conditions))` in favor of something like `with(x, sum(conditions))` which doesn't require a full subset of `x` (part of #884, @MichaelChirico).
 * `pipe_return_linter()` for discouraging usage of `return()` inside a {magrittr} pipeline (part of #884, @MichaelChirico).
 

R/nested_pipe_linter.R

@@ -0,0 +1,86 @@
+#' 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.
+#'
+#' @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
+#' code <- "df1 %>%\n  inner_join(df2 %>%\n    select(a, b)\n  )"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = nested_pipe_linter()
+#' )
+#'
+#' lint(
+#'   text = "df1 %>% inner_join(df2 %>% select(a, b))",
+#'   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()
+#' )
+#'
+#' @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,
+    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({ xp_text_in_table(allow_outer_calls) })
+      and (
+        text() != 'switch'
+        or parent::expr
+          /following-sibling::expr[1]
+          /*[self::PIPE or self::SPECIAL[{ xp_text_in_table(magrittr_pipes) }]]
+      )
+    ]]
+  ")
+
+  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"
+    )
+  })
+}

inst/lintr/linters.csv

@@ -56,6 +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 configurable
 no_tab_linter,style consistency deprecated
 nonportable_path_linter,robustness best_practices configurable
 nrow_subset_linter,efficiency consistency best_practices