Extend allow_filter in conjunct_test_linter() to allow linting only dplyr::filter() (i.e. qualified) (#2169)

* extend allow_dplyr in conjunct_test_linter() for finer tuning

* issue in NEWS

* Update test-conjunct_test_linter.R

---------

Co-authored-by: AshesITR <alexander.rosenstock@web.de>

Author: MichaelChirico

NEWS.md

@@ -35,7 +35,7 @@
   + `yoda_test_linter()`
 * `sprintf_linter()` is pipe-aware, so that `x %>% sprintf(fmt = "%s")` no longer lints (#1943, @MichaelChirico).
 * `line_length_linter()` helpfully includes the line length in the lint message (#2057, @MichaelChirico).
-* `conjunct_test_linter()` also lints usage like `dplyr::filter(x, A & B)` in favor of using `dplyr::filter(x, A, B)` unless `allow_filter = TRUE` (part of #884, @MichaelChirico; #2110, @salim-b).
+* `conjunct_test_linter()` also lints usage like `dplyr::filter(x, A & B)` in favor of using `dplyr::filter(x, A, B)` (part of #884; #2110 and #2078, @salim-b and @MichaelChirico). Option `allow_filter` toggles when this applies. `allow_filter = "always"` drops such lints entirely, while `"not_dplyr"` only lints calls explicitly qualified as `dplyr::filter()`. The default, `"never"`, assumes all unqualified calls to `filter()` are `dplyr::filter()`.
 * `sort_linter()` checks for code like `x == sort(x)` which is better served by using the function `is.unsorted()` (part of #884, @MichaelChirico).
 * `paste_linter()` gains detection for file paths that are better constructed with `file.path()`, e.g. `paste0(dir, "/", file)` would be better as `file.path(dir, file)` (part of #884, #2082, @MichaelChirico). What exactly gets linted here can be fine-tuned with the `allow_file_path` option (`"double_slash"` by default, with alternatives `"never"` and `"always"`). When `"always"`, these rules are ignored. When `"double_slash"`, paths appearing to construct a URL that have consecutive forward slashes (`/`) are skipped. When `"never"`, even URLs should be construced with `file.path()`.
 * `seq_linter()` recommends `rev()` in the lint message for lints like `nrow(x):1` (#1542, @MichaelChirico).

R/conjunct_test_linter.R

@@ -14,7 +14,9 @@
 #'
 #' @param allow_named_stopifnot Logical, `TRUE` by default. If `FALSE`, "named" calls to `stopifnot()`,
 #'   available since R 4.0.0 to provide helpful messages for test failures, are also linted.
-#' @param allow_filter Logical, `FALSE` by default. If `TRUE`, `filter()` expressions are not linted.
+#' @param allow_filter Character naming the method for linting calls to `filter()`. The default, `"never"`, means
+#'   `filter()` and `dplyr::filter()` calls are linted; `"not_dplyr"` means only `dplyr::filter()` calls are linted;
+#'   and `"always"` means no calls to `filter()` are linted. Calls like `stats::filter()` are never linted.
 #'
 #' @examples
 #' # will produce lints
@@ -38,6 +40,11 @@
 #'   linters = conjunct_test_linter()
 #' )
 #'
+#' lint(
+#'   text = "filter(mtcars, mpg > 20 & vs == 0)",
+#'   linters = conjunct_test_linter()
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = "expect_true(x || (y && z))",
@@ -51,14 +58,26 @@
 #'
 #' lint(
 #'   text = "dplyr::filter(mtcars, mpg > 20 & vs == 0)",
-#'   linters = conjunct_test_linter(allow_filter = TRUE)
+#'   linters = conjunct_test_linter(allow_filter = "always")
+#' )
+#'
+#' lint(
+#'   text = "filter(mtcars, mpg > 20 & vs == 0)",
+#'   linters = conjunct_test_linter(allow_filter = "not_dplyr")
+#' )
+#'
+#' lint(
+#'   text = "stats::filter(mtcars$cyl, mtcars$mpg > 20 & mtcars$vs == 0)",
+#'   linters = conjunct_test_linter()
 #' )
 #'
 #' @evalRd rd_tags("conjunct_test_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 conjunct_test_linter <- function(allow_named_stopifnot = TRUE,
-                                 allow_filter = FALSE) {
+                                 allow_filter = c("never", "not_dplyr", "always")) {
+  allow_filter <- match.arg(allow_filter)
+
   expect_true_assert_that_xpath <- "
   //SYMBOL_FUNCTION_CALL[text() = 'expect_true' or text() = 'assert_that']
     /parent::expr
@@ -85,12 +104,17 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE,
     sep = " | "
   )
 
-  filter_xpath <- "
+  filter_ns_cond <- switch(allow_filter,
+    never = "not(SYMBOL_PACKAGE[text() != 'dplyr'])",
+    not_dplyr = "SYMBOL_PACKAGE[text() = 'dplyr']",
+    always = "true"
+  )
+  filter_xpath <- glue("
   //SYMBOL_FUNCTION_CALL[text() = 'filter']
-    /parent::expr[not(SYMBOL_PACKAGE[text() != 'dplyr'])]
+    /parent::expr[{ filter_ns_cond }]
     /parent::expr
     /expr[AND]
-  "
+  ")
 
   Linter(function(source_expression) {
     # need the full file to also catch usages at the top level
@@ -122,7 +146,7 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE,
       type = "warning"
     )
 
-    if (!allow_filter) {
+    if (allow_filter != "always") {
       filter_expr <- xml_find_all(xml, filter_xpath)
 
       filter_lints <- xml_nodes_to_lints(

man/conjunct_test_linter.Rd

@@ -33,67 +33,40 @@ test_that("conjunct_test_linter blocks && conditions with expect_true()", {
 })
 
 test_that("conjunct_test_linter blocks || conditions with expect_false()", {
-  expect_lint(
-    "expect_false(x || y)",
-    rex::rex("Instead of expect_false(A || B), write multiple expectations"),
-    conjunct_test_linter()
-  )
+  linter <- conjunct_test_linter()
+  lint_msg <- rex::rex("Instead of expect_false(A || B), write multiple expectations")
 
-  expect_lint(
-    "expect_false(x || y || z)",
-    rex::rex("Instead of expect_false(A || B), write multiple expectations"),
-    conjunct_test_linter()
-  )
+  expect_lint("expect_false(x || y)", lint_msg, linter)
+  expect_lint("expect_false(x || y || z)", lint_msg, linter)
 
   # these lint because `||` is always outer by operator precedence
-  expect_lint(
-    "expect_false(x || y && z)",
-    rex::rex("Instead of expect_false(A || B), write multiple expectations"),
-    conjunct_test_linter()
-  )
-  expect_lint(
-    "expect_false(x && y || z)",
-    rex::rex("Instead of expect_false(A || B), write multiple expectations"),
-    conjunct_test_linter()
-  )
+  expect_lint("expect_false(x || y && z)", lint_msg, linter)
+  expect_lint("expect_false(x && y || z)", lint_msg, linter)
 })
 
 test_that("conjunct_test_linter skips allowed stopifnot() and assert_that() usages", {
-  expect_lint("stopifnot(x)", NULL, conjunct_test_linter())
-  expect_lint("assert_that(x, y, z)", NULL, conjunct_test_linter())
+  linter <- conjunct_test_linter()
+
+  expect_lint("stopifnot(x)", NULL, linter)
+  expect_lint("assert_that(x, y, z)", NULL, linter)
 
   # more complicated expression
-  expect_lint("stopifnot(x || (y && z))", NULL, conjunct_test_linter())
+  expect_lint("stopifnot(x || (y && z))", NULL, linter)
   # the same by operator precedence, though not obvious a priori
-  expect_lint("stopifnot(x || y && z)", NULL, conjunct_test_linter())
-  expect_lint("assertthat::assert_that(x && y || z)", NULL, conjunct_test_linter())
+  expect_lint("stopifnot(x || y && z)", NULL, linter)
+  expect_lint("assertthat::assert_that(x && y || z)", NULL, linter)
 })
 
 test_that("conjunct_test_linter blocks simple disallowed usages of stopifnot() and assert_that()", {
-  expect_lint(
-    "stopifnot(x && y)",
-    rex::rex("Instead of stopifnot(A && B), write multiple conditions"),
-    conjunct_test_linter()
-  )
+  linter <- conjunct_test_linter()
+  lint_msg <- function(fun) rex::rex("Instead of ", fun, "(A && B), write multiple conditions")
 
-  expect_lint(
-    "stopifnot(x && y && z)",
-    rex::rex("Instead of stopifnot(A && B), write multiple conditions"),
-    conjunct_test_linter()
-  )
+  expect_lint("stopifnot(x && y)", lint_msg("stopifnot"), linter)
+  expect_lint("stopifnot(x && y && z)", lint_msg("stopifnot"), linter)
 
   # assert_that() versions
-  expect_lint(
-    "assert_that(x && y)",
-    rex::rex("Instead of assert_that(A && B), write multiple conditions"),
-    conjunct_test_linter()
-  )
-
-  expect_lint(
-    "assertthat::assert_that(x && y && z)",
-    rex::rex("Instead of assert_that(A && B), write multiple conditions"),
-    conjunct_test_linter()
-  )
+  expect_lint("assert_that(x && y)", lint_msg("assert_that"), linter)
+  expect_lint("assertthat::assert_that(x && y && z)", lint_msg("assert_that"), linter)
 })
 
 test_that("conjunct_test_linter's allow_named_stopifnot argument works", {
@@ -132,11 +105,19 @@ test_that("conjunct_test_linter blocks simple disallowed usages", {
 })
 
 test_that("conjunct_test_linter respects its allow_filter argument", {
-  linter <- conjunct_test_linter(allow_filter = TRUE)
+  linter_always <- conjunct_test_linter(allow_filter = "always")
+  linter_dplyr <- conjunct_test_linter(allow_filter = "not_dplyr")
+  lint_msg <- rex::rex("Use dplyr::filter(DF, A, B) instead of dplyr::filter(DF, A & B)")
 
-  expect_lint("dplyr::filter(DF, A & B)", NULL, linter)
-  expect_lint("dplyr::filter(DF, A & B & C)", NULL, linter)
-  expect_lint("DF %>% dplyr::filter(A & B)", NULL, linter)
+  expect_lint("dplyr::filter(DF, A & B)", NULL, linter_always)
+  expect_lint("dplyr::filter(DF, A & B & C)", NULL, linter_always)
+  expect_lint("DF %>% dplyr::filter(A & B)", NULL, linter_always)
+  expect_lint("dplyr::filter(DF, A & B)", lint_msg, linter_dplyr)
+  expect_lint("dplyr::filter(DF, A & B & C)", lint_msg, linter_dplyr)
+  expect_lint("DF %>% dplyr::filter(A & B)", lint_msg, linter_dplyr)
+  expect_lint("filter(DF, A & B)", NULL, linter_dplyr)
+  expect_lint("filter(DF, A & B & C)", NULL, linter_dplyr)
+  expect_lint("DF %>% filter(A & B)", NULL, linter_dplyr)
 })
 
 test_that("filter() is assumed to be dplyr::filter() by default, unless o/w specified", {