feat(new linter): added a new linter

DESCRIPTION

@@ -78,6 +78,7 @@ Collate:
     'no_tab_linter.R'
     'object_usage_linter.R'
     'open_curly_linter.R'
+    'paren_body_linter.R'
     'paren_brace_linter.R'
     'path_linters.R'
     'pipe_call_linter.R'

NAMESPACE

@@ -51,6 +51,7 @@ export(object_length_linter)
 export(object_name_linter)
 export(object_usage_linter)
 export(open_curly_linter)
+export(paren_body_linter)
 export(paren_brace_linter)
 export(pipe_call_linter)
 export(pipe_continuation_linter)

NEWS.md

@@ -68,6 +68,8 @@
 * `get_source_expressions()` no longer fails if `getParseData()` returns a truncated (invalid) Unicode character as parsed text (#815, #816, @leogama)
 * lintr now supports non-system character Encodings. Auto-detects the correct encoding from .Rproj or DESCRIPTION 
   files in your project. Override the default in the `encoding` setting of lintr. (#752, #782, @AshesITR)
+* New default linter `paren_body_linter()` checks that there is a space between right parenthesis and a body 
+  expression. (#809, #830, @kpagacz)
 
 # lintr 2.0.1
 

R/paren_body_linter.R

@@ -0,0 +1,36 @@
+#' @describeIn linters check that there is a space between right parenthesis and a body expression.
+#'
+#' @export
+paren_body_linter <- function() {
+  Linter(function(source_file) {
+    if (is.null(source_file$xml_parsed_content)) return(NULL)
+
+    xpath <- paste(
+      "//expr[",
+      "@line1 = preceding-sibling::FUNCTION/@line1",
+      "|",
+      "preceding-sibling::IF/@line1",
+      "|",
+      "preceding-sibling::WHILE/@line1",
+      "|",
+      "preceding-sibling::OP-LAMBDA/@line1",
+      "and",
+      "@col1 = preceding-sibling::OP-RIGHT-PAREN/@col1 + 1",
+      "]",
+      "|",
+      "//expr[",
+      "@line1 = preceding-sibling::forcond/@line1",
+      "and",
+      "@col1 = preceding-sibling::forcond/OP-RIGHT-PAREN/@col1 + 1",
+      "]"
+    )
+    matched_expressions <- xml2::xml_find_all(source_file$xml_parsed_content, xpath)
+
+    lapply(
+      matched_expressions,
+      xml_nodes_to_lint,
+      source_file = source_file,
+      message = "There should be a space between right parenthesis and a body expression."
+    )
+  })
+}

R/zzz.R

@@ -97,6 +97,7 @@ default_linters <- with_defaults(
   object_name_linter(),
   object_usage_linter(),
   open_curly_linter(),
+  paren_body_linter(),
   paren_brace_linter(),
   pipe_continuation_linter(),
   semicolon_terminator_linter(),

README.md

@@ -60,6 +60,7 @@ If you need a bit automatic help for re-styling your code, have a look at [the `
   [base::eval()](https://rdrr.io/r/base/eval.html) on the code, so do not use with untrusted code.
 * `open_curly_linter`: check that opening curly braces are never on their own
   line and are always followed by a newline.
+* `paren_body_linter`: check that there is a space between right parenthesis and a body expression.
 * `paren_brace_linter`: check that there is a space between right parenthesis and an opening curly brace.
 * `pipe_call_linter`: force explicit calls in magrittr pipes.
 * `pipe_continuation_linter`: Check that each step in a pipeline is on a new

tests/testthat/test-paren_body_linter.R

@@ -0,0 +1,52 @@
+testthat::test_that("paren_body_linter returns correct lints", {
+  linter <- paren_body_linter()
+  msg <- "There should be a space between right parenthesis and a body expression."
+
+  # No space after the closing parenthesis prompts a lint
+  expect_lint("function()test", msg, linter)
+  expect_lint("print('hello')\nx <- function(x)NULL\nprint('hello')", msg, linter)
+  expect_lint("if (TRUE)test", msg, linter)
+  expect_lint("while (TRUE)test", msg, linter)
+  expect_lint("for (i in seq_along(1))test", msg, linter)
+
+  # A space after the closing parenthesis does not prompt a lint
+  expect_lint("function() test", NULL, linter)
+
+  # Symbols after the closing parenthesis of a function call do not prompt a lint
+  expect_lint("head(mtcars)$cyl", NULL, linter)
+
+  # paren_body_linter returns the correct line number
+  expect_lint(
+    "print('hello')\nx <- function(x)NULL\nprint('hello')",
+    list(line_number = 2L),
+    linter
+  )
+
+  expect_lint(
+    "function()test",
+    list(
+      line_number = 1L,
+      column_number = 11L,
+      type = "style",
+      line = c("1" = "function()test"),
+      ranges = list(c(11L, 14L))
+    ),
+    linter
+  )
+
+  # paren_body_linter does not lint when the function body is defined on a new line
+  expect_lint("function()\n  test", NULL, linter)
+
+  # paren_body_linter does not lint comments
+  expect_lint("#function()test", NULL, linter)
+
+  # multiple lints on the same line
+  expect_lint("function()if(TRUE)while(TRUE)test", list(msg, msg, msg), linter)
+
+  # No space after the closing parenthesis of an anonymous function prompts a lint
+  testthat::skip_if(
+    getRversion() < "4.1",
+    message = "Not run on R version < 4.1.0"
+  )
+  expect_lint("\\()test", msg, linter)
+})