Merge e8f755d into 15a22fe

Author: MichaelChirico

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