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

@@ -32,6 +32,7 @@ export(clear_cache)
 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

@@ -8,6 +8,10 @@
    + Linters `closed_curly_linter()`, `open_curly_linter()`, `paren_brace_linter()`, and `semicolon_terminator_linter()`.
    + `linter=` argument of `Lint()`.
 
+## New linters
+
+* `complex_conditional_linter()` for encouraging refactoring of complex conditional expressions (like `if (x > 0 && y < 0 || z == 0)`) via well-named abstractions (#2676, @IndrajeetPatil).
+
 # lintr 3.2.0
 
 ## Deprecations & breaking changes
@@ -93,6 +97,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

@@ -353,11 +353,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

@@ -277,7 +277,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

@@ -10,6 +10,7 @@ class_equals_linter,best_practices robustness consistency
 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

lintr.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: ab4c2695-5b43-4cc6-8ea0-0daf83afd8a3
 
 RestoreWorkspace: No
 SaveWorkspace: No