Add linter_level Attribute to Linter()

NEWS.md

@@ -28,6 +28,7 @@
   + to discourage many consecutive calls to `suppressMessages()` or `suppressPackageStartupMessages()` (part of #884, @MichaelChirico).
 * `return_linter()` also has an argument `return_style` (`"implicit"` by default) which checks that all functions confirm to the specified return style of `"implicit"` or `"explicit"` (part of #884, @MichaelChirico, @AshesITR and @MEO265).
 * `unnecessary_lambda_linter` is extended to encourage vectorized comparisons where possible, e.g. `sapply(x, sum) > 0` instead of `sapply(x, function(x) sum(x) > 0)` (part of #884, @MichaelChirico). Toggle this behavior with argument `allow_comparison`.
+* `Linter()` has a new argument `linter_level` (default `NA`). This is used by `lint()` to more efficiently check for expression levels than the idiom `if (!is_lint_level(...)) { return(list()) }` (#2351, @AshesITR).
 
 ### New linters
 

R/T_and_F_symbol_linter.R

@@ -44,12 +44,10 @@ T_and_F_symbol_linter <- function() { # nolint: object_name.
   replacement_map <- c(T = "TRUE", F = "FALSE")
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
-    bad_usage <- xml_find_all(source_expression$xml_parsed_content, usage_xpath)
-    bad_assignment <- xml_find_all(source_expression$xml_parsed_content, assignment_xpath)
+    xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
+    bad_usage <- xml_find_all(xml, usage_xpath)
+    bad_assignment <- xml_find_all(xml, assignment_xpath)
 
     make_lints <- function(expr, fmt) {
       symbol <- xml_text(expr)
@@ -68,5 +66,5 @@ T_and_F_symbol_linter <- function() { # nolint: object_name.
       make_lints(bad_usage, "Use %s instead of the symbol %s."),
       make_lints(bad_assignment, "Don't use %2$s as a variable name, as it can break code relying on %2$s being %1$s.")
     )
-  })
+  }, linter_level = "expression")
 }

R/any_duplicated_linter.R

@@ -86,11 +86,8 @@ any_duplicated_linter <- function() {
   uses_nrow_xpath <- "./parent::expr/expr/expr[1]/SYMBOL_FUNCTION_CALL[text() = 'nrow']"
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
 
     any_duplicated_expr <- xml_find_all(xml, any_duplicated_xpath)
     any_duplicated_lints <- xml_nodes_to_lints(
@@ -114,5 +111,5 @@ any_duplicated_linter <- function() {
     )
 
     c(any_duplicated_lints, length_unique_lints)
-  })
+  }, linter_level = "expression")
 }

R/any_is_na_linter.R

@@ -47,11 +47,8 @@ any_is_na_linter <- function() {
   "
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
 
     bad_expr <- xml_find_all(xml, xpath)
 
@@ -61,5 +58,5 @@ any_is_na_linter <- function() {
       lint_message = "anyNA(x) is better than any(is.na(x)).",
       type = "warning"
     )
-  })
+  }, linter_level = "expression")
 }

R/assignment_linter.R

@@ -100,11 +100,8 @@ assignment_linter <- function(allow_cascading_assign = TRUE,
   ))
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
 
     bad_expr <- xml_find_all(xml, xpath)
     if (length(bad_expr) == 0L) {
@@ -126,5 +123,5 @@ assignment_linter <- function(allow_cascading_assign = TRUE,
 
     lint_message <- sprintf(lint_message_fmt, operator)
     xml_nodes_to_lints(bad_expr, source_expression, lint_message, type = "style")
-  })
+  }, linter_level = "expression")
 }

R/backport_linter.R

@@ -37,7 +37,7 @@ backport_linter <- function(r_version = getRversion(), except = character()) {
   r_version <- normalize_r_version(r_version)
 
   if (all(r_version >= R_system_version(names(backports)))) {
-    return(Linter(function(source_expression) list()))
+    return(Linter(function(source_expression) list(), linter_level = "file"))
   }
 
   backport_blacklist <- backports[r_version < R_system_version(names(backports))]
@@ -46,11 +46,8 @@ backport_linter <- function(r_version = getRversion(), except = character()) {
   names_xpath <- "//SYMBOL | //SYMBOL_FUNCTION_CALL"
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
 
     all_names_nodes <- xml_find_all(xml, names_xpath)
     all_names <- xml_text(all_names_nodes)
@@ -79,7 +76,7 @@ backport_linter <- function(r_version = getRversion(), except = character()) {
       lint_message = lint_message,
       type = "warning"
     )
-  })
+  }, linter_level = "expression")
 }
 
 normalize_r_version <- function(r_version) {

R/boolean_arithmetic_linter.R

@@ -56,11 +56,8 @@ boolean_arithmetic_linter <- function() {
   any_xpath <- paste(length_xpath, "|", sum_xpath)
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
 
     any_expr <- xml_find_all(xml, any_xpath)
 
@@ -74,5 +71,5 @@ boolean_arithmetic_linter <- function() {
       ),
       type = "warning"
     )
-  })
+  }, linter_level = "expression")
 }

R/brace_linter.R

@@ -147,11 +147,8 @@ brace_linter <- function(allow_single_line = FALSE) {
   "
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
     lints <- list()
 
     lints <- c(
@@ -211,5 +208,5 @@ brace_linter <- function(allow_single_line = FALSE) {
     )
 
     lints
-  })
+  }, linter_level = "expression")
 }

R/class_equals_linter.R

@@ -45,11 +45,8 @@ class_equals_linter <- function() {
   "
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
 
     bad_expr <- xml_find_all(xml, xpath)
 
@@ -64,5 +61,5 @@ class_equals_linter <- function() {
       lint_message = lint_message,
       type = "warning"
     )
-  })
+  }, linter_level = "expression")
 }

R/commas_linter.R

@@ -78,10 +78,8 @@ commas_linter <- function(allow_trailing = FALSE) {
   )
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
 
     before_lints <- xml_nodes_to_lints(
       xml_find_all(xml, xpath_before),
@@ -100,5 +98,5 @@ commas_linter <- function(allow_trailing = FALSE) {
     )
 
     c(before_lints, after_lints)
-  })
+  }, linter_level = "expression")
 }

R/comment_linters.R

@@ -76,10 +76,9 @@ commented_code_linter <- function() {
     )
   )
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "file")) {
-      return(list())
-    }
-    all_comment_nodes <- xml_find_all(source_expression$full_xml_parsed_content, "//COMMENT")
+    xml <- source_expression$full_xml_parsed_content
+    if (is.null(xml)) return(list())
+    all_comment_nodes <- xml_find_all(xml, "//COMMENT")
     all_comments <- xml_text(all_comment_nodes)
     code_candidates <- re_matches(all_comments, code_candidate_regex, global = FALSE, locations = TRUE)
     extracted_code <- code_candidates[, "code"]
@@ -106,7 +105,7 @@ commented_code_linter <- function() {
     }
 
     lint_list
-  })
+  }, linter_level = "file")
 }
 
 # is given text parsable

R/comparison_negation_linter.R

@@ -61,11 +61,8 @@ comparison_negation_linter <- function() {
   ")
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
 
     bad_expr <- xml_find_all(xml, xpath)
 
@@ -88,5 +85,5 @@ comparison_negation_linter <- function() {
       lint_message = glue("Use x {inverse} y, not !(x {comparator_text} y)."),
       type = "warning"
     )
-  })
+  }, linter_level = "expression")
 }

R/condition_message_linter.R

@@ -57,11 +57,8 @@ condition_message_linter <- function() {
   ")
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
 
     bad_expr <- xml_find_all(xml, xpath)
     sep_value <- get_r_string(bad_expr, xpath = "./expr/SYMBOL_SUB[text() = 'sep']/following-sibling::expr/STR_CONST")
@@ -75,5 +72,5 @@ condition_message_linter <- function() {
       '(using "" as a separator). For translatable strings, prefer using gettextf().'
     )
     xml_nodes_to_lints(bad_expr, source_expression = source_expression, lint_message = lint_message, type = "warning")
-  })
+  }, linter_level = "expression")
 }

R/conjunct_test_linter.R

@@ -118,11 +118,8 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE,
 
   Linter(function(source_expression) {
     # need the full file to also catch usages at the top level
-    if (!is_lint_level(source_expression, "file")) {
-      return(list())
-    }
-
     xml <- source_expression$full_xml_parsed_content
+    if (is.null(xml)) return(list())
 
     test_expr <- xml_find_all(xml, test_xpath)
 
@@ -160,5 +157,5 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE,
     }
 
     lints
-  })
+  }, linter_level = "file")
 }

R/consecutive_assertion_linter.R

@@ -49,11 +49,8 @@ consecutive_assertion_linter <- function() {
 
   Linter(function(source_expression) {
     # need the full file to also catch usages at the top level
-    if (!is_lint_level(source_expression, "file")) {
-      return(list())
-    }
-
     xml <- source_expression$full_xml_parsed_content
+    if (is.null(xml)) return(list())
 
     bad_expr <- xml_find_all(xml, xpath)
 
@@ -64,5 +61,5 @@ consecutive_assertion_linter <- function() {
       lint_message = sprintf("Unify consecutive calls to %s().", matched_function),
       type = "warning"
     )
-  })
+  }, linter_level = "file")
 }

R/consecutive_mutate_linter.R

@@ -73,11 +73,8 @@ consecutive_mutate_linter <- function(invalid_backends = "dbplyr") {
 
   Linter(function(source_expression) {
     # need the full file to also catch usages at the top level
-    if (!is_lint_level(source_expression, "file")) {
-      return(list())
-    }
-
     xml <- source_expression$full_xml_parsed_content
+    if (is.null(xml)) return(list())
 
     attach_str <- get_r_string(xml_find_all(xml, attach_pkg_xpath))
     if (any(invalid_backends %in% attach_str)) {
@@ -97,5 +94,5 @@ consecutive_mutate_linter <- function(invalid_backends = "dbplyr") {
       lint_message = "Unify consecutive calls to mutate().",
       type = "warning"
     )
-  })
+  }, linter_level = "file")
 }

R/cyclocomp_linter.R

@@ -23,9 +23,6 @@
 #' @export
 cyclocomp_linter <- function(complexity_limit = 15L) {
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
     complexity <- try_silently(
       cyclocomp::cyclocomp(parse(text = source_expression$content))
     )
@@ -45,5 +42,5 @@ cyclocomp_linter <- function(complexity_limit = 15L) {
       ranges = list(rep(col1, 2L)),
       line = source_expression$lines[1L]
     )
-  })
+  }, linter_level = "expression")
 }

R/duplicate_argument_linter.R

@@ -41,11 +41,8 @@ duplicate_argument_linter <- function(except = c("mutate", "transmute")) {
   xpath_arg_name <- "./EQ_SUB/preceding-sibling::*[1]"
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "file")) {
-      return(list())
-    }
-
     xml <- source_expression$full_xml_parsed_content
+    if (is.null(xml)) return(list())
 
     calls <- xml_find_all(xml, xpath_call_with_args)
 
@@ -64,5 +61,5 @@ duplicate_argument_linter <- function(except = c("mutate", "transmute")) {
       lint_message = "Duplicate arguments in function call.",
       type = "warning"
     )
-  })
+  }, linter_level = "file")
 }

R/equals_na_linter.R

@@ -47,11 +47,8 @@ equals_na_linter <- function() {
   ")
 
   Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
     xml <- source_expression$xml_parsed_content
+    if (is.null(xml)) return(list())
 
     bad_expr <- xml_find_all(xml, xpath)
 
@@ -61,5 +58,5 @@ equals_na_linter <- function() {
       lint_message = "Use is.na for comparisons to NA (not == or != or %in%)",
       type = "warning"
     )
-  })
+  }, linter_level = "expression")
 }