if_not_else_linter() for "double negation" in if statements

DESCRIPTION

@@ -105,6 +105,7 @@ Collate:
     'function_return_linter.R'
     'get_source_expressions.R'
     'ids_with_token.R'
+    'if_not_else_linter.R'
     'ifelse_censor_linter.R'
     'implicit_assignment_linter.R'
     'implicit_integer_linter.R'

NAMESPACE

@@ -69,6 +69,7 @@ export(function_return_linter)
 export(get_r_string)
 export(get_source_expressions)
 export(ids_with_token)
+export(if_not_else_linter)
 export(ifelse_censor_linter)
 export(implicit_assignment_linter)
 export(implicit_integer_linter)

NEWS.md

@@ -38,6 +38,7 @@
 * `library_call_linter()` can detect if all library/require calls are not at the top of your script (#2027 and #2043, @nicholas-masel and @MichaelChirico).
 * `keyword_quote_linter()` for finding unnecessary or discouraged quoting of symbols in assignment, function arguments, or extraction (part of #884, @MichaelChirico). Quoting is unnecessary when the target is a valid R name, e.g. `c("a" = 1)` can be `c(a = 1)`. The same goes to assignment (`"a" <- 1`) and extraction (`x$"a"`). Where quoting is necessary, the linter encourages doing so with backticks (e.g. `` x$`a b` `` instead of `x$"a b"`).
 * `length_levels_linter()` for using the specific function `nlevels()` instead of checking `length(levels(x))` (part of #884, @MichaelChirico).
+* `if_not_else_linter()` for encouraging `if` statements to be structured as `if (A) x else y` instead of `if (!A) y else x` (part of #884, @MichaelChirico).
 
 ## Changes to defaults
 

R/if_not_else_linter.R

@@ -0,0 +1,108 @@
+#' Block statements like if (!A) x else y
+#'
+#' `if (!A) x else y` is the same as `if (A) y else x`, but the latter is
+#'   easier to reason about in the `else` case. The former requires
+#'   double negation that can be avoided by switching the statement order.
+#'
+#' This only applies in the simple `if/else` case. Statements like
+#'   `if (!A) x else if (B) y else z` don't always have a simpler or
+#'   more readable form.
+#'
+#' It also applies to [ifelse()] and the package equivalents
+#'   `dplyr::if_else()` and `data.table::fifelse()`.
+#'
+#' @param exceptions Character vector of calls to exclude from linting.
+#'   By default, [is.null()], [is.na()], and [missing()] are excluded
+#'   given the common idiom `!is.na(x)` as "x is present".
+#'
+#' @examples
+#' # will produce lints
+#' lint(
+#'   text = "if (!A) x else y",
+#'   linters = if_not_else_linter()
+#' )
+#'
+#' lint(
+#'   text = "ifelse(!is_treatment, x, y)",
+#'   linters = if_not_else_linter()
+#' )
+#'
+#' lint(
+#'   text = "if (!is.null(x)) x else 2",
+#'   linters = if_not_else_linter(exceptions = character())
+#' )
+#'
+#' # okay
+#' lint(
+#'   text = "if (A) x else y",
+#'   linters = if_not_else_linter()
+#' )
+#'
+#' lint(
+#'   text = "ifelse(is_treatment, y, x)",
+#'   linters = if_not_else_linter()
+#' )
+#'
+#' lint(
+#'   text = "if (!is.null(x)) x else 2",
+#'   linters = if_not_else_linter()
+#' )
+#'
+#' @evalRd rd_tags("if_not_else_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+if_not_else_linter <- function(exceptions = c("is.null", "is.na", "missing")) {
+  if_xpath <- glue("
+  //IF[following-sibling::ELSE[not(following-sibling::expr[IF])]]
+    /following-sibling::expr[1][
+      OP-EXCLAMATION
+      and not(expr[expr[SYMBOL_FUNCTION_CALL[{ xp_text_in_table(exceptions) }]]])
+    ]
+  ")
+
+  ifelse_xpath <- glue("
+  //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]
+    /parent::expr
+    /parent::expr[expr[
+      position() = 2
+      and OP-EXCLAMATION
+      and not(expr[
+        OP-EXCLAMATION
+        or expr/SYMBOL_FUNCTION_CALL[{ xp_text_in_table(exceptions) }]
+      ])
+    ]]
+  ")
+
+  Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+
+    xml <- source_expression$xml_parsed_content
+
+    if_expr <- xml_find_all(xml, if_xpath)
+    if_lints <- xml_nodes_to_lints(
+      if_expr,
+      source_expression = source_expression,
+      lint_message = paste(
+        "In a simple if/else statement,",
+        "prefer `if (A) x else y` to the less-readable `if (!A) y else x`."
+      ),
+      type = "warning"
+    )
+
+    ifelse_expr <- xml_find_all(xml, ifelse_xpath)
+    ifelse_call <- xp_call_name(ifelse_expr)
+    ifelse_lints <- xml_nodes_to_lints(
+      ifelse_expr,
+      source_expression = source_expression,
+      lint_message = sprintf(
+        "Prefer `%1$s(A, x, y)` to the less-readable `%1$s(!A, y, x)`.",
+        ifelse_call
+      ),
+      type = "warning"
+    )
+
+    c(if_lints, ifelse_lints)
+  })
+}

R/xp_utils.R

@@ -2,6 +2,7 @@
 
 # like `text() %in% table`, translated to XPath 1.0
 xp_text_in_table <- function(table) {
+  if (length(table) == 0L) return("true")
   # xpath doesn't seem to have a standard way of escaping quotes, so attempt
   #   to use "" whenever the string has ' (not a perfect solution). info on
   #   escaping from https://stackoverflow.com/questions/14822153

inst/lintr/linters.csv

@@ -34,6 +34,7 @@ for_loop_index_linter,best_practices readability robustness
 function_argument_linter,style consistency best_practices
 function_left_parentheses_linter,style readability default
 function_return_linter,readability best_practices
+if_not_else_linter,readability consistency configurable
 ifelse_censor_linter,best_practices efficiency
 implicit_assignment_linter,style best_practices readability configurable
 implicit_integer_linter,style consistency best_practices configurable

tests/testthat/test-if_not_else_linter.R

@@ -0,0 +1,85 @@
+test_that("if_not_else_linter skips allowed usages", {
+  linter <- if_not_else_linter()
+
+  # simple if/else statement is fine
+  expect_lint("if (A) x else y", NULL, linter)
+  # not plain negation --> OK
+  expect_lint("if (!A || B) x else y", NULL, linter)
+  # no else clause --> OK
+  expect_lint("if (!A) x", NULL, linter)
+
+  # nested statements are also OK
+  expect_lint("if (!A) x else if (B) y", NULL, linter)
+  expect_lint("if (!A) x else if (B) y else z", NULL, linter)
+
+  # ! picked up in the evaluation statements is skipped
+  expect_lint("if (A) !x else y", NULL, linter)
+  expect_lint("if (A) x else !y", NULL, linter)
+})
+
+test_that("if_not_else_linter blocks simple disallowed usages", {
+  linter <- if_not_else_linter()
+  lint_msg <- rex::rex("In a simple if/else statement, prefer `if (A) x else y`")
+
+  expect_lint("if (!A) x else y", lint_msg, linter)
+
+  # ditto for more complicated expressions where ! is still the outer operator
+  expect_lint("if (!x %in% 1:10) y else z", lint_msg, linter)
+})
+
+patrick::with_parameters_test_that(
+  "if_not_else_linter blocks usages in ifelse() and friends as well",
+  {
+    linter <- if_not_else_linter()
+    expect_lint(sprintf("%s(!A | B, x, y)", ifelse_fun), NULL, linter)
+    expect_lint(sprintf("%s(A, !x, y)", ifelse_fun), NULL, linter)
+    expect_lint(
+      sprintf("%s(!A, x, y)", ifelse_fun),
+      sprintf("Prefer `%s[(]A, x, y[)]` to the less-readable", ifelse_fun),
+      linter
+    )
+    # particularly relevant for if_else()
+    expect_lint(sprintf("%s(!!A, x, y)", ifelse_fun), NULL, linter)
+  },
+  .test_name = c("ifelse", "fifelse", "if_else"),
+  ifelse_fun = c("ifelse", "fifelse", "if_else")
+)
+
+test_that("if_not_else_linter skips negated calls to is.null & similar", {
+  linter <- if_not_else_linter()
+
+  expect_lint("if (!is.null(x)) x else y", NULL, linter)
+  expect_lint("if (!is.na(x)) x else y", NULL, linter)
+  expect_lint("if (!missing(x)) x else y", NULL, linter)
+  expect_lint("ifelse(!is.na(x), x, y)", NULL, linter)
+})
+
+test_that("multiple lints are generated correctly", {
+  expect_lint(
+    trim_some("{
+        if (!A) x else B
+        ifelse(!A, x, y)
+        fifelse(!A, x, y)
+        if_else(!A, x, y)
+    }"),
+    list(
+      "In a simple if/else statement",
+      "Prefer `ifelse",
+      "Prefer `fifelse",
+      "Prefer `if_else"
+    ),
+    if_not_else_linter()
+  )
+})
+
+test_that("exceptions= argument works", {
+  expect_lint(
+    "if (!is.null(x)) x else y",
+    "In a simple if/else statement",
+    if_not_else_linter(exceptions = character())
+  )
+
+  expect_lint("if (!foo(x)) y else z", NULL, if_not_else_linter(exceptions = "foo"))
+})
+
+# TODO(michaelchirico): should if (A != B) be considered as well?