Unified brace_linter

DESCRIPTION

@@ -54,6 +54,7 @@ Collate:
     'any_is_na_linter.R'
     'assignment_linter.R'
     'backport_linter.R'
+    'brace_linter.R'
     'cache.R'
     'class_equals_linter.R'
     'closed_curly_linter.R'

NAMESPACE

@@ -19,6 +19,7 @@ export(assignment_linter)
 export(available_linters)
 export(available_tags)
 export(backport_linter)
+export(brace_linter)
 export(checkstyle_output)
 export(class_equals_linter)
 export(clear_cache)

NEWS.md

@@ -9,6 +9,8 @@
 * Consistent access to linters through a function call, even for linters without parameters (#245, @fangly, @AshesITR, and @MichaelChirico)
 * Removed deprecated functions `absolute_paths_linter`, `camel_case_linter`, `multiple_dots_linter`, `snake_case_linter`, and `trailing_semicolons_linter`. They have been marked as deprecated since v1.0.1, which was released in 2017.
 * Rename `semicolon_terminator_linter` to `semicolon_linter` for better consistency. `semicolon_terminator_linter` survives but is marked for deprecation. The new linter also has a new signature, taking arguments `allow_compound` and `allow_trailing` to replace the old single argument `semicolon=`, again for signature consistency with other linters.
+* Combined several curly brace related linters into a new `brace_linter`:
+  + `closed_curly_linter()`, also allowing `}]` in addition to `})` and `},` as exceptions.
 * The `...` arguments for `lint()`, `lint_dir()`, and `lint_package()` have promoted to an earlier position to better match the [Tidyverse design principal](https://design.tidyverse.org/args-data-details.html) of data->descriptor->details. This change enables passing objects to `...` without needing to specify non-required arguments, e.g. `lint_dir("/path/to/dir", linter())` now works without the need to specify `relative_path`. This affects some code that uses positional arguments. (#935, @michaelchirico)
   + For `lint()`, `...` is now the 3rd argument, where earlier this was `cache=`
   + For `lint_dir()` and `lint_package()`, `...` is now the 2nd argument, where earlier this was `relative_path=`

R/brace_linter.R

@@ -0,0 +1,57 @@
+#' Brace linter
+#'
+#' Perform various style checks related to placement and spacing of curly braces:
+#'
+#'  - Curly braces are on their own line unless they are followed by an `else`.
+#'
+#' @param allow_single_line if `TRUE`, allow an open and closed curly pair on the same line.
+#'
+#' @evalRd rd_tags("brace_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+brace_linter <- function(allow_single_line = FALSE) {
+  Linter(function(source_expression) {
+    if (length(source_expression$xml_parsed_content) == 0L) {
+      return(list())
+    }
+
+    lints <- list()
+
+    xp_cond_closed <- xp_and(c(
+      # matching { is on same line
+      if (isTRUE(allow_single_line)) {
+        "(@line1 != preceding-sibling::OP-LEFT-BRACE/@line1)"
+      },
+      # immediately followed by ",", "]" or ")"
+      "not(
+        @line1 = ancestor::expr/following-sibling::*[1][
+          self::OP-COMMA or self::OP-RIGHT-BRACKET or self::OP-RIGHT-PAREN
+        ]/@line1
+      )",
+      # double curly
+      "not(
+        (@line1 = parent::expr/following-sibling::OP-RIGHT-BRACE/@line1) or
+        (@line1 = preceding-sibling::expr/OP-RIGHT-BRACE/@line1)
+      )"
+    ))
+
+    xp_closed_curly <- glue::glue("//OP-RIGHT-BRACE[
+      { xp_cond_closed } and (
+        (@line1 = preceding-sibling::*[1]/@line2) or
+        (@line1 = parent::expr/following-sibling::*[1][not(self::ELSE)]/@line1)
+      )
+    ]")
+
+    lints <- c(lints, lapply(
+      xml2::xml_find_all(source_expression$xml_parsed_content, xp_closed_curly),
+      xml_nodes_to_lint,
+      source_file = source_expression,
+      lint_message = paste(
+        "Closing curly-braces should always be on their own line,",
+        "unless they are followed by an else."
+      )
+    ))
+
+    lints
+  })
+}

R/closed_curly_linter.R

@@ -9,6 +9,7 @@
 #'   <https://style.tidyverse.org/syntax.html#indenting>
 #' @export
 closed_curly_linter <- function(allow_single_line = FALSE) {
+  lintr_deprecated("closed_curly_linter", new = "brace_linter", version = "2.0.1.9001", type = "Linter")
   Linter(function(source_file) {
     lapply(ids_with_token(source_file, "'}'"),
            function(id) {
@@ -66,7 +67,8 @@ closed_curly_linter <- function(allow_single_line = FALSE) {
               "unless they are followed by an else."
             ),
             line = source_file$lines[as.character(parsed$line1)]
-          )}
+          )
+        }
       }
     )
   })

R/semicolon_linter.R

@@ -54,7 +54,7 @@ semicolon_linter <- function(allow_compound = FALSE, allow_trailing = FALSE) {
 #' }
 #' @export
 semicolon_terminator_linter <- function(semicolon = c("compound", "trailing")) {
-  lintr_deprecated(old = "semicolon_terminator_linter", new = "semicolon_linter", version = "2.0.1.9001")
+  lintr_deprecated(old = "semicolon_terminator_linter", new = "semicolon_linter", version = "2.0.1.9001", type = "Linter")
   semicolon <- match.arg(semicolon, several.ok = TRUE)
   allow_compound <- !"compound" %in% semicolon
   allow_trailing <- !"trailing" %in% semicolon

R/zzz.R

@@ -13,7 +13,7 @@
 default_linters <- with_defaults(
   default = list(),
   assignment_linter(),
-  closed_curly_linter(),
+  brace_linter(),
   commas_linter(),
   commented_code_linter(),
   cyclocomp_linter(),

inst/lintr/linters.csv

@@ -4,8 +4,9 @@ any_duplicated_linter,efficiency best_practices
 any_is_na_linter,efficiency best_practices
 assignment_linter,style consistency default
 backport_linter,robustness configurable package_development
+brace_linter,style readability default configurable
 class_equals_linter,best_practices robustness consistency
-closed_curly_linter,style readability default configurable
+closed_curly_linter,style readability configurable
 commas_linter,style readability default
 commented_code_linter,style readability best_practices default
 condition_message_linter,best_practices consistency

tests/testthat/test-brace_linter.R

@@ -0,0 +1,84 @@
+test_that("brace_linter lints closed braces correctly", {
+  closed_curly_msg <- rex::rex(paste(
+    "Closing curly-braces should always be on their own line,",
+    "unless they are followed by an else."
+  ))
+
+  linter <- brace_linter()
+  expect_lint("blah", NULL, linter)
+  expect_lint("a <- function() {\n}", NULL, linter)
+
+  expect_lint("a <- function() { 1 }", closed_curly_msg, linter)
+  # allowed by allow_single_line
+  expect_lint("a <- function() { 1 }", NULL, brace_linter(allow_single_line = TRUE))
+
+  expect_lint(
+    trim_some("
+      a <- if(1) {
+        1} else {
+        2
+      }
+    "),
+    closed_curly_msg,
+    linter
+  )
+  expect_lint(
+    trim_some("
+      a <- if(1) {
+        1
+      } else {
+        2}
+    "),
+    closed_curly_msg,
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      a <- if(1) {
+        1} else {
+        2}
+    "),
+    list(
+      closed_curly_msg,
+      closed_curly_msg
+    ),
+    linter
+  )
+
+  # }) is allowed
+  expect_lint("eval(bquote({...}))", NULL, linter)
+  # }] is too
+  expect_lint("df[, {...}]", NULL, linter)
+
+  # }, is allowed
+  expect_lint(
+    trim_some("
+      fun({
+        statements
+      }, param)"),
+    NULL,
+    linter
+  )
+  expect_lint(
+    trim_some("
+      fun(function(a) {
+        statements
+      }, param)"),
+    NULL,
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      out <- lapply(stuff, function(i) {
+        do_something(i)
+      }) %>% unlist
+    "),
+    NULL,
+    linter
+  )
+
+  # }} is allowed
+  expect_lint("{{ x }}", NULL, linter)
+})

tests/testthat/test-closed_curly_linter.R

@@ -5,52 +5,58 @@ test_that("returns the correct linting", {
       "unless they are followed by an else."
     ))
 
+  expect_warning(
+    linter <- closed_curly_linter(),
+    "Linter closed_curly_linter was deprecated",
+    fixed = TRUE
+  )
+
   expect_lint("blah",
-    NULL,
-    closed_curly_linter())
+              NULL,
+              linter)
 
   expect_lint("a <- function() {\n}",
-    NULL,
-    closed_curly_linter())
+              NULL,
+              linter)
 
   expect_lint("a <- function() { 1 }",
-    closed_curly_message_regex,
-    closed_curly_linter())
+              closed_curly_message_regex,
+              linter)
 
   expect_lint("a <- function() { 1 }",
-    closed_curly_message_regex,
-    closed_curly_linter())
+              closed_curly_message_regex,
+              linter)
 
   expect_lint("a <- function() { 1 }",
-    NULL,
-    closed_curly_linter(allow_single_line = TRUE))
+              NULL,
+              suppressWarnings(closed_curly_linter(allow_single_line = TRUE)))
 
   expect_lint("a <- if(1) {\n 1} else {\n 2\n}",
-    closed_curly_message_regex,
-    closed_curly_linter())
+              closed_curly_message_regex,
+              linter)
 
   expect_lint("a <- if(1) {\n 1\n} else {\n 2}",
-    closed_curly_message_regex,
-    closed_curly_linter())
+              closed_curly_message_regex,
+              linter)
 
   expect_lint("a <- if(1) {\n 1} else {\n 2}",
-    list(
-      closed_curly_message_regex,
-      closed_curly_message_regex
-    ),
-    closed_curly_linter())
+              list(
+                closed_curly_message_regex,
+                closed_curly_message_regex
+              ),
+              linter)
 
   expect_lint("eval(bquote({...}))",
-    NULL,
-    closed_curly_linter())
+              NULL,
+              linter)
 
   expect_lint("fun({\n  statements\n}, param)",
-    NULL,
-    closed_curly_linter())
+              NULL,
+              linter)
 
   expect_lint("out <- lapply(stuff, function(i) {\n  do_something(i)\n}) %>% unlist",
-    NULL,
-    closed_curly_linter())
+              NULL,
+              linter)
 
-  expect_lint("{{x}}", NULL, closed_curly_linter())
+  expect_lint("{{x}}", NULL, linter)
 })