Enhance and fix indentation_linter (#1758)

* fix #1751

* fix #1754

* omit \cr

* more tests

* fix cyclocomp

* remove unnecessary Rd comment

* remove stray nolint end

* increase coverage, more tightly define always-hanging style

* line_length

Co-authored-by: Michael Chirico <chiricom@google.com>

R/indentation_linter.R

@@ -8,6 +8,8 @@
 #'   line and a hanging indent if not.
 #'   Note that function multi-line function calls without arguments on their first line will always be expected to have
 #'   block-indented arguments.
+#'   If `hanging_indent_style` is `"tidy"`, multi-line function definitions are expected to be double-indented if the
+#'   first line of the function definition contains no arguments and the closing parenthesis is not on its own line.
 #'
 #'   ```r
 #'   # complies to any style
@@ -34,6 +36,13 @@
 #'   # complies to "never"
 #'   map(x, f,
 #'     additional_arg = 42)
+#'
+#'   # complies to "tidy"
+#'   function(
+#'       a,
+#'       b) {
+#'     # body
+#'   }
 #'   ```
 #'
 #' @examples
@@ -82,8 +91,10 @@
 #' )
 #'
 #' @evalRd rd_tags("indentation_linter")
-#' @seealso [linters] for a complete list of linters available in lintr. \cr
-#' <https://style.tidyverse.org/syntax.html#indenting>
+#' @seealso
+#' - [linters] for a complete list of linters available in lintr.
+#' - <https://style.tidyverse.org/syntax.html#indenting>
+#' - <https://style.tidyverse.org/functions.html#long-lines-1>
 #'
 #' @export
 indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "always", "never")) {
@@ -98,18 +109,14 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
   hanging_indent_style <- match.arg(hanging_indent_style)
 
   if (hanging_indent_style == "tidy") {
-    xp_is_not_hanging <- paste(
-      c(
-        glue::glue(
-          "self::{paren_tokens_left}/following-sibling::{paren_tokens_right}[@line1 > preceding-sibling::*[1]/@line2]"
-        ),
-        glue::glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))} and {xp_last_on_line}]")
-      ),
-      collapse = " | "
-    )
+    find_indent_type <- build_indentation_style_tidy()
   } else if (hanging_indent_style == "always") {
-    xp_is_not_hanging <- glue::glue("self::*[{xp_last_on_line}]")
-  } # "never" makes no use of xp_is_not_hanging, so no definition is necessary
+    find_indent_type <- build_indentation_style_always()
+  } else { # "never"
+    find_indent_type <- function(change) {
+      "block"
+    }
+  }
 
   xp_block_ends <- paste0(
     "number(",
@@ -121,7 +128,7 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
         glue::glue("self::*[
                       {xp_and(paste0('not(self::', paren_tokens_left, ')'))} and
                       not(following-sibling::SYMBOL_FUNCTION_CALL)
-                    ]/following-sibling::*[1]/@line2")
+                    ]/following-sibling::*[not(self::COMMENT)][1]/@line2")
       ),
       collapse = " | "
     ),
@@ -174,20 +181,20 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
 
     indent_changes <- xml2::xml_find_all(xml, xp_indent_changes)
     for (change in indent_changes) {
-      if (hanging_indent_style != "never") {
-        change_starts_hanging <- length(xml2::xml_find_first(change, xp_is_not_hanging)) == 0L
-      } else {
-        change_starts_hanging <- FALSE
-      }
+      change_type <- find_indent_type(change)
       change_begin <- as.integer(xml2::xml_attr(change, "line1")) + 1L
       change_end <- xml2::xml_find_num(change, xp_block_ends)
       if (change_begin <= change_end) {
         to_indent <- seq(from = change_begin, to = change_end)
-        if (change_starts_hanging) {
+        if (change_type == "hanging") {
           expected_indent_levels[to_indent] <- as.integer(xml2::xml_attr(change, "col2"))
           is_hanging[to_indent] <- TRUE
-        } else {
-          expected_indent_levels[to_indent] <- expected_indent_levels[to_indent] + indent
+        } 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
         }
       }
@@ -241,3 +248,75 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
     }
   })
 }
+
+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")
+  xp_last_on_line <- "@line1 != following-sibling::*[not(self::COMMENT)][1]/@line1"
+
+  # double indent is tidyverse style for function definitions
+  # triggered only if the closing parenthesis of the function definition is not on its own line and the opening
+  # parenthesis has no arguments behind it.
+  # this allows both of these styles:
+  #
+  #> function(
+  #>     a,
+  #>     b) {
+  #>   body
+  #> }
+  #
+  #> function(
+  #>   a,
+  #>   b
+  #> ) {
+  #>   body
+  #> }
+  xp_is_double_indent <- "
+    parent::expr[FUNCTION and not(@line1 = SYMBOL_FORMALS/@line1)]
+      /OP-RIGHT-PAREN[@line1 = preceding-sibling::*[not(self::COMMENT)][1]/@line2]
+  "
+  xp_is_not_hanging <- paste(
+    c(
+      glue::glue(
+        "self::{paren_tokens_left}/following-sibling::{paren_tokens_right}[@line1 > preceding-sibling::*[1]/@line2]"
+      ),
+      glue::glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))} and {xp_last_on_line}]")
+    ),
+    collapse = " | "
+  )
+
+  function(change) {
+    if (length(xml2::xml_find_first(change, xp_is_double_indent)) > 0L) {
+      "double"
+    } else if (length(xml2::xml_find_first(change, xp_is_not_hanging)) == 0L) {
+      "hanging"
+    } else {
+      "block"
+    }
+  }
+}
+
+build_indentation_style_always <- 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")
+  xp_last_on_line <- "@line1 != following-sibling::*[not(self::COMMENT)][1]/@line1"
+
+  xp_is_not_hanging <- paste(
+    c(
+      glue::glue("
+        self::{paren_tokens_left}[{xp_last_on_line}]/
+          following-sibling::{paren_tokens_right}[@line1 > preceding-sibling::*[1]/@line2]
+      "),
+      glue::glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))} and {xp_last_on_line}]")
+    ),
+    collapse = " | "
+  )
+
+  function(change) {
+    if (length(xml2::xml_find_first(change, xp_is_not_hanging)) == 0L) {
+      "hanging"
+    } else {
+      "block"
+    }
+  }
+}