lint %<>% in assignment_linter

NEWS.md

@@ -4,6 +4,10 @@
 
 * `inner_combine_linter()` no longer throws on length-1 calls to `c()` like `c(exp(2))` or `c(log(3))` (#2017, @MichaelChirico). Such usage is discouraged by `unnecessary_concatenation_linter()`, but `inner_combine_linter()` _per se_ does not apply.
 
+## Changes to defaults
+
+* `assignment_linter()` lints the {magrittr} assignment pipe `%<>%` (#2008, @MichaelChirico). This can be deactivated by setting the new argument `allow_pipe_assign` to `TRUE`.
+
 # lintr 3.1.0
 
 ## Deprecations & Breaking Changes

R/assignment_linter.R

@@ -6,6 +6,7 @@
 #'   If `FALSE`, [`<<-`][base::assignOps] and `->>` are not allowed.
 #' @param allow_right_assign Logical, default `FALSE`. If `TRUE`, `->` and `->>` are allowed.
 #' @param allow_trailing Logical, default `TRUE`. If `FALSE` then assignments aren't allowed at end of lines.
+#' @param allow_pipe_assign Logical, default `FALSE`. If `TRUE`, magrittr's `%<>%` assignment is allowed.
 #'
 #' @examples
 #' # will produce lints
@@ -21,6 +22,11 @@
 #'   linters = assignment_linter()
 #' )
 #'
+#' lint(
+#'   text = "x %<>% as.character()",
+#'   linters = assignment_linter()
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = "x <- mean(x)",
@@ -53,19 +59,29 @@
 #'   linters = assignment_linter(allow_trailing = FALSE)
 #' )
 #'
+#' lint(
+#'   text = "x %<>% as.character()",
+#'   linters = assignment_linter(allow_pipe_assign = TRUE)
+#' )
+#'
 #' @evalRd rd_tags("assignment_linter")
 #' @seealso
 #' - [linters] for a complete list of linters available in lintr.
 #' - <https://style.tidyverse.org/syntax.html#assignment-1>
+#' - <https://style.tidyverse.org/pipes.html#assignment-2>
 #' @export
-assignment_linter <- function(allow_cascading_assign = TRUE, allow_right_assign = FALSE, allow_trailing = TRUE) {
+assignment_linter <- function(allow_cascading_assign = TRUE,
+                              allow_right_assign = FALSE,
+                              allow_trailing = TRUE,
+                              allow_pipe_assign = FALSE) {
   trailing_assign_xpath <- paste(
     collapse = " | ",
     c(
       paste0("//LEFT_ASSIGN", if (allow_cascading_assign) "" else "[text() = '<-']"),
       if (allow_right_assign) paste0("//RIGHT_ASSIGN", if (allow_cascading_assign) "" else "[text() = '->']"),
       "//EQ_SUB",
-      "//EQ_FORMALS"
+      "//EQ_FORMALS",
+      if (!allow_pipe_assign) "//SPECIAL[text() = '%<>%']"
     ),
     "[@line1 < following-sibling::expr[1]/@line1]"
   )
@@ -79,7 +95,8 @@ assignment_linter <- function(allow_cascading_assign = TRUE, allow_right_assign
     # NB: := is not linted because of (1) its common usage in rlang/data.table and
     #   (2) it's extremely uncommon as a normal assignment operator
     if (!allow_cascading_assign) "//LEFT_ASSIGN[text() = '<<-']",
-    if (!allow_trailing) trailing_assign_xpath
+    if (!allow_trailing) trailing_assign_xpath,
+    if (!allow_pipe_assign) "//SPECIAL[text() = '%<>%']"
   ))
 
   Linter(function(source_expression) {
@@ -95,16 +112,16 @@ assignment_linter <- function(allow_cascading_assign = TRUE, allow_right_assign
     }
 
     operator <- xml2::xml_text(bad_expr)
-    lint_message_fmt <- ifelse(
-      operator %in% c("<<-", "->>"),
-      "%s can have hard-to-predict behavior; prefer assigning to a specific environment instead (with assign() or <-).",
-      "Use <-, not %s, for assignment."
-    )
+    lint_message_fmt <- rep("Use <-, not %s, for assignment.", length(operator))
+    lint_message_fmt[operator %in% c("<<-", "->>")] <-
+      "%s can have hard-to-predict behavior; prefer assigning to a specific environment instead (with assign() or <-)."
+    lint_message_fmt[operator == "%<>%"] <-
+      "Avoid the assignment pipe %s; prefer using <- and %%>%% separately."
 
     if (!allow_trailing) {
       bad_trailing_expr <- xml2::xml_find_all(xml, trailing_assign_xpath)
       trailing_assignments <- xml2::xml_attrs(bad_expr) %in% xml2::xml_attrs(bad_trailing_expr)
-      lint_message_fmt[trailing_assignments] <- "Assignment %s should not be trailing at end of line"
+      lint_message_fmt[trailing_assignments] <- "Assignment %s should not be trailing at the end of a line."
     }
 
     lint_message <- sprintf(lint_message_fmt, operator)

tests/testthat/test-assignment_linter.R

@@ -55,7 +55,7 @@ test_that("arguments handle trailing assignment operators correctly", {
 
   expect_lint(
     "foo(bar =\n1)",
-    rex::rex("= should not be trailing"),
+    rex::rex("= should not be trailing at the end of a line."),
     assignment_linter(allow_trailing = FALSE)
   )
 
@@ -163,3 +163,24 @@ test_that("allow_trailing interacts correctly with comments in braced expression
     linter
   )
 })
+
+test_that("%<>% throws a lint", {
+  expect_lint("x %<>% sum()", "Avoid the assignment pipe %<>%", assignment_linter())
+  expect_lint("x %<>% sum()", NULL, assignment_linter(allow_pipe_assign = TRUE))
+
+  # interaction with allow_trailing
+  expect_lint("x %<>%\n  sum()", "Assignment %<>% should not be trailing", assignment_linter(allow_trailing = FALSE))
+})
+
+test_that("multiple lints throw correct messages", {
+  expect_lint(
+    "{ x <<- 1; y ->> 2; z -> 3; x %<>% as.character() }",
+    list(
+      list(message = "<<- can have hard-to-predict behavior"),
+      list(message = "->> can have hard-to-predict behavior"),
+      list(message = "Use <-, not ->"),
+      list(message = "Avoid the assignment pipe %<>%")
+    ),
+    assignment_linter(allow_cascading_assign = FALSE)
+  )
+})