New linter for complex conditional expressions

DESCRIPTION

@@ -76,6 +76,7 @@ Collate:
     'commas_linter.R'
     'commented_code_linter.R'
     'comparison_negation_linter.R'
+    'complex_conditional_linter.R'
     'condition_call_linter.R'
     'condition_message_linter.R'
     'conjunct_test_linter.R'

NAMESPACE

@@ -31,6 +31,7 @@ export(closed_curly_linter)
 export(commas_linter)
 export(commented_code_linter)
 export(comparison_negation_linter)
+export(complex_conditional_linter)
 export(condition_call_linter)
 export(condition_message_linter)
 export(conjunct_test_linter)

NEWS.md

@@ -19,7 +19,6 @@
 * `scalar_in_linter` is now configurable to allow other `%in%` like operators to be linted. The data.table operator `%chin%` is no longer linted by default; use `in_operators = "%chin%"` to continue linting it. (@F-Noelle)
 * `lint()` and friends now normalize paths to forward slashes on Windows (@olivroy, #2613).
 * `undesirable_function_linter()`, `undesirable_operator_linter()`, and `list_comparison_linter()` were removed from the tag `efficiency` (@IndrajeetPatil, #2655). If you use `linters_with_tags("efficiency")` to include these linters, you'll need to adjust your config to keep linting your code against them. We did not find any such users on GitHub.
-
 
 ## Bug fixes
 
@@ -47,7 +46,7 @@
   + `return_functions` to customize which functions are equivalent to `return()` as "exit" clauses, e.g. `rlang::abort()` can be considered in addition to the default functions like `stop()` and `q()` from base (#2271 and part of #884, @MichaelChirico and @MEO265).
   + `except` to customize which functions are ignored entirely (i.e., whether they have a return of the specified style is not checked; #2271 and part of #884, @MichaelChirico and @MEO265). Namespace hooks like `.onAttach()` and `.onLoad()` are always ignored.
   + `except_regex`, the same purpose as `except=`, but filters functions by pattern. This is motivated by {RUnit}, where test suites are based on unit test functions matched by pattern, e.g. `^Test`, and where explicit return may be awkward (#2335, @MichaelChirico).
-* `unnecessary_lambda_linter` is extended to encourage vectorized comparisons where possible, e.g. `sapply(x, sum) > 0` instead of `sapply(x, function(x) sum(x) > 0)` (part of #884, @MichaelChirico). Toggle this behavior with argument `allow_comparison`.
+* `unnecessary_lambda_linter()` is extended to encourage vectorized comparisons where possible, e.g. `sapply(x, sum) > 0` instead of `sapply(x, function(x) sum(x) > 0)` (part of #884, @MichaelChirico). Toggle this behavior with argument `allow_comparison`.
 * `backport_linter()` is slightly faster by moving expensive computations outside the linting function (#2339, #2348, @AshesITR and @MichaelChirico).
 * `Linter()` has a new argument `linter_level` (default `NA`). This is used by `lint()` to more efficiently check for expression levels than the idiom `if (!is_lint_level(...)) { return(list()) }` (#2351, @AshesITR).
 * `string_boundary_linter()` recognizes regular expression calls like `grepl("^abc$", x)` that can be replaced by using `==` instead (#1613, @MichaelChirico).
@@ -83,6 +82,7 @@
 * `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).
+* `complex_conditional_linter()` for encouraging refactoring of complex conditional expressions (like `if (x > 0 && y < 0 || z == 0)`) via well-named abstractions (#2676, @IndrajeetPatil).
 
 ### Lint accuracy fixes: removing false positives
 

R/complex_conditional_linter.R

@@ -0,0 +1,111 @@
+#' Complex Conditional Expressions Linter
+#'
+#' Detects complex conditional expressions and suggests extracting
+#' them into Boolean functions or variables for improved readability and reusability.
+#'
+#' For example, if you have a conditional expression with more than two logical operands,
+#'
+#' ```
+#' if (looks_like_a_duck(x) &&
+#'     swims_like_a_duck(x) &&
+#'     quacks_like_a_duck(x)) {
+#'     ...
+#' }
+#' ````
+#'
+#' to improve its readability and reusability, you can extract the conditional expression.
+#'
+#' You can either extract it into a Boolean function:
+#'
+#' ```
+#' is_duck <- function(x) {
+#'   looks_like_a_duck(x) &&
+#'     swims_like_a_duck(x) &&
+#'     quacks_like_a_duck(x)
+#' }
+#'
+#' if (is_duck(x)) {
+#'   ...
+#' }
+#' ```
+#'
+#' or into a Boolean variable:
+#'
+#' ```
+#' is_duck <- looks_like_a_duck(x) &&
+#'    swims_like_a_duck(x) &&
+#'    quacks_like_a_duck(x)
+#'
+#' if (is_duck) {
+#'  ...
+#' }
+#' ```
+#'
+#' In addition to improving code readability, extracting complex conditional expressions
+#' has the added benefit of introducing a reusable abstraction.
+#'
+#' @param threshold Integer. The maximum number of logical operators (`&&` or `||`)
+#'   allowed in a conditional expression. The default is `2L`, meaning any conditional expression
+#'   with more than two logical operators will be flagged.
+#'
+#' @examples
+#' # will produce lints
+#' code <- "if (a && b && c) { do_something() }"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = complex_conditional_linter()
+#' )
+#'
+#' # okay
+#' code <- "if (ready_to_do_something) { do_something() }"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = complex_conditional_linter()
+#' )
+#'
+#' code <- "if (a && b && c) { do_something() }"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = complex_conditional_linter(threshold = 2L)
+#' )
+#'
+#' @evalRd rd_tags("complex_conditional_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+complex_conditional_linter <- function(threshold = 2L) {
+  stopifnot(is.numeric(threshold), length(threshold) == 1L, threshold >= 1L)
+  threshold <- as.integer(threshold)
+
+  xpath <- glue::glue("//expr[
+    parent::expr[IF or WHILE]
+    and
+    preceding-sibling::*[1][self::OP-LEFT-PAREN]
+    and
+    following-sibling::*[1][self::OP-RIGHT-PAREN]
+    and
+    count(descendant-or-self::*[AND2 or OR2]) > {threshold}
+  ]")
+
+
+  Linter(linter_level = "expression", function(source_expression) {
+    xml <- source_expression$xml_parsed_content
+
+    nodes <- xml2::xml_find_all(xml, xpath)
+
+    lints <- xml_nodes_to_lints(
+      nodes,
+      source_expression = source_expression,
+      lint_message = paste0(
+        "Complex conditional with more than ",
+        threshold,
+        " logical operator(s). Consider extracting into a boolean function or variable for readability and reusability."
+      ),
+      type = "warning"
+    )
+
+    lints
+  })
+}

R/get_source_expressions.R

@@ -85,8 +85,9 @@ get_source_expressions <- function(filename, lines = NULL) {
   names(source_expression$lines) <- seq_along(source_expression$lines)
   source_expression$content <- get_content(source_expression$lines)
   parsed_content <- get_source_expression(source_expression, error = function(e) lint_parse_error(e, source_expression))
+  is_unreliable_lint <- is.na(e$line) || !nzchar(e$line) || e$message == "unexpected end of input"
 
-  if (is_lint(e) && (is.na(e$line) || !nzchar(e$line) || e$message == "unexpected end of input")) {
+  if (is_lint(e) && is_unreliable_lint) {
     # Don't create expression list if it's unreliable (invalid encoding or unhandled parse error)
     expressions <- list()
   } else {

R/lint.R

@@ -360,11 +360,11 @@ validate_linter_object <- function(linter, name) {
   )
 }
 
+# A linter factory is a function whose last call is to `Linter()`
 is_linter_factory <- function(fun) {
-  # A linter factory is a function whose last call is to Linter()
   bdexpr <- body(fun)
-  # covr internally transforms each call into if (TRUE) { covr::count(...); call }
-  while (is.call(bdexpr) && (bdexpr[[1L]] == "{" || (bdexpr[[1L]] == "if" && bdexpr[[2L]] == "TRUE"))) {
+  # covr internally transforms each call into `if (TRUE) { covr::count(...); call }`
+  while (is.call(bdexpr) && (bdexpr[[1L]] == "{" || (bdexpr[[1L]] == "if" && bdexpr[[2L]] == "TRUE"))) { # nolint: complex_conditional_linter
     bdexpr <- bdexpr[[length(bdexpr)]]
   }
   is.call(bdexpr) && identical(bdexpr[[1L]], as.name("Linter"))

R/unnecessary_nesting_linter.R

@@ -238,7 +238,7 @@ unnecessary_nesting_linter <- function(
     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.",
+      lint_message = "Simplify this condition by using 'else if' instead of 'else { if'.",
       type = "warning"
     )
 

R/utils.R

@@ -1,5 +1,6 @@
 `%||%` <- function(x, y) {
-  if (is.null(x) || length(x) == 0L || (is.atomic(x[[1L]]) && is.na(x[[1L]]))) {
+  is_atomic_and_missing <- is.atomic(x[[1L]]) && is.na(x[[1L]])
+  if (is.null(x) || length(x) == 0L || is_atomic_and_missing) {
     y
   } else {
     x

inst/lintr/linters.csv

@@ -11,6 +11,7 @@ closed_curly_linter,defunct
 commas_linter,style readability default configurable
 commented_code_linter,style readability best_practices default
 comparison_negation_linter,readability consistency
+complex_conditional_linter,style readability best_practices configurable
 condition_call_linter,style tidy_design best_practices configurable
 condition_message_linter,best_practices consistency
 conjunct_test_linter,package_development best_practices readability configurable pkg_testthat