Require R 4.1.0, use shorthand lambdas

.dev/compare_branches.R

@@ -226,7 +226,7 @@ test_encoding <- function(dir) {
     for (r_file in list.files(dir, pattern = "(?i)\\.r(?:md)?$", recursive = TRUE, full.names = TRUE)) {
       # lintr has better encoding support since 8cd6ad~linter>2.0.1~Jul 2021; use
       #   the accompanying helper if possible. clunkier default otherwise.
-      encoding <- tryCatch(lintr:::find_default_encoding(r_file), error = function(...) NULL)
+      encoding <- tryCatch(lintr:::find_default_encoding(r_file), error = \(...) NULL)
       local({
         con <- file(r_file, encoding = encoding %||% "UTF-8")
         on.exit(close(con))
@@ -360,7 +360,7 @@ get_linter_from_name <- function(linter_name) {
     } else {
       eval(call(linter_name))
     },
-    error = function(cond) eval(as.name(linter_name))
+    error = \(cond) eval(as.name(linter_name))
   )
 }
 
@@ -580,7 +580,7 @@ if (params$benchmark) {
             idcol = "package",
             lapply(
               linter,
-              function(package) data.table::data.table(filename = names(package), duration = unlist(package))
+              \(package) data.table::data.table(filename = names(package), duration = unlist(package))
             )
           )
         )

.dev/revdep_compare_releases.R

@@ -44,7 +44,7 @@ snake_case_linter <-
 trailing_semicolons_linter <- function(...) {
   # .call=TRUE means the linter name will be displayed in the warning
   warning("Using deleted linter")
-  Linter(function(...) list())
+  Linter(\(...) list())
 }
 
 
@@ -146,7 +146,7 @@ summarize_failures <- function(version, failures) {
   files <- result_path(version, failures)
   packages <- gsub("\\.failures$", "", failures)
 
-  package_failures <- sapply(files, function(x) paste(unique(readLines(x)), collapse = " ||| "))
+  package_failures <- sapply(files, \(x) paste(unique(readLines(x)), collapse = " ||| "))
 
   paste(sprintf("  %s: %s", packages, package_failures), collapse = "\n")
 }

DESCRIPTION

@@ -24,9 +24,8 @@ License: MIT + file LICENSE
 URL: https://lintr.r-lib.org, https://github.com/r-lib/lintr
 BugReports: https://github.com/r-lib/lintr/issues
 Depends:
-    R (>= 4.0)
+    R (>= 4.1.0)
 Imports:
-    backports (>= 1.5.0),
     cli (>= 3.4.0),
     codetools,
     digest,

NEWS.md

@@ -4,6 +4,10 @@
 
 * Six linters fully deprecated in the previous release are now removed: `consecutive_stopifnot_linter()`, `extraction_operator_linter()`, `no_tab_linter()`, `single_quotes_linter()`, `unnecessary_nested_if_linter()`, and `unneeded_concatenation_linter()`.
 
+## Notes
+
+* {lintr} now requires R 4.1.0
+
 # lintr (3.3.0-1)
 
 ## Deprecations & breaking changes

R/backport_linter.R

@@ -50,7 +50,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(), linter_level = "file"))
+    return(Linter(\(source_expression) list(), linter_level = "file"))
   }
 
   backport_blacklist <- backports[r_version < R_system_version(names(backports))]

R/conjunct_test_linter.R

@@ -12,8 +12,7 @@
 #'   if you're using another function named `filter()`, e.g. [stats::filter()], please namespace-qualify it to avoid
 #'   false positives. You can omit linting `filter()` expressions altogether via `allow_filter = TRUE`.
 #'
-#' @param allow_named_stopifnot Logical, `TRUE` by default. If `FALSE`, "named" calls to `stopifnot()`,
-#'   available since R 4.0.0 to provide helpful messages for test failures, are also linted.
+#' @param allow_named_stopifnot Logical, `TRUE` by default. If `FALSE`, "named" calls to `stopifnot()` are also linted.
 #' @param allow_filter Character naming the method for linting calls to `filter()`. The default, `"never"`, means
 #'   `filter()` and `dplyr::filter()` calls are linted; `"not_dplyr"` means only `dplyr::filter()` calls are linted;
 #'   and `"always"` means no calls to `filter()` are linted. Calls like `stats::filter()` are never linted.

R/exclude.R

@@ -75,7 +75,7 @@ is_excluded <- function(line_number, linter, file_exclusion) {
 is_excluded_file <- function(file_exclusion) {
   any(vapply(
     file_exclusion[!nzchar(names2(file_exclusion))],
-    function(full_exclusion) Inf %in% full_exclusion,
+    \(full_exclusion) Inf %in% full_exclusion,
     logical(1L)
   ))
 }
@@ -170,7 +170,7 @@ parse_exclusions <- function(file,
     exclusions <- add_exclusions(exclusions, nextt + 1L, linters_string, exclude_linter_sep, linter_names)
   }
 
-  exclusions[] <- lapply(exclusions, function(lines) sort(unique(lines)))
+  exclusions[] <- lapply(exclusions, \(lines) sort(unique(lines)))
 
   exclusions
 }
@@ -413,6 +413,6 @@ remove_linter_duplicates <- function(x) {
 
 # Removes linter exclusions without lines and files without any linter exclusions.
 remove_empty <- function(x) {
-  x[] <- lapply(x, function(ex) ex[lengths(ex) > 0L])
+  x[] <- lapply(x, \(ex) ex[lengths(ex) > 0L])
   x[lengths(x) > 0L]
 }

R/expect_lint.R

@@ -79,9 +79,9 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno
     lints <- lints[lint_order]
 
     check_order <- order(
-      vapply(checks, function(x) x$line_number %||% 0L, FUN.VALUE = integer(1L)),
-      vapply(checks, function(x) x$column_number %||% 0L, FUN.VALUE = integer(1L)),
-      vapply(checks, function(x) x$linter %||% "", FUN.VALUE = character(1L))
+      vapply(checks, \(x) x$line_number %||% 0L, FUN.VALUE = integer(1L)),
+      vapply(checks, \(x) x$column_number %||% 0L, FUN.VALUE = integer(1L)),
+      vapply(checks, \(x) x$linter %||% "", FUN.VALUE = character(1L))
     )
     checks <- checks[check_order]
   }

R/get_source_expressions.R

@@ -77,11 +77,11 @@ get_source_expressions <- function(filename, lines = NULL) {
   source_expression$lines <- extract_r_source(
     filename = source_expression$filename,
     lines = source_expression$lines,
-    error = function(e) lint_rmd_error(e, source_expression)
+    error = \(e) lint_rmd_error(e, source_expression)
   )
   names(source_expression$lines) <- seq_along(source_expression$lines)
   source_expression$content <- get_content(source_expression$lines)
-  parsed_content <- get_source_expression(source_expression, error = function(e) lint_parse_error(e, source_expression))
+  parsed_content <- get_source_expression(source_expression, error = \(e) lint_parse_error(e, source_expression))
 
   # Currently no way to distinguish the source of the warning
   #   from the message itself, so we just grep the source for the
@@ -218,7 +218,7 @@ parser_warning_regexes <- list(
 #'
 #' @noRd
 fixup_line <- function(line) {
-  nchars <- tryCatch(nchar(line, type = "chars"), error = function(e) NA_integer_)
+  nchars <- tryCatch(nchar(line, type = "chars"), error = \(e) NA_integer_)
   if (is.na(nchars)) {
     ""
   } else {
@@ -584,7 +584,7 @@ maybe_append_expression_xml <- function(expressions, xml_parsed_content) {
   }
   expression_xmls <- lapply(
     xml_find_all(xml_parsed_content, "/exprlist/*"),
-    function(top_level_expr) xml2::xml_add_parent(xml2::xml_new_root(top_level_expr), "exprlist")
+    \(top_level_expr) xml2::xml_add_parent(xml2::xml_new_root(top_level_expr), "exprlist")
   )
   for (i in seq_along(expressions)) {
     expressions[[i]]$xml_parsed_content <- expression_xmls[[i]]
@@ -625,7 +625,7 @@ fix_tab_indentations <- function(source_expression) {
 
   tab_cols <- gregexpr("\t", source_expression[["lines"]], fixed = TRUE)
   names(tab_cols) <- seq_along(tab_cols)
-  matched_lines <- vapply(tab_cols, function(line_match) !is.na(line_match[1L]) && line_match[1L] > 0L, logical(1L))
+  matched_lines <- vapply(tab_cols, \(line_match) !is.na(line_match[1L]) && line_match[1L] > 0L, logical(1L))
   if (!any(matched_lines)) {
     return(parse_data)
   }

R/indentation_linter.R

@@ -133,7 +133,7 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
   find_indent_type <- switch(hanging_indent_style,
     tidy = build_indentation_style_tidy(),
     always = build_indentation_style_always(),
-    never = function(change) "block"
+    never = \(change) "block"
   )
 
   if (isTRUE(assignment_as_infix)) {

R/line_length_linter.R

@@ -117,7 +117,7 @@ is_in_string_body <- function(parse_data, max_length, long_idx) {
   # right delimiter just ends at 'col2', but 'col1' takes some sleuthing
   str_data$line1_width <- nchar(vapply(
     strsplit(str_data$text, "\n", fixed = TRUE),
-    function(x) x[1L],
+    \(x) x[1L],
     FUN.VALUE = character(1L),
     USE.NAMES = FALSE
   ))

R/lint.R

@@ -232,7 +232,7 @@ lint_dir <- function(path = ".", ...,
 drop_excluded <- function(files, exclusions) {
   to_exclude <- vapply(
     files,
-    function(file) file %in% names(exclusions) && is_excluded_file(exclusions[[file]]),
+    \(file) file %in% names(exclusions) && is_excluded_file(exclusions[[file]]),
     logical(1L)
   )
   files[!to_exclude]
@@ -612,7 +612,7 @@ sarif_output <- function(lints, filename = "lintr_results.sarif") {
       rule_index_exists <-
         which(vapply(
           sarif$runs[[1L]]$tool$driver$rules,
-          function(x) x$id == lint$linter,
+          \(x) x$id == lint$linter,
           logical(1L)
         ))
       if (length(rule_index_exists) == 0L || is.na(rule_index_exists[1L])) {

R/linter_tags.R

@@ -85,11 +85,11 @@ build_available_linters <- function(available, package, tags, exclude_tags) {
   available_df <- data.frame(linter = available[["linter"]], package)
   available_df$tags <- strsplit(available[["tags"]], split = " ", fixed = TRUE)
   if (!is.null(tags)) {
-    matches_tags <- vapply(available_df$tags, function(linter_tags) any(linter_tags %in% tags), logical(1L))
+    matches_tags <- vapply(available_df$tags, \(linter_tags) any(linter_tags %in% tags), logical(1L))
     available_df <- available_df[matches_tags, ]
   }
   if (!is.null(exclude_tags)) {
-    matches_exclude <- vapply(available_df$tags, function(linter_tags) any(linter_tags %in% exclude_tags), logical(1L))
+    matches_exclude <- vapply(available_df$tags, \(linter_tags) any(linter_tags %in% exclude_tags), logical(1L))
     available_df <- available_df[!matches_exclude, ]
   }
 
@@ -184,7 +184,7 @@ rd_linters <- function(tag_name) {
 rd_taglist <- function() {
   linters <- available_linters(exclude_tags = NULL)
   # don't count tags on deprecated linters to the counts of other tags
-  linters$tags <- lapply(linters$tags, function(x) if ("deprecated" %in% x) "deprecated" else x)
+  linters$tags <- lapply(linters$tags, \(x) if ("deprecated" %in% x) "deprecated" else x)
 
   tag_table <- table(unlist(linters[["tags"]]))
   tags <- platform_independent_sort(names(tag_table))

R/literal_coercion_linter.R

@@ -101,7 +101,7 @@ literal_coercion_linter <- function() {
       # TODO(#2473): Avoid a recommendation like '1' that clashes with implicit_integer_linter().
       literal_equivalent_str <- vapply(
         str2expression(coercion_str),
-        function(expr) deparse1(suppressWarnings(eval(expr))),
+        \(expr) deparse1(suppressWarnings(eval(expr))),
         character(1L)
       )
       lint_message <- sprintf(

R/namespace.R

@@ -2,7 +2,7 @@
 namespace_imports <- function(path = find_package(".")) {
   namespace_data <- tryCatch(
     parseNamespaceFile(basename(path), package.lib = file.path(path, "..")),
-    error = function(e) NULL
+    error = \(e) NULL
   )
 
   if (length(namespace_data$imports) == 0L) {
@@ -57,7 +57,7 @@ imported_s3_generics <- function(ns_imports) {
 exported_s3_generics <- function(path = find_package(".")) {
   namespace_data <- tryCatch(
     parseNamespaceFile(basename(path), package.lib = file.path(path, "..")),
-    error = function(e) NULL
+    error = \(e) NULL
   )
 
   if (length(namespace_data$S3methods) == 0L || nrow(namespace_data$S3methods) == 0L) {

R/namespace_linter.R

@@ -79,7 +79,7 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) {
     ## Case 2/3/4: problems with foo in pkg::foo / pkg:::foo
 
     # run here, not in the factory, to allow for run- vs. "compile"-time differences in package structure
-    namespaces <- lapply(packages, function(package) tryCatch(getNamespace(package), error = identity))
+    namespaces <- lapply(packages, \(package) tryCatch(getNamespace(package), error = identity))
     failed_namespace <- vapply(namespaces, inherits, "condition", FUN.VALUE = logical(1L))
 
     # nocov start
@@ -126,7 +126,7 @@ namespace_symbols <- function(ns, exported = TRUE) {
 is_in_pkg <- function(symbols, namespaces, exported = TRUE) {
   vapply(
     seq_along(symbols),
-    function(ii) symbols[[ii]] %in% namespace_symbols(namespaces[[ii]], exported = exported),
+    \(ii) symbols[[ii]] %in% namespace_symbols(namespaces[[ii]], exported = exported),
     logical(1L)
   )
 }

R/object_overwrite_linter.R

@@ -63,7 +63,7 @@ object_overwrite_linter <- function(
   pkg_exports <- lapply(
     packages,
     # .__C__ etc.: drop 150+ "virtual" names since they are very unlikely to appear anyway
-    function(pkg) setdiff(grep("^[.]__[A-Z]__", getNamespaceExports(pkg), value = TRUE, invert = TRUE), allow_names)
+    \(pkg) setdiff(grep("^[.]__[A-Z]__", getNamespaceExports(pkg), value = TRUE, invert = TRUE), allow_names)
   )
   pkg_exports <- data.frame(
     package = rep(packages, lengths(pkg_exports)),

R/object_usage_linter.R

@@ -190,7 +190,7 @@ make_check_env <- function(pkg_name, xml, library_lint_hook) {
 
   # Just assign them an empty function
   for (symbol in symbols) {
-    assign(symbol, function(...) invisible(), envir = env)
+    assign(symbol, \(...) invisible(), envir = env)
   }
   env
 }

R/package_hooks_linter.R

@@ -70,7 +70,7 @@ package_hooks_linter <- function() {
   "
   bad_call_xpaths <- vapply(
     seq_along(bad_calls),
-    function(ii) sprintf(bad_msg_call_xpath_fmt, names(bad_calls)[ii], xp_text_in_table(bad_calls[[ii]])),
+    \(ii) sprintf(bad_msg_call_xpath_fmt, names(bad_calls)[ii], xp_text_in_table(bad_calls[[ii]])),
     character(1L)
   )
   names(bad_call_xpaths) <- names(bad_calls)

R/settings.R

@@ -244,7 +244,7 @@ validate_exclusions <- function(exclusions) {
   exclusion_names <- names2(exclusions)
   has_names <- nzchar(exclusion_names)
   unnamed_is_string <-
-    vapply(exclusions[!has_names], function(x) is.character(x) && length(x) == 1L && !is.na(x), logical(1L))
+    vapply(exclusions[!has_names], \(x) is.character(x) && length(x) == 1L && !is.na(x), logical(1L))
   if (!all(unnamed_is_string)) {
     problematic_entries <- which(!has_names)[!unnamed_is_string] # nolint: object_usage_linter. TODO(#2252).
     cli_abort(c(
@@ -258,7 +258,7 @@ validate_exclusions <- function(exclusions) {
 validate_named_exclusion <- function(exclusions, idx) {
   entry <- exclusions[[idx]]
   if (is.list(entry)) {
-    valid_entry <- vapply(entry, function(x) is.numeric(x) && !anyNA(x), logical(1L))
+    valid_entry <- vapply(entry, \(x) is.numeric(x) && !anyNA(x), logical(1L))
   } else {
     valid_entry <- is.numeric(entry) && !anyNA(entry)
   }
@@ -298,8 +298,8 @@ get_encoding_from_dcf <- function(file) {
 
   encodings <- tryCatch(
     unname(drop(read.dcf(file, "Encoding"))),
-    error = function(e) NULL,
-    warning = function(e) NULL
+    error = \(e) NULL,
+    warning = \(e) NULL
   )
 
   encodings <- encodings[!is.na(encodings)]

R/shared_constants.R

@@ -309,8 +309,8 @@ glue_parse_failure_warning <- function(cond) {
 glue_symbol_extractor <- function(text, envir, data) {
   symbols <- tryCatch(
     all.vars(parse(text = text), functions = TRUE),
-    error = function(...) NULL,
-    warning = function(...) NULL
+    error = \(...) NULL,
+    warning = \(...) NULL
   )
   for (sym in symbols) {
     assign(sym, NULL, envir = envir)

R/trailing_whitespace_linter.R

@@ -59,7 +59,7 @@ trailing_whitespace_linter <- function(allow_empty_lines = FALSE, allow_in_strin
       start_lines <- as.integer(xml_attr(all_str_consts, "line1"))
       end_lines <- as.integer(xml_attr(all_str_consts, "line2"))
 
-      is_in_str <- vapply(bad_lines, function(ln) any(start_lines <= ln & ln < end_lines), logical(1L))
+      is_in_str <- vapply(bad_lines, \(ln) any(start_lines <= ln & ln < end_lines), logical(1L))
       bad_lines <- bad_lines[!is_in_str]
     }
 

R/utils.R

@@ -263,7 +263,7 @@ is_tainted <- function(lines) {
 #' @param ref_help Help page to refer users hitting an error to.
 #' @noRd
 check_dots <- function(dot_names, ref_calls, ref_help = as.character(sys.call(-1L)[[1L]])) {
-  valid_args <- unlist(lapply(ref_calls, function(f) names(formals(f))))
+  valid_args <- unlist(lapply(ref_calls, \(f) names(formals(f))))
   is_valid <- dot_names %in% valid_args
   if (all(is_valid)) {
     return(invisible())

R/xml_utils.R

@@ -42,7 +42,7 @@ safe_parse_to_xml <- function(parsed_content) {
   tryCatch(
     xml2::read_xml(xmlparsedata::xml_parse_data(parsed_content)),
     # use xml_missing so that code doesn't always need to condition on XML existing
-    error = function(e) xml2::xml_missing()
+    error = \(e) xml2::xml_missing()
   )
 }
 

R/zzz.R

@@ -307,9 +307,6 @@ logical_env <- function(x, unset = "") {
   toset <- !(names(op_lintr) %in% names(op))
   if (any(toset)) options(op_lintr[toset])
 
-  # R>=4.1.0: ...names
-  backports::import(pkgname, "...names")
-
   utils::assignInMyNamespace("default_settings", list(
     linters = default_linters,
     encoding = "UTF-8",