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. The data.table operator `%chin%` is no longer linted by default; use `in_operators = "%chin%"` to continue linting it. (@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 infix operators 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,22 +29,24 @@
 #' @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.")
+ lint_msg <- glue(
+ "Use comparison operators (e.g. ==, !=, etc.) to match length-1 scalars instead of {in_op} ",
+ "as these operators preserve NA where {in_op} does not."
+ )
 
  xml_nodes_to_lints(
  bad_expr,

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,44 @@ 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_msg <- rex::rex("Use comparison operators (e.g. ==, !=, etc.) to match length-1 scalars instead of")
+
+ expect_lint("x %in% 1", lint_msg, linter)
+ expect_lint("x %chin% 'a'", lint_msg, linter)
+ expect_lint("x %notin% 1", lint_msg, linter)
+})
 
- expect_lint("x %in% 1", lint_in_msg, linter)
- expect_lint("x %chin% 'a'", lint_chin_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_msg <- rex::rex("Use comparison operators (e.g. ==, !=, etc.) to match length-1 scalars instead of")
+
+ # default
+ expect_lint("x %in% 1", lint_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_msg, linter_config)
+ expect_lint("x %notin% 1", lint_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('{