add assignment_as_infix = TRUE to indentation_linter()

R/indentation_linter.R

@@ -44,6 +44,27 @@
 #'     # body
 #'   }
 #'   ```
+#' @param assignment_as_infix Treat `<-` as a regular (i.e. left-associative) infix operator?
+#'   This means, that infix operators on the right hand side of an assignment do not trigger a second level of
+#'   indentation:
+#'   ```r
+#'   # complies to any style
+#'   variable <- a %+%
+#'     b %+%
+#'     c
+#'
+#'   # complies to assignment_as_infix = TRUE
+#'   variable <-
+#'     a %+%
+#'     b %+%
+#'     c
+#'
+#'   # complies to assignment_as_infix = FALSE
+#'   variable <-
+#'     a %+%
+#'       b %+%
+#'       c
+#'   ```
 #'
 #' @examples
 #' # will produce lints
@@ -97,7 +118,8 @@
 #' - <https://style.tidyverse.org/functions.html#long-lines-1>
 #'
 #' @export
-indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "always", "never")) {
+indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "always", "never"),
+                               assignment_as_infix = TRUE) {
   paren_tokens_left <- c("OP-LEFT-BRACE", "OP-LEFT-PAREN", "OP-LEFT-BRACKET", "LBB")
   paren_tokens_right <- c("OP-RIGHT-BRACE", "OP-RIGHT-PAREN", "OP-RIGHT-BRACKET", "OP-RIGHT-BRACKET")
   infix_tokens <- setdiff(infix_metadata$xml_tag, c("OP-LEFT-BRACE", "OP-COMMA", paren_tokens_left))
@@ -118,6 +140,21 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
     }
   }
 
+  if (isTRUE(assignment_as_infix)) {
+    infix_condition <- glue::glue("
+      and not(
+        ancestor::expr[
+          preceding-sibling::LEFT_ASSIGN[{xp_last_on_line}] or expr[SYMBOL_FUNCTION_CALL]
+        ][1][
+          preceding-sibling::LEFT_ASSIGN[{xp_last_on_line}]
+        ]
+      )
+    ")
+    # suppress only infix operators that are not inside of a function call
+  } else {
+    infix_condition <- ""
+  }
+
   xp_block_ends <- paste0(
     "number(",
     paste(
@@ -141,7 +178,7 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
                     @line2 > @line1 and
                     ({xp_or(paste0('descendant::', paren_tokens_left, '[', xp_last_on_line, ']'))})
                   ]/@line1)]"),
-      glue::glue("//{infix_tokens}[{xp_last_on_line}]"),
+      glue::glue("//{infix_tokens}[{xp_last_on_line}{infix_condition}]"),
       glue::glue("//{no_paren_keywords}[{xp_last_on_line}]"),
       glue::glue("//{keyword_tokens}/following-sibling::OP-RIGHT-PAREN[
                     {xp_last_on_line} and
@@ -186,17 +223,13 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
       change_end <- xml2::xml_find_num(change, xp_block_ends)
       if (isTRUE(change_begin <= change_end)) {
         to_indent <- seq(from = change_begin, to = change_end)
-        if (change_type == "hanging") {
-          expected_indent_levels[to_indent] <- as.integer(xml2::xml_attr(change, "col2"))
-          is_hanging[to_indent] <- TRUE
-        } else { # block or double
-          if (change_type == "double") {
-            expected_indent_levels[to_indent] <- expected_indent_levels[to_indent] + 2L * indent
-          } else {
-            expected_indent_levels[to_indent] <- expected_indent_levels[to_indent] + indent
-          }
-          is_hanging[to_indent] <- FALSE
-        }
+        expected_indent_levels[to_indent] <- find_new_indent(
+          expected_indent_levels[to_indent],
+          change_type,
+          indent,
+          as.integer(xml2::xml_attr(change, "col2"))
+        )
+        is_hanging[to_indent] <- change_type == "hanging"
       }
     }
 
@@ -261,6 +294,16 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
   })
 }
 
+find_new_indent <- function(current_indent, change_type, indent, hanging_indent) {
+  if (change_type == "hanging") {
+    hanging_indent
+  } else if (change_type == "double") {
+    current_indent + 2L * indent
+  } else {
+    current_indent + indent
+  }
+}
+
 build_indentation_style_tidy <- function() {
   paren_tokens_left <- c("OP-LEFT-BRACE", "OP-LEFT-PAREN", "OP-LEFT-BRACKET", "LBB")
   paren_tokens_right <- c("OP-RIGHT-BRACE", "OP-RIGHT-PAREN", "OP-RIGHT-BRACKET", "OP-RIGHT-BRACKET")

tests/testthat/test-indentation_linter.R

@@ -634,6 +634,49 @@ test_that("hanging_indent_stlye works", {
   expect_lint(code_hanging_same_line, "Indent", non_hanging_linter)
 })
 
+test_that("assignment_as_infix works", {
+  code_infix <- trim_some("
+    ok_code <-
+      var1 +
+      f(
+        var2 +
+          var3
+      ) +
+      var4
+  ")
+
+  code_infix_2 <- trim_some("
+    lapply(x,
+      function(e) {
+        temp_var <-
+          e +
+          42
+      }
+    )
+  ")
+
+  code_no_infix <- trim_some("
+    ok_code <-
+      var1 +
+        f(
+          var2 +
+            var3
+        ) +
+        var4
+  ")
+
+  tidy_linter <- indentation_linter()
+  no_infix_linter <- indentation_linter(assignment_as_infix = FALSE)
+
+  expect_lint(code_infix, NULL, tidy_linter)
+  expect_lint(code_infix_2, NULL, tidy_linter)
+  expect_lint(code_no_infix, rex::rex("Indentation should be 2 spaces but is 4 spaces."), tidy_linter)
+
+  expect_lint(code_infix, rex::rex("Indentation should be 4 spaces but is 2 spaces."), no_infix_linter)
+  expect_lint(code_infix_2, rex::rex("Indentation should be 8 spaces but is 6 spaces."), no_infix_linter)
+  expect_lint(code_no_infix, NULL, no_infix_linter)
+})
+
 test_that("consecutive same-level lints are suppressed", {
   bad_code <- trim_some("
     ok_code <- 42