Merge branch 'main' into roxy-action

DESCRIPTION

@@ -192,7 +192,6 @@ Collate:
     'undesirable_operator_linter.R'
     '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'

NEWS.md

@@ -13,6 +13,7 @@
 * `all_linters()` has signature `all_linters(..., packages)` rather than `all_linters(packages, ...)` (#2332, @MichaelChirico). This forces `packages=` to be supplied by name and will break users who rely on supplying `packages=` positionally, of which we found none searching GitHub.
 * Adjusted various lint messages for consistency in readability (#1330, @MichaelChirico). In general, we favor lint messages to be phrased like "Action, reason" to but the "what" piece of the message front-and-center. This may be a breaking change for code that tests the specific phrasing of lints.
 * `extraction_operator_linter()` is deprecated. Although switching from `$` to `[[` has some robustness benefits for package code, it can lead to non-idiomatic code in many contexts (e.g. R6 classes, Shiny applications, etc.) (#2409, @IndrajeetPatil). To enable the detection of the `$` operator for extraction through partial matching, use `options(warnPartialMatchDollar = TRUE)`.
+* `unnecessary_nested_if_linter()` is deprecated and subsumed into the new/more general `unnecessary_nesting_linter()`.
 
 ## Bug fixes
 
@@ -59,11 +60,11 @@
 * `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).
+* `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).
 * `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 (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` (#2314 and 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` (#2313, #2314 and part of #884, @MichaelChirico).
 * `pipe_return_linter()` for discouraging usage of `return()` inside a {magrittr} pipeline (part of #884, @MichaelChirico).
 * `one_call_pipe_linter()` for discouraging one-step pipelines like `x |> as.character()` (#2330 and part of #884, @MichaelChirico).
 * `object_overwrite_linter()` for discouraging re-use of upstream package exports as local variables (#2344, #2346 and part of #884, @MichaelChirico and @AshesITR).

R/get_source_expressions.R

@@ -640,18 +640,7 @@ fix_eq_assigns <- function(pc) {
 
   for (i in seq_len(n_expr)) {
     start_loc <- true_locs[i]
-
-    # TODO(michaelchirico): vectorize this loop away. the tricky part is,
-    #   this loop doesn't execute on most R versions (we tried 3.6.3 and 4.2.0).
-    #   so it likely requires some GHA print debugging -- tedious :)
     end_loc <- true_locs[i]
-    j <- end_loc + 1L
-    # nocov start: only runs on certain R versions
-    while (j <= length(expr_locs) && !expr_locs[j]) {
-      end_loc <- j
-      j <- j + 1L
-    }
-    # nocov end
 
     prev_loc <- prev_locs[start_loc]
     next_loc <- next_locs[end_loc]

R/lintr-deprecated.R

@@ -161,3 +161,41 @@ extraction_operator_linter <- function() {
     )
   })
 }
+
+#' Unnecessary nested if linter
+#' @rdname lintr-deprecated
+#' @export
+unnecessary_nested_if_linter <- function() {
+  lintr_deprecated(
+    what = "unnecessary_nested_if_linter",
+    alternative = "unnecessary_nesting_linter",
+    version = "3.2.0",
+    type = "Linter",
+    signal = "warning"
+  )
+
+  xpath <- paste0(
+    "//IF/parent::expr[not(ELSE)]/OP-RIGHT-PAREN/",
+    c(
+      "following-sibling::expr[IF and not(ELSE)]", # catch if (cond) if (other_cond) { ... }
+      "following-sibling::expr[OP-LEFT-BRACE and count(expr) = 1]
+         /expr[IF and not(ELSE)]" # catch if (cond) { if (other_cond) { ... } }
+    ),
+    collapse = " | "
+  )
+
+  Linter(linter_level = "expression", function(source_expression) {
+    xml <- source_expression$xml_parsed_content
+
+    bad_exprs <- xml_find_all(xml, xpath)
+    xml_nodes_to_lints(
+      bad_exprs,
+      source_expression = source_expression,
+      lint_message = paste(
+        "Don't use nested `if` statements,",
+        "where a single `if` with the combined conditional expression will do.",
+        "For example, instead of `if (x) { if (y) { ... }}`, use `if (x && y) { ... }`."
+      )
+    )
+  })
+}

R/nrow_subset_linter.R

@@ -14,6 +14,16 @@
 #'   linters = nrow_subset_linter()
 #' )
 #'
+#' lint(
+#'   text = "nrow(filter(x, is_treatment))",
+#'   linters = nrow_subset_linter()
+#' )
+#'
+#' lint(
+#'   text = "x %>% filter(x, is_treatment) %>% nrow()",
+#'   linters = nrow_subset_linter()
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = "with(x, sum(is_treatment, na.rm = TRUE))",
@@ -25,7 +35,7 @@
 #' @include shared_constants.R
 #' @export
 nrow_subset_linter <- make_linter_from_function_xpath(
-  function_names = "subset",
+  function_names = c("subset", "filter"),
   xpath = glue("
   parent::expr
     /parent::expr

R/shared_constants.R

@@ -34,6 +34,7 @@ rx_static_token <- local({
 rx_unescaped_regex <- paste0("(?s)", rex(start, zero_or_more(rx_non_active_char), end))
 rx_static_regex <- paste0("(?s)", rex(start, zero_or_more(rx_static_token), end))
 rx_first_static_token <- paste0("(?s)", rex(start, zero_or_more(rx_non_active_char), rx_static_escape))
+rx_escapable_tokens <- "^${}().*+?|[]\\<>=:;/_-!@#%&,~"
 
 #' Determine whether a regex pattern actually uses regex patterns
 #'
@@ -95,19 +96,17 @@ get_fixed_string <- function(static_regex) {
 #'
 #' @noRd
 get_token_replacement <- function(token_content, token_type) {
-  if (token_type == "trivial_char_group") {
+  if (token_type == "trivial_char_group") { # otherwise, char_escape
     token_content <- substr(token_content, start = 2L, stop = nchar(token_content) - 1L)
     if (startsWith(token_content, "\\")) { # escape within trivial char group
       get_token_replacement(token_content, "char_escape")
     } else {
       token_content
     }
-  } else { # char_escape token
-    if (re_matches(token_content, rex("\\", one_of("^${}().*+?|[]\\<>=:;/_-!@#%&,~")))) {
-      substr(token_content, start = 2L, stop = nchar(token_content))
-    } else {
-      eval(parse(text = paste0('"', token_content, '"')))
-    }
+  } else if (re_matches(token_content, rex("\\", one_of(rx_escapable_tokens)))) {
+    substr(token_content, start = 2L, stop = nchar(token_content))
+  } else {
+    eval(parse(text = paste0('"', token_content, '"')))
   }
 }
 

R/unnecessary_nesting_linter.R

@@ -33,6 +33,12 @@
 #'   linters = unnecessary_nesting_linter(allow_assignment = FALSE)
 #' )
 #'
+#' writeLines("if (x) { \n  if (y) { \n   return(1L) \n  } \n}")
+#' lint(
+#'   text = "if (x) { \n  if (y) { \n   return(1L) \n  } \n}",
+#'   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)
@@ -55,6 +61,18 @@
 #'   linters = unnecessary_nesting_linter()
 #' )
 #'
+#' writeLines("if (x && y) { \n  return(1L) \n}")
+#' lint(
+#'   text = "if (x && y) { \n  return(1L) \n}",
+#'   linters = unnecessary_nesting_linter()
+#' )
+#'
+#' writeLines("if (x) { \n  y <- x + 1L\n  if (y) { \n   return(1L) \n  } \n}")
+#' lint(
+#'   text = "if (x) { \n  y <- x + 1L\n  if (y) { \n   return(1L) \n  } \n}",
+#'   linters = unnecessary_nesting_linter()
+#' )
+#'
 #' @evalRd rd_tags("unnecessary_nesting_linter")
 #' @seealso
 #'  - [cyclocomp_linter()] for another linter that penalizes overly complexcode.
@@ -141,6 +159,19 @@ unnecessary_nesting_linter <- function(allow_assignment = TRUE) {
     ]
   ")
 
+  unnecessary_nested_if_xpath <- paste0(
+    "//IF/parent::expr[not(ELSE)]/OP-RIGHT-PAREN/",
+    c(
+      # catch if (cond) if (other_cond) { ... }
+      "following-sibling::expr[IF and not(ELSE)]",
+      # catch if (cond) { if (other_cond) { ... } }
+      "following-sibling::expr[OP-LEFT-BRACE and count(expr) = 1]/expr[IF and not(ELSE)]"
+    ),
+    collapse = " | "
+  )
+
+  unnecessary_else_brace_xpath <-  "//IF/parent::expr[parent::expr[preceding-sibling::ELSE and count(expr) = 1]]"
+
   Linter(linter_level = "expression", function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
@@ -165,6 +196,25 @@ unnecessary_nesting_linter <- function(allow_assignment = TRUE) {
       type = "warning"
     )
 
-    c(if_else_exit_lints, unnecessary_brace_lints)
+    unnecessary_nested_if_expr <- xml_find_all(xml, unnecessary_nested_if_xpath)
+    unnecessary_nested_if_lints <- xml_nodes_to_lints(
+      unnecessary_nested_if_expr,
+      source_expression = source_expression,
+      lint_message = paste(
+        "Don't use nested `if` statements, where a single `if` with the combined conditional expression will do.",
+        "For example, instead of `if (x) { if (y) { ... }}`, use `if (x && y) { ... }`."
+      ),
+      type = "warning"
+    )
+
+    unnecessary_else_brace_expr <- xml_find_all(xml, unnecessary_else_brace_xpath)
+    unnecessary_else_brace_lints <- xml_nodes_to_lints(
+      unnecessary_else_brace_expr,
+      source_expression = source_expression,
+      lint_message = "Simplify this condition by using 'else if' instead of 'else { if.",
+      type = "warning"
+    )
+
+    c(if_else_exit_lints, unnecessary_brace_lints, unnecessary_nested_if_lints, unnecessary_else_brace_lints)
   })
 }

inst/lintr/linters.csv

@@ -112,8 +112,8 @@ undesirable_function_linter,style efficiency configurable robustness best_practi
 undesirable_operator_linter,style efficiency configurable robustness best_practices
 unnecessary_concatenation_linter,style readability efficiency configurable
 unnecessary_lambda_linter,best_practices efficiency readability configurable
-unnecessary_nested_if_linter,readability best_practices
-unnecessary_nesting_linter,readability consistency configurable
+unnecessary_nested_if_linter,readability best_practices deprecated
+unnecessary_nesting_linter,readability consistency configurable best_practices
 unnecessary_placeholder_linter,readability best_practices
 unneeded_concatenation_linter,style readability efficiency configurable deprecated
 unreachable_code_linter,best_practices readability configurable