New allow_functions= to control skipped functions in unnecessary_nesting_linter()

NEWS.md

@@ -62,7 +62,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 (#2317 and part of #884, @MichaelChirico).
+* `unnecessary_nesting_linter()` for discouraging overly-nested code where an early return or eliminated sub-expression (inside '{') is preferable (#2317, #2334 and part of #884, @MichaelChirico).
 * `consecutive_mutate_linter()` for encouraging consecutive calls to `dplyr::mutate()` to be combined (part of #884, @MichaelChirico).
 * `if_switch_linter()` for encouraging `switch()` over repeated `if`/`else` tests (#2322 and 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).

R/unnecessary_nesting_linter.R

@@ -9,6 +9,12 @@
 #' 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.
+#' @param allow_functions Character vector of functions which always allow
+#' one-child braced expressions. `testthat::test_that()` is always allowed because
+#' testthat requires a braced expression in its `code` argument. The other defaults
+#' similarly compute on expressions in a way which is worth highlighting by
+#' em-bracing them, even if there is only one expression, while [switch()] is allowed
+#' for its use as a control flow analogous to `if`/`else`.
 #'
 #' @examples
 #' # will produce lints
@@ -39,6 +45,11 @@
 #' linters = unnecessary_nesting_linter()
 #' )
 #'
+#' lint(
+#' text = "my_quote({x})",
+#' linters = unnecessary_nesting_linter()
+#' )
+#'
 #' # okay
 #' code <- "if (A) {\n stop('A is bad because a.')\n} else {\n stop('!A is bad too.')\n}"
 #' writeLines(code)
@@ -73,12 +84,27 @@
 #' linters = unnecessary_nesting_linter()
 #' )
 #'
+#' lint(
+#' text = "my_quote({x})",
+#' linters = unnecessary_nesting_linter(allow_functions = "my_quote")
+#' )
+#'
 #' @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) {
+unnecessary_nesting_linter <- function(
+ allow_assignment = TRUE,
+ allow_functions = c(
+ "switch",
+ "try", "tryCatch", "withCallingHandlers",
+ "quote", "expression", "bquote", "substitute",
+ "with_parameters_test_that",
+ "reactive", "observe", "observeEvent",
+ "renderCachedPlot", "renderDataTable", "renderImage", "renderPlot",
+ "renderPrint", "renderTable", "renderText", "renderUI"
+ )) {
  exit_calls <- c("stop", "return", "abort", "quit", "q")
  exit_call_expr <- glue("
  expr[SYMBOL_FUNCTION_CALL[{xp_text_in_table(exit_calls)}]]
@@ -145,6 +171,7 @@ unnecessary_nesting_linter <- function(allow_assignment = TRUE) {
  or self::IF
  or self::WHILE
  or self::REPEAT
+ or self::expr/SYMBOL_FUNCTION_CALL[{ xp_text_in_table(c('test_that', allow_functions)) }]
  or self::expr/expr/SYMBOL_FUNCTION_CALL[text() = 'foreach']
  or self::OP-TILDE
  or self::LEFT_ASSIGN[text() = ':=']

tests/testthat/test-unnecessary_nesting_linter.R

@@ -325,7 +325,7 @@ test_that("rlang's double-brace operator is skipped", {
 test_that("unnecessary_nesting_linter blocks one-expression braced expressions", {
  expect_lint(
  trim_some("
- tryCatch(
+ tryToCatch(
  {
  foo(x)
  },
@@ -340,7 +340,7 @@ test_that("unnecessary_nesting_linter blocks one-expression braced expressions",
 test_that("unnecessary_nesting_linter allow_assignment= argument works", {
  expect_lint(
  trim_some("
- tryCatch(
+ tryToCatch(
  {
  idx <- foo(x)
  },
@@ -710,3 +710,26 @@ test_that("else that can drop braces is found", {
  linter
  )
 })
+
+patrick::with_parameters_test_that(
+ "default allowed functions are skipped",
+ expect_lint(sprintf("%s(x, {y}, z)", call), NULL, unnecessary_nesting_linter()),
+ call = c(
+ "test_that", "with_parameters_test_that",
+ "switch",
+ "try", "tryCatch", "withCallingHandlers",
+ "quote", "bquote", "expression", "substitute",
+ "observe", "observeEvent", "reactive",
+ "renderCachedPlot", "renderDataTable", "renderImage", "renderPlot",
+ "renderPrint", "renderTable", "renderText", "renderUI"
+ )
+)
+
+test_that("allow_functions= works", {
+ linter_default <- unnecessary_nesting_linter()
+ linter_foo <- unnecessary_nesting_linter(allow_functions = "foo")
+ expect_lint("foo(x, {y}, z)", "Reduce the nesting of this statement", linter_default)
+ expect_lint("foo(x, {y}, z)", NULL, linter_foo)
+ expect_lint("test_that('a', {y})", NULL, linter_default)
+ expect_lint("that_that('b', {y})", NULL, linter_foo)
+})