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,24 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
     }
   }
 
+  if (isTRUE(assignment_as_infix)) {
+    suppressing_tokens <- c("LEFT_ASSIGN", "EQ_ASSIGN", "EQ_SUB", "EQ_FORMALS")
+    xp_suppress <- glue::glue("preceding-sibling::{suppressing_tokens}[{xp_last_on_line}]")
+
+    restoring_tokens <- c("expr[SYMBOL_FUNCTION_CALL]", "OP-LEFT-BRACE")
+    xp_restore <- glue::glue("preceding-sibling::{restoring_tokens}")
+
+    # match the first ancestor expr that is either
+    #  * a suppressing token (<- or =) or
+    #  * a restoring token (braces or a function call)
+    # suppress the indent if the matched ancestor is a suppressing token
+    infix_condition <- glue::glue("
+      and not(ancestor::expr[{xp_or(c(xp_suppress, xp_restore))}][1][{xp_or(xp_suppress)}])
+    ")
+  } else {
+    infix_condition <- ""
+  }
+
   xp_block_ends <- paste0(
     "number(",
     paste(
@@ -141,7 +181,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 +226,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(
+          current_indent = expected_indent_levels[to_indent],
+          change_type = change_type,
+          indent = indent,
+          hanging_indent = as.integer(xml2::xml_attr(change, "col2"))
+        )
+        is_hanging[to_indent] <- change_type == "hanging"
       }
     }
 
@@ -261,6 +297,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,96 @@ test_that("hanging_indent_stlye works", {
   expect_lint(code_hanging_same_line, "Indent", non_hanging_linter)
 })
 
+test_that("assignment_as_infix works", {
+  # test function call restorator and LEFT_ASSIGN suppressor
+  code_infix <- trim_some("
+    ok_code <-
+      var1 +
+      f(
+        var2 +
+          var3
+      ) +
+      var4
+  ")
+
+  # test that innermost ancestor token decides the indentation
+  code_infix_2 <- trim_some("
+    lapply(x,
+      function(e) {
+        temp_var <-
+          e +
+          42
+      }
+    )
+  ")
+
+  # test brace restorator
+  code_infix_3 <- trim_some("
+    ok_code <-
+      if (condition) {
+        a +
+          b
+      } else {
+        c +
+          d
+      } +
+      e
+  ")
+
+  # test EQ_ASSIGN, EQ_SUB and EQ_FORMALS suppressors
+  code_infix_4 <- trim_some("
+    # EQ_ASSIGN
+    ok_code =
+      a +
+      b
+
+    # EQ_SUB
+    f(
+      a =
+        b +
+        c
+    )
+
+    # EQ_FORMALS
+    f <- function(
+      a =
+        b +
+        c
+    ) {
+      NULL
+    }
+  ")
+
+  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_infix_3, NULL, tidy_linter)
+  expect_lint(code_infix_4, 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_infix_3, rex::rex("Indentation should be 4 spaces but is 2 spaces."), no_infix_linter)
+  expect_lint(code_infix_4, list(
+    list(line_number = 4L, rex::rex("Indentation should be 4 spaces but is 2 spaces.")),
+    list(line_number = 10L, rex::rex("Indentation should be 6 spaces but is 4 spaces.")),
+    list(line_number = 17L, rex::rex("Indentation should be 6 spaces but is 4 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