Make scalar_in_linter() configurable

NEWS.md

@@ -54,6 +54,7 @@
 * `any_is_na_linter()` is extended to catch the unusual usage `NA %in% x` (#2113, @MichaelChirico).
 * `make_linter_from_xpath()` errors up front when `lint_message` is missing (instead of delaying this error until the linter is used, #2541, @MichaelChirico).
 * `paste_linter()`  is extended to recommend using `paste()` instead of `paste0()` for simply aggregating a character vector with `collapse=`, i.e., when `sep=` is irrelevant (#1108, @MichaelChirico).
+* `scalar_in_linter` is now configurable to allow other `%in%` like operators to be linted. `%chin%` is no longer linted by default. (@F-Noelle)
 
 ### New linters
 

R/scalar_in_linter.R

@@ -1,12 +1,13 @@
 #' Block usage like x %in% "a"
 #'
 #' `vector %in% set` is appropriate for matching a vector to a set, but if
-#'   that set has size 1, `==` is more appropriate. `%chin%` from `{data.table}`
-#'   is matched as well.
+#'   that set has size 1, `==` is more appropriate.
 #'
 #' `scalar %in% vector` is OK, because the alternative (`any(vector == scalar)`)
 #'   is more circuitous & potentially less clear.
 #'
+#' @param in_operators Character vector of additional functions that behave like the `%in%` operator
+#'
 #' @examples
 #' # will produce lints
 #' lint(
@@ -16,7 +17,7 @@
 #'
 #' lint(
 #'   text = "x %chin% 'a'",
-#'   linters = scalar_in_linter()
+#'   linters = scalar_in_linter(in_operators = "%chin%")
 #' )
 #'
 #' # okay
@@ -28,27 +29,33 @@
 #' @evalRd rd_tags("scalar_in_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
-scalar_in_linter <- function() {
+scalar_in_linter <- function(in_operators = NULL) {
   # TODO(#2085): Extend to include other cases where the RHS is clearly a scalar
   # NB: all of logical, integer, double, hex, complex are parsed as NUM_CONST
-  xpath <- "
-  //SPECIAL[text() = '%in%' or text() = '%chin%']
+  xpath <- glue("
+  //SPECIAL[{xp_text_in_table(c('%in%', {in_operators}))}]
     /following-sibling::expr[NUM_CONST[not(starts-with(text(), 'NA'))] or STR_CONST]
     /parent::expr
-  "
+  ")
 
   Linter(linter_level = "expression", function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     bad_expr <- xml_find_all(xml, xpath)
     in_op <- xml_find_chr(bad_expr, "string(SPECIAL)")
-    lint_msg <-
-      paste0("Use == to match length-1 scalars, not ", in_op, ". Note that == preserves NA where ", in_op, " does not.")
+    msg <- ifelse(
+      in_op == "%in%",
+      "Use == to match length-1 scalars instead of %in%. Note that == preserves NA where %in% does not.",
+      glue(
+        "{in_op} behaves similar to %in%. ",
+        "Use operators like == to match length-1 scalars instead of operators like %in%."
+      )
+    )
 
     xml_nodes_to_lints(
       bad_expr,
       source_expression = source_expression,
-      lint_message = lint_msg,
+      lint_message = msg,
       type = "warning"
     )
   })

inst/lintr/linters.csv

@@ -90,7 +90,7 @@ repeat_linter,style readability
 return_linter,style configurable default
 routine_registration_linter,best_practices efficiency robustness
 sample_int_linter,efficiency readability robustness
-scalar_in_linter,readability consistency best_practices efficiency
+scalar_in_linter,readability consistency best_practices efficiency configurable
 semicolon_linter,style readability default configurable
 semicolon_terminator_linter,defunct
 seq_linter,robustness efficiency consistency best_practices default

tests/testthat/test-scalar_in_linter.R

@@ -3,28 +3,48 @@ test_that("scalar_in_linter skips allowed usages", {
 
   expect_lint("x %in% y", NULL, linter)
   expect_lint("y %in% c('a', 'b')", NULL, linter)
-  expect_lint("c('a', 'b') %chin% x", NULL, linter)
+  expect_lint("c('a', 'b') %in% x", NULL, linter)
   expect_lint("z %in% 1:3", NULL, linter)
   # scalars on LHS are fine (often used as `"col" %in% names(DF)`)
   expect_lint("3L %in% x", NULL, linter)
-
   # this should be is.na(x), but it more directly uses the "always TRUE/FALSE, _not_ NA"
   #   aspect of %in%, so we delegate linting here to equals_na_linter()
   expect_lint("x %in% NA", NULL, linter)
   expect_lint("x %in% NA_character_", NULL, linter)
 })
 
 test_that("scalar_in_linter blocks simple disallowed usages", {
-  linter <- scalar_in_linter()
-  lint_in_msg <- rex::rex("Use == to match length-1 scalars, not %in%.")
-  lint_chin_msg <- rex::rex("Use == to match length-1 scalars, not %chin%.")
+  linter <- scalar_in_linter(in_operators = c("%chin%", "%notin%"))
+
+  lint_in_msg <- rex::rex("Use == to match length-1 scalars instead of %in%.")
+  lint_chin_msg <- rex::rex("%chin% behaves similar to %in%.")
+  lint_notin_msg <- rex::rex("%notin% behaves similar to %in%.")
 
   expect_lint("x %in% 1", lint_in_msg, linter)
   expect_lint("x %chin% 'a'", lint_chin_msg, linter)
+  expect_lint("x %notin% 1", lint_notin_msg, linter)
+})
+
+test_that("scalar_in_linter blocks or skips based on configuration", {
+  linter_default <- scalar_in_linter()
+  linter_config <- scalar_in_linter(in_operators = "%notin%")
+
+  lint_in_msg <- rex::rex("Use == to match length-1 scalars instead of %in%.")
+  lint_notin_msg <- rex::rex("%notin% behaves similar to %in%.")
+
+  # default
+  expect_lint("x %in% 1", lint_in_msg, linter_default)
+  expect_lint("x %notin% 1", NULL, linter_default)
+  expect_lint("x %notin% y", NULL, linter_default)
+
+  # configured
+  expect_lint("x %in% 1", lint_in_msg, linter_config)
+  expect_lint("x %notin% 1", lint_notin_msg, linter_config)
+  expect_lint("x %notin% y", NULL, linter_config)
 })
 
 test_that("multiple lints are generated correctly", {
-  linter <- scalar_in_linter()
+  linter <- scalar_in_linter(in_operators = "%chin%")
 
   expect_lint(
     trim_some('{