New unnecessary_nesting_linter

DESCRIPTION

@@ -190,6 +190,7 @@ Collate:
     'unnecessary_concatenation_linter.R'
     'unnecessary_lambda_linter.R'
     'unnecessary_nested_if_linter.R'
+    'unnecessary_nesting_linter.R'
     'unnecessary_placeholder_linter.R'
     'unreachable_code_linter.R'
     'unused_import_linter.R'

NAMESPACE

@@ -153,6 +153,7 @@ export(undesirable_operator_linter)
 export(unnecessary_concatenation_linter)
 export(unnecessary_lambda_linter)
 export(unnecessary_nested_if_linter)
+export(unnecessary_nesting_linter)
 export(unnecessary_placeholder_linter)
 export(unneeded_concatenation_linter)
 export(unreachable_code_linter)

NEWS.md

@@ -33,6 +33,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).
+* `unnecessary_nesting_linter()` for discouraging overly-nested code where an early return or eliminated sub-expression (inside '{') is preferable (part of #884, @MichaelChirico).
 * `if_switch_linter()` for encouraging `switch()` over repeated `if`/`else` tests (part of #884, @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).

R/unnecessary_nesting_linter.R

@@ -0,0 +1,180 @@
+#' Block instances of excessive nesting
+#'
+#' Excessive nesting harms readability. Use helper functions or early returns
+#'   to reduce nesting wherever possible.
+#'
+#' @param allow_assignment Logical, default `TRUE`, in which case
+#'   braced expressions consisting only of a single assignment are skipped.
+#'   if `FALSE`, all braced expressions with only one child expression are linted.
+#'   The `TRUE` case facilitates interaction with [implicit_assignment_linter()]
+#'   for certain cases where an implicit assignment is necessary, so a braced
+#'   assignment is used to further distinguish the assignment. See examples.
+#'
+#' @examples
+#' # will produce lints
+#' code <- "if (A) {\n  stop('A is bad!')\n} else {\n  do_good()\n}"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = unnecessary_nesting_linter()
+#' )
+#'
+#' code <- "tryCatch(\n  {\n    foo()\n  },\n  error = identity\n)"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = unnecessary_nesting_linter()
+#' )
+#'
+#' code <- "expect_warning(\n  {\n    x <- foo()\n  },\n  'warned'\n)"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = unnecessary_nesting_linter(allow_assignment = FALSE)
+#' )
+#'
+#' # okay
+#' code <- "if (A) {\n  stop('A is bad because a.')\n} else {\n  stop('!A is bad too.')\n}"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = unnecessary_nesting_linter()
+#' )
+#'
+#' code <- "capture.output({\n  foo()\n})"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = unnecessary_nesting_linter()
+#' )
+#'
+#' code <- "expect_warning(\n  {\n    x <- foo()\n  },\n  'warned'\n)"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = unnecessary_nesting_linter()
+#' )
+#'
+#' @evalRd rd_tags("unnecessary_nesting_linter")
+#' @seealso
+#'  - [cyclocomp_linter()] for another linter that penalizes overly complexcode.
+#'  - [linters] for a complete list of linters available in lintr.
+#' @export
+unnecessary_nesting_linter <- function(allow_assignment = TRUE) {
+  exit_calls <- c("stop", "return", "abort", "quit", "q")
+  exit_call_expr <- glue("
+    expr[SYMBOL_FUNCTION_CALL[{xp_text_in_table(exit_calls)}]]
+  ")
+  # block IF here for cases where a nested if/else is entirely within
+  #   one of the branches.
+  # TODO(michaelchirico): we could try and make the parallel exits requirement
+  #   more recursive, but it's a pain to do so.
+  no_exit_call_expr <- glue("
+  expr[
+    OP-LEFT-BRACE
+    and expr[
+      position() = last()
+      and not(IF)
+      and not(expr[SYMBOL_FUNCTION_CALL[{xp_text_in_table(exit_calls)}]])
+    ]
+  ]
+  ")
+  # condition for ELSE should be redundant, but include for robustness
+  # condition on parent::expr[IF] ensures we're at the first `if` of a sequence of if/else statements
+  # condition on expr uses following-sibling or preceding-sibling to ensure
+  #   that the other expr falls on a different branch (earlier used separate
+  #   conditions on two expr[], but seems to allow any branch with >1 statement
+  #   to lead to a lint.
+  # use position() = last() to ignore any expr but the last one in any branch.
+  if_else_exit_xpath <- glue("
+  //expr[
+    IF
+    and ELSE
+    and not(parent::expr[IF])
+    and expr[
+      OP-LEFT-BRACE
+      and expr[position() = last() and {exit_call_expr}]
+      and (
+        following-sibling::{no_exit_call_expr}
+        or preceding-sibling::{no_exit_call_expr}
+      )
+    ]
+  ]
+  ")
+
+  assignment_cond <- if (allow_assignment) "expr[LEFT_ASSIGN or RIGHT_ASSIGN]" else "false"
+
+  # several carve-outs of common cases where single-expression braces are OK
+  #   - control flow statements: if, for, while, repeat, switch()
+  #       + switch() is unique in being a function, not a language element
+  #       + include foreach() as a common package-based for loop extension
+  #   - function definitions
+  #       + includes purrr-like anonymous functions as ~ {...}
+  #   - rlang's double-brace expressions like {{ var }}
+  #       + NB: both braces would trigger here, so we must exclude both of them
+  #   - any expression starting like `({` or `[{` or ending like `})` or `}]`
+  #       + note that nesting is not improved by "fixing" such cases,
+  #         and could also be worsened
+  #       + motivated by the most common cases:
+  #          * test_that("test", { expr })
+  #          * with(x, { expr }) / within(x, { expr })
+  #          * suppressWarnings({ expr })
+  #          * DataTable[, { expr }]
+  #          * DataTable[, col := { expr }] <- requires carve-out for `:=`
+  unnecessary_brace_xpath <- glue("
+  //OP-LEFT-BRACE
+    /parent::expr[
+      count(expr) = 1
+      and not(preceding-sibling::*[
+        self::FUNCTION
+        or self::FOR
+        or self::IF
+        or self::WHILE
+        or self::REPEAT
+        or self::expr/SYMBOL_FUNCTION_CALL[text() = 'switch']
+        or self::expr/expr/SYMBOL_FUNCTION_CALL[text() = 'foreach']
+        or self::OP-TILDE
+        or self::LEFT_ASSIGN[text() = ':=']
+      ])
+      and not(expr/OP-LEFT-BRACE)
+      and not(preceding-sibling::OP-LEFT-BRACE)
+      and not(
+        OP-LEFT-BRACE/@end - 1 = preceding-sibling::*[1][self::OP-LEFT-PAREN or self::OP-LEFT-BRACKET]/@end
+        or OP-RIGHT-BRACE/@end + 1 = following-sibling::*[1][self::OP-RIGHT-PAREN or self::OP-RIGHT-BRACKET]/@end
+      )
+      and not({assignment_cond})
+    ]
+  ")
+
+  Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+
+    xml <- source_expression$xml_parsed_content
+
+    if_else_exit_expr <- xml_find_all(xml, if_else_exit_xpath)
+    # TODO(michaelchirico): customize the error message to the exit clause used
+    if_else_exit_lints <- xml_nodes_to_lints(
+      if_else_exit_expr,
+      source_expression = source_expression,
+      lint_message = paste0(
+        "Reduce the nesting of this if/else statement by unnesting the ",
+        "portion without an exit clause (i.e., ",
+        paste0(exit_calls, "()", collapse = ", "),
+        ")."
+      ),
+      type = "warning"
+    )
+
+    unnecessary_brace_expr <- xml_find_all(xml, unnecessary_brace_xpath)
+    unnecessary_brace_lints <- xml_nodes_to_lints(
+      unnecessary_brace_expr,
+      source_expression = source_expression,
+      lint_message = "Reduce the nesting of this statement by removing the braces {}.",
+      type = "warning"
+    )
+
+    c(if_else_exit_lints, unnecessary_brace_lints)
+  })
+}

inst/lintr/linters.csv

@@ -110,6 +110,7 @@ undesirable_operator_linter,style efficiency configurable robustness best_practi
 unnecessary_concatenation_linter,style readability efficiency configurable
 unnecessary_lambda_linter,best_practices efficiency readability
 unnecessary_nested_if_linter,readability best_practices
+unnecessary_nesting_linter,readability consistency configurable
 unnecessary_placeholder_linter,readability best_practices
 unneeded_concatenation_linter,style readability efficiency configurable deprecated
 unreachable_code_linter,best_practices readability