Formatting changes to follow tidyverse style guide (#1539)

* Formatting changes to follow tidyverse style guide

* Address review comments

* Update get_source_expressions.R

R/backport_linter.R

@@ -40,8 +40,10 @@ backport_linter <- function(r_version = getRversion(), except = character()) {
     # which(arr.ind) returns things in the same order as which()
     needs_backport_version_idx <- ((which(needs_backport) - 1L) %% length(backport_blacklist)) + 1L
     lint_message <- sprintf(
-      paste("%s (R %s) is not available for dependency R >= %s.",
-            "Use the `except` argument of `backport_linter()` to configure available backports."),
+      paste(
+        "%s (R %s) is not available for dependency R >= %s.",
+        "Use the `except` argument of `backport_linter()` to configure available backports."
+      ),
       all_names[bad_idx],
       names(backport_blacklist)[needs_backport_version_idx],
       r_version

R/cache.R

@@ -159,7 +159,6 @@ digest_content <- function(linters, obj) {
 }
 
 find_new_line <- function(line_number, line, lines) {
-
   if (lines[line_number] %==% line) {
     return(line_number)
   }

R/comment_linters.R

@@ -1,6 +1,6 @@
 ops <- list(
   "+",
-  #"-",
+  # "-",
   "=",
   "==",
   "!=",
@@ -21,7 +21,8 @@ ops <- list(
   "||",
   "&",
   "&&",
-  rex("%", except_any_of("%"), "%"))
+  rex("%", except_any_of("%"), "%")
+)
 
 #' Commented code linter
 #'

R/declared_functions.R

@@ -4,15 +4,16 @@ declared_s3_generics <- function(x) {
     "/exprlist/expr",
 
     # Assigns to a symbol
-      "[./LEFT_ASSIGN|EQ_ASSIGN]",
-      "[./expr[FUNCTION]]",
-      "[./expr/SYMBOL]",
+    "[./LEFT_ASSIGN|EQ_ASSIGN]",
+    "[./expr[FUNCTION]]",
+    "[./expr/SYMBOL]",
 
     # Is a S3 Generic (contains call to UseMethod)
-      "[.//SYMBOL_FUNCTION_CALL[text()='UseMethod']]",
+    "[.//SYMBOL_FUNCTION_CALL[text()='UseMethod']]",
 
     # Retrieve assigned name of the function
-    "/expr/SYMBOL/text()")
+    "/expr/SYMBOL/text()"
+  )
 
   as.character(xml2::xml_find_all(x, xpath))
 }

R/duplicate_argument_linter.R

@@ -15,7 +15,6 @@ duplicate_argument_linter <- function(except = character()) {
   xpath_arg_name <- "./EQ_SUB/preceding-sibling::*[1]"
 
   Linter(function(source_expression) {
-
     if (!is_lint_level(source_expression, "file")) {
       return(list())
     }

R/equals_na_linter.R

@@ -14,7 +14,6 @@ equals_na_linter <- function() {
   xpath <- sprintf(xpath_fmt, na_table, comparator_table)
 
   Linter(function(source_expression) {
-
     if (!is_lint_level(source_expression, "expression")) {
       return(list())
     }

R/exclude.R

@@ -225,7 +225,6 @@ normalize_exclusions <- function(x, normalize_path = TRUE,
   x <- as.list(x)
   unnamed <- !nzchar(names2(x))
   if (any(unnamed)) {
-
     # must be character vectors of length 1
     bad <- vapply(
       seq_along(x),
@@ -236,10 +235,12 @@ normalize_exclusions <- function(x, normalize_path = TRUE,
     )
 
     if (any(bad)) {
-      stop("Full file exclusions must be character vectors of length 1. items: ",
-           toString(which(bad)),
-           " are not!",
-           call. = FALSE)
+      stop(
+        "Full file exclusions must be character vectors of length 1. items: ",
+        toString(which(bad)),
+        " are not!",
+        call. = FALSE
+      )
     }
     # Normalize unnamed entries to list(<filename> = list(Inf), ...)
     names(x)[unnamed] <- x[unnamed]
@@ -249,16 +250,17 @@ normalize_exclusions <- function(x, normalize_path = TRUE,
   full_line_exclusions <- !vapply(x, is.list, logical(1L))
 
   if (any(full_line_exclusions)) {
-
     # must be integer or numeric vectors
     are_numeric <- vapply(x, is.numeric, logical(1L))
     bad <- full_line_exclusions & !are_numeric
 
     if (any(bad)) {
-      stop("Full line exclusions must be numeric or integer vectors. items: ",
-           toString(which(bad)),
-           " are not!",
-           call. = FALSE)
+      stop(
+        "Full line exclusions must be numeric or integer vectors. items: ",
+        toString(which(bad)),
+        " are not!",
+        call. = FALSE
+      )
     }
 
     # Normalize list(<filename> = c(<lines>)) to
@@ -301,7 +303,7 @@ normalize_exclusions <- function(x, normalize_path = TRUE,
     rel_path <- !is_absolute_path(paths)
     paths[rel_path] <- file.path(root, paths[rel_path])
     names(x) <- paths
-    x <- x[file.exists(paths)]       # remove exclusions for non-existing files
+    x <- x[file.exists(paths)] # remove exclusions for non-existing files
     names(x) <- normalizePath(names(x)) # get full path for remaining files
   }
 

R/expect_lint.R

@@ -26,13 +26,13 @@
 #'
 #' # one expected lint
 #' expect_lint("a\n", "superfluous", trailing_blank_lines_linter)
-#' expect_lint("a\n", list(message="superfluous", line_number=2), trailing_blank_lines_linter)
+#' expect_lint("a\n", list(message = "superfluous", line_number = 2), trailing_blank_lines_linter)
 #'
 #' # several expected lints
 #' expect_lint("a\n\n", list("superfluous", "superfluous"), trailing_blank_lines_linter)
 #' expect_lint(
 #'   "a\n\n",
-#'   list(list(message="superfluous", line_number=2), list(message="superfluous", line_number=3)),
+#'   list(list(message = "superfluous", line_number = 2), list(message = "superfluous", line_number = 3)),
 #'   trailing_blank_lines_linter()
 #' )
 #' @export
@@ -57,7 +57,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") {
   n_lints <- length(lints)
   lint_str <- if (n_lints) paste0(c("", lints), collapse = "\n") else ""
 
-  wrong_number_fmt  <- "got %d lints instead of %d%s"
+  wrong_number_fmt <- "got %d lints instead of %d%s"
   if (is.null(checks)) {
     msg <- sprintf(wrong_number_fmt, n_lints, length(checks), lint_str)
     return(testthat::expect(n_lints %==% 0L, msg))
@@ -77,37 +77,42 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") {
     itr <- 0L
     # keep 'linter' as a field even if we remove the deprecated argument from Lint() in the future
     lint_fields <- unique(c(names(formals(Lint)), "linter"))
-    Map(function(lint, check) {
-      itr <<- itr + 1L
-      lapply(names(check), function(field) {
-        if (!field %in% lint_fields) {
-          stop(sprintf(
-            "check #%d had an invalid field: \"%s\"\nValid fields are: %s\n",
-            itr, field, toString(lint_fields)))
-        }
-        check <- check[[field]]
-        value <- lint[[field]]
-        msg <- sprintf("check #%d: %s %s did not match %s",
-                       itr, field, deparse(value), deparse(check))
-               # deparse ensures that NULL, list(), etc are handled gracefully
-        exp <- if (field == "message") {
-          re_matches(value, check)
-        } else {
-          isTRUE(all.equal(value, check))
-        }
-        if (!is.logical(exp)) {
-          stop(
-            "Invalid regex result, did you mistakenly have a capture group in the regex? ",
-            "Be sure to escape parenthesis with `[]`",
-            call. = FALSE
+    Map(
+      function(lint, check) {
+        itr <<- itr + 1L
+        lapply(names(check), function(field) {
+          if (!field %in% lint_fields) {
+            stop(sprintf(
+              "check #%d had an invalid field: \"%s\"\nValid fields are: %s\n",
+              itr, field, toString(lint_fields)
+            ))
+          }
+          check <- check[[field]]
+          value <- lint[[field]]
+          msg <- sprintf(
+            "check #%d: %s %s did not match %s",
+            itr, field, deparse(value), deparse(check)
           )
-        }
-        testthat::expect(exp, msg)
+          # deparse ensures that NULL, list(), etc are handled gracefully
+          exp <- if (field == "message") {
+            re_matches(value, check)
+          } else {
+            isTRUE(all.equal(value, check))
+          }
+          if (!is.logical(exp)) {
+            stop(
+              "Invalid regex result, did you mistakenly have a capture group in the regex? ",
+              "Be sure to escape parenthesis with `[]`",
+              call. = FALSE
+            )
+          }
+          testthat::expect(exp, msg)
         })
       },
       lints,
-      checks)
-    })
+      checks
+    )
+  })
 
   invisible(NULL)
 }

R/expect_named_linter.R

@@ -8,7 +8,7 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 expect_named_linter <- function() {
-   xpath <- "//expr[
+  xpath <- "//expr[
     SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical']
     and following-sibling::expr[
       expr[1][SYMBOL_FUNCTION_CALL[text() = 'names']]

R/extract.R

@@ -10,7 +10,7 @@ extract_r_source <- function(filename, lines, error = identity) {
 
   chunks <- tryCatch(get_chunk_positions(pattern = pattern, lines = lines), error = error)
   if (inherits(chunks, "error") || inherits(chunks, "lint")) {
-    assign("e", chunks,  envir = parent.frame())
+    assign("e", chunks, envir = parent.frame())
     # error, so return empty code
     return(output)
   }
@@ -34,7 +34,9 @@ get_knitr_pattern <- function(filename, lines) {
   # Early return if the source code is parseable as plain R code.
   # Otherwise, R code containing a line which matches any knitr pattern will be treated as a knitr file.
   # See #1406 for details.
-  if (parsable(lines)) return(NULL)
+  if (parsable(lines)) {
+    return(NULL)
+  }
   pattern <- ("knitr" %:::% "detect_pattern")(lines, tolower(("knitr" %:::% "file_ext")(filename)))
   if (!is.null(pattern)) {
     knitr::all_patterns[[pattern]]

R/get_source_expressions.R

@@ -265,10 +265,11 @@ lint_parse_error_nonstandard <- function(e, source_expression) {
   } else if (grepl("repeated formal argument", e$message, fixed = TRUE)) {
     matches <- re_matches(
       e$message,
-      rex("repeated formal argument '",
-          capture(name = "symbol", anything),
-          "' on line ",
-          capture(name = "line", digits)
+      rex(
+        "repeated formal argument '",
+        capture(name = "symbol", anything),
+        "' on line ",
+        capture(name = "line", digits)
       )
     )
     sym <- matches$symbol
@@ -336,10 +337,14 @@ lint_parse_error_nonstandard <- function(e, source_expression) {
     )
   }
 
-  message_info <- re_matches(e$message,
-                             rex(single_quotes, capture(name = "name", anything), single_quotes,
-                                 anything,
-                                 double_quotes, capture(name = "starting", anything), double_quotes))
+  message_info <- re_matches(
+    e$message,
+    rex(
+      single_quotes, capture(name = "name", anything), single_quotes,
+      anything,
+      double_quotes, capture(name = "starting", anything), double_quotes
+    )
+  )
 
   loc <- re_matches(source_expression$content, rex(message_info$starting), locations = TRUE)
   line_location <- loc[!is.na(loc$start) & !is.na(loc$end), ]
@@ -348,11 +353,13 @@ lint_parse_error_nonstandard <- function(e, source_expression) {
     if (grepl("attempt to use zero-length variable name", e$message, fixed = TRUE)) {
       # empty symbol: ``, ``(), ''(), ""(), fun(''=42), fun(""=42), fun(a=1,""=42)
       loc <- re_matches(source_expression$content,
-                        rex("``" %or%
-                              list(or("''", '""'), any_spaces, "(") %or%
-                              list(or("(", ","), any_spaces, or("''", '""'), any_spaces, "=")),
-                        options = "multi-line",
-                        locations = TRUE)
+        rex(
+          "``" %or%
+          list(or("''", '""'), any_spaces, "(") %or%
+          list(or("(", ","), any_spaces, or("''", '""'), any_spaces, "=")),
+        options = "multi-line",
+        locations = TRUE
+      )
       loc <- loc[!is.na(loc$start) & !is.na(loc$end), ]
       if (nrow(loc) > 0L) {
         line_location <- loc[1L, ]
@@ -388,20 +395,20 @@ lint_parse_error_nonstandard <- function(e, source_expression) {
 }
 
 lint_rmd_error <- function(e, source_expression) {
-  message_info <- re_matches(e$message,
-    rex(except_some_of(":"),
+  message_info <- re_matches(
+    e$message,
+    rex(
+      except_some_of(":"),
       ":",
-      capture(name = "line",
-        digits),
+      capture(name = "line", digits),
       ":",
-      capture(name = "column",
-        digits),
+      capture(name = "column", digits),
       ":",
       space,
-      capture(name = "message",
-        anything),
-      "\n")
+      capture(name = "message", anything),
+      "\n"
     )
+  )
 
   line_number <- as.integer(message_info$line)
   column_number <- as.integer(message_info$column)
@@ -486,7 +493,8 @@ get_source_expression <- function(source_expression, error = identity) {
 
 get_newline_locs <- function(x) {
   newline_search <- re_matches(x, rex("\n"), locations = TRUE, global = TRUE)[[1L]]$start
-  c(0L,
+  c(
+    0L,
     if (!is.na(newline_search[1L])) newline_search,
     nchar(x) + 1L
   )
@@ -575,7 +583,7 @@ tab_offsets <- function(tab_columns) {
   vapply(
     tab_columns - 1L,
     function(tab_idx) {
-      offset <- 7L - (tab_idx + cum_offset) %% 8L  # using a tab width of 8 characters
+      offset <- 7L - (tab_idx + cum_offset) %% 8L # using a tab width of 8 characters
       cum_offset <<- cum_offset + offset
       offset
     },

R/inner_combine_linter.R

@@ -112,6 +112,6 @@ build_arg_condition <- function(calls, arguments) {
   xp_or(
     sprintf("not(expr[1][SYMBOL_FUNCTION_CALL[%s]])", xp_text_in_table(calls)),
     "not(EQ_SUB) and not(following-sibling::expr/EQ_SUB)",
-   xp_and(vapply(arguments, arg_match_condition, character(1L)))
+    xp_and(vapply(arguments, arg_match_condition, character(1L)))
   )
 }

R/line_length_linter.R

@@ -10,7 +10,6 @@
 #' @export
 line_length_linter <- function(length = 80L) {
   Linter(function(source_expression) {
-
     # Only go over complete file
     if (!is_lint_level(source_expression, "file")) {
       return(list())