Merge branch 'character_only' of github.com:r-lib/lintr into characte…

…r_only

DESCRIPTION

@@ -36,7 +36,7 @@ Imports:
     xmlparsedata (>= 1.0.5)
 Suggests:
     bookdown,
-    crayon,
+    cli,
     httr (>= 1.2.1),
     jsonlite,
     mockery,

NEWS.md

@@ -7,7 +7,7 @@
 ## New and improved features
 
 * More helpful errors for invalid configs (#2253, @MichaelChirico).
-* `library_call_linter()` is extended to encouraging all packages to be attached with `library(symbol)`, not `library("symbol", character.only = TRUE)` or "vectorized" approaches looping over package names (part of #884, @MichaelChirico).
+* `library_call_linter()` is extended to encourage all packages to be attached with `library(symbol)`, not `library("symbol", character.only = TRUE)` or "vectorized" approaches looping over package names (part of #884, @MichaelChirico).
 
 ### New linters
 

R/exclude.R

@@ -35,20 +35,20 @@ exclude <- function(lints, exclusions = settings$exclusions, linter_names = NULL
     return(lints)
   }
 
-  df <- as.data.frame(lints)
+  lint_df <- as.data.frame(lints)
 
-  filenames <- unique(df$filename)
+  filenames <- unique(lint_df$filename)
   source_exclusions <- lapply(filenames, parse_exclusions, linter_names = linter_names, ...)
   names(source_exclusions) <- filenames
 
 
   exclusions <- normalize_exclusions(c(source_exclusions, exclusions))
   to_exclude <- vapply(
-    seq_len(nrow(df)),
+    seq_len(nrow(lint_df)),
     function(i) {
-      file <- df$filename[i]
-      file %in% names(exclusions) &&
-        is_excluded(df$line_number[i], df$linter[i], exclusions[[file]])
+      filename <- lint_df$filename[i]
+      filename %in% names(exclusions) &&
+        is_excluded(lint_df$line_number[i], lint_df$linter[i], exclusions[[filename]])
     },
     logical(1L)
   )
@@ -375,11 +375,11 @@ remove_linter_duplicates <- function(x) {
 
     if (length(unique_linters) < length(ex)) {
       ex <- lapply(unique_linters, function(linter) {
-        lines <- unlist(ex[names2(ex) == linter])
-        if (Inf %in% lines) {
+        excluded_lines <- unlist(ex[names2(ex) == linter])
+        if (Inf %in% excluded_lines) {
           Inf
         } else {
-          lines
+          excluded_lines
         }
       })
 

R/expect_lint.R

@@ -99,19 +99,19 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") {
             itr, field, deparse(value), deparse(check)
           )
           # deparse ensures that NULL, list(), etc are handled gracefully
-          exp <- if (field == "message") {
+          ok <- if (field == "message") {
             re_matches(value, check)
           } else {
             isTRUE(all.equal(value, check))
           }
-          if (!is.logical(exp)) {
+          if (!is.logical(ok)) {
             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)
+          testthat::expect(ok, msg)
         })
       },
       lints,

R/extract.R

@@ -93,8 +93,8 @@ get_chunk_positions <- function(pattern, lines) {
 
 filter_chunk_start_positions <- function(starts, lines) {
   # keep blocks that don't set a knitr engine (and so contain evaluated R code)
-  drop <- defines_knitr_engine(lines[starts])
-  starts[!drop]
+  drop_idx <- defines_knitr_engine(lines[starts])
+  starts[!drop_idx]
 }
 
 filter_chunk_end_positions <- function(starts, ends) {

R/lint.R

@@ -338,18 +338,18 @@ define_linters <- function(linters = NULL) {
 validate_linter_object <- function(linter, name) {
   if (!is_linter(linter) && is.function(linter)) {
     if (is_linter_factory(linter)) {
-      old <- "Passing linters as variables"
-      new <- "a call to the linters (see ?linters)"
       lintr_deprecated(
-        old = old, new = new, version = "3.0.0",
+        old = "Passing linters as variables",
+        new =  "a call to the linters (see ?linters)",
+        version = "3.0.0",
         type = ""
       )
       linter <- linter()
     } else {
-      old <- "The use of linters of class 'function'"
-      new <- "linters classed as 'linter' (see ?Linter)"
       lintr_deprecated(
-        old = old, new = new, version = "3.0.0",
+        old = "The use of linters of class 'function'",
+        new = "linters classed as 'linter' (see ?Linter)",
+        version = "3.0.0",
         type = ""
       )
       linter <- Linter(linter, name = name)

R/matrix_apply_linter.R

@@ -72,7 +72,7 @@ matrix_apply_linter <- function() {
 
   # This doesn't handle the case when MARGIN and FUN are named and in a different position
   # but this should be relatively rate
-  var_xpath <- "expr[position() = 2]"
+  variable_xpath <- "expr[position() = 2]"
   margin_xpath <- "expr[position() = 3]"
   fun_xpath <- "expr[position() = 4]"
 
@@ -84,7 +84,7 @@ matrix_apply_linter <- function() {
 
     bad_expr <- xml_find_all(xml, xpath)
 
-    var <- xml_text(xml_find_all(bad_expr, var_xpath))
+    variable <- xml_text(xml_find_all(bad_expr, variable_xpath))
 
     fun <- xml_text(xml_find_all(bad_expr, fun_xpath))
     fun <- tools::toTitleCase(fun)
@@ -95,7 +95,7 @@ matrix_apply_linter <- function() {
       xml_find_first(bad_expr, "SYMBOL_SUB[text() = 'na.rm']/following-sibling::expr")
     )
 
-    recos <- Map(craft_colsums_rowsums_msg, var, margin, fun, narm_val)
+    recos <- Map(craft_colsums_rowsums_msg, variable, margin, fun, narm_val)
 
     xml_nodes_to_lints(
       bad_expr,
@@ -106,7 +106,7 @@ matrix_apply_linter <- function() {
   })
 }
 
-craft_colsums_rowsums_msg <- function(var, margin, fun, narm_val) {
+craft_colsums_rowsums_msg <- function(variable, margin, fun, narm_val) {
   if (is.na(xml_find_first(margin, "OP-COLON"))) {
     l1 <- xml_text(margin)
     l2 <- NULL
@@ -135,12 +135,12 @@ craft_colsums_rowsums_msg <- function(var, margin, fun, narm_val) {
   }
 
   if (identical(l1, 1L)) {
-    reco <- glue("row{fun}s({var}{narm}, dims = {l2})")
+    reco <- glue("row{fun}s({variable}{narm}, dims = {l2})")
   } else {
     reco <- glue(
-      "row{fun}s(col{fun}s({var}{narm}, dims = {l1 - 1}), dims = {l2 - l1 + 1})",
+      "row{fun}s(col{fun}s({variable}{narm}, dims = {l1 - 1}), dims = {l2 - l1 + 1})",
       " or ",
-      "col{fun}s({var}{narm}, dims = {l1 - 1}) if {var} has {l2} dimensions"
+      "col{fun}s({variable}{narm}, dims = {l1 - 1}) if {variable} has {l2} dimensions"
     )
   }
 

R/methods.R

@@ -1,13 +1,13 @@
 #' @export
 format.lint <- function(x, ...) {
-  if (requireNamespace("crayon", quietly = TRUE)) {
+  if (requireNamespace("cli", quietly = TRUE)) {
     color <- switch(x$type,
-      warning = crayon::magenta,
-      error = crayon::red,
-      style = crayon::blue,
-      crayon::bold
+      warning = cli::col_magenta,
+      error = cli::col_red,
+      style = cli::col_blue,
+      cli::style_bold
     )
-    emph <- crayon::bold
+    emph <- cli::style_bold
   } else {
     # nocov start
     color <- identity

R/object_usage_linter.R

@@ -213,16 +213,16 @@ parse_check_usage <- function(expression,
   )
 
   # nocov start
-  missing <- is.na(res$message)
-  if (any(missing)) {
+  is_missing <- is.na(res$message)
+  if (any(is_missing)) {
     # TODO (AshesITR): Remove this in the future, if no bugs arise from this safeguard
     warning(
-      "Possible bug in lintr: Couldn't parse usage message ", sQuote(vals[missing][[1L]]), ". ",
-      "Ignoring ", sum(missing), " usage warnings. Please report an issue at https://github.com/r-lib/lintr/issues."
+      "Possible bug in lintr: Couldn't parse usage message ", sQuote(vals[is_missing][[1L]]), ". ",
+      "Ignoring ", sum(is_missing), " usage warnings. Please report an issue at https://github.com/r-lib/lintr/issues."
     )
   }
   # nocov end
-  res <- res[!missing, ]
+  res <- res[!is_missing, ]
 
   res$line1 <- ifelse(
     nzchar(res$line1),

R/paste_linter.R

@@ -258,11 +258,11 @@ paste_linter <- function(allow_empty_sep = FALSE,
 }
 
 check_is_not_file_path <- function(expr, allow_file_path) {
-  args <- xml_find_all(expr, "expr[position() > 1]")
+  arguments <- xml_find_all(expr, "expr[position() > 1]")
 
-  is_string <- !is.na(xml_find_first(args, "STR_CONST"))
-  string_values <- character(length(args))
-  string_values[is_string] <- get_r_string(args[is_string])
+  is_string <- !is.na(xml_find_first(arguments, "STR_CONST"))
+  string_values <- character(length(arguments))
+  string_values[is_string] <- get_r_string(arguments[is_string])
   not_start_slash <- which(!startsWith(string_values, "/"))
   not_end_slash <- which(!endsWith(string_values, "/"))
 

R/sort_linter.R

@@ -93,11 +93,10 @@ sort_linter <- function() {
   "
 
 
-  args_xpath <- ".//SYMBOL_SUB[text() = 'method' or
-                               text() = 'decreasing' or
-                               text() = 'na.last']"
+  arguments_xpath <-
+    ".//SYMBOL_SUB[text() = 'method' or text() = 'decreasing' or text() = 'na.last']"
 
-  arg_values_xpath <- glue("{args_xpath}/following-sibling::expr[1]")
+  arg_values_xpath <- glue("{arguments_xpath}/following-sibling::expr[1]")
 
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {
@@ -108,16 +107,16 @@ sort_linter <- function() {
 
     order_expr <- xml_find_all(xml, order_xpath)
 
-    var <- xml_text(xml_find_first(
+    variable <- xml_text(xml_find_first(
       order_expr,
       ".//SYMBOL_FUNCTION_CALL[text() = 'order']/parent::expr[1]/following-sibling::expr[1]"
     ))
 
-    orig_call <- sprintf("%s[%s]", var, get_r_string(order_expr))
+    orig_call <- sprintf("%s[%s]", variable, get_r_string(order_expr))
 
     # Reconstruct new argument call for each expression separately
-    args <- vapply(order_expr, function(e) {
-      arg_names <- xml_text(xml_find_all(e, args_xpath))
+    arguments <- vapply(order_expr, function(e) {
+      arg_names <- xml_text(xml_find_all(e, arguments_xpath))
       arg_values <- xml_text(xml_find_all(e, arg_values_xpath))
       if (!"na.last" %in% arg_names) {
         arg_names <- c(arg_names, "na.last")
@@ -126,7 +125,7 @@ sort_linter <- function() {
       paste(arg_names, "=", arg_values, collapse = ", ")
     }, character(1L))
 
-    new_call <- sprintf("sort(%s, %s)", var, args)
+    new_call <- sprintf("sort(%s, %s)", variable, arguments)
 
     order_lints <- xml_nodes_to_lints(
       order_expr,

R/sprintf_linter.R

@@ -113,13 +113,13 @@ sprintf_linter <- function() {
 
     sprintf_calls <- xml_find_all(xml, call_xpath)
 
-    message <- vapply(sprintf_calls, capture_sprintf_warning, character(1L))
+    sprintf_warning <- vapply(sprintf_calls, capture_sprintf_warning, character(1L))
 
-    has_message <- !is.na(message)
+    has_warning <- !is.na(sprintf_warning)
     xml_nodes_to_lints(
-      sprintf_calls[has_message],
+      sprintf_calls[has_warning],
       source_expression = source_expression,
-      lint_message = message[has_message],
+      lint_message = sprintf_warning[has_warning],
       type = "warning"
     )
   })

R/utils.R

@@ -50,21 +50,21 @@ fix_names <- function(x, default) {
 }
 
 linter_auto_name <- function(which = -3L) {
-  call <- sys.call(which = which)
-  nm <- paste(deparse(call, 500L), collapse = " ")
+  sys_call <- sys.call(which = which)
+  nm <- paste(deparse(sys_call, 500L), collapse = " ")
   regex <- rex(start, one_or_more(alnum %or% "." %or% "_" %or% ":"))
   if (re_matches(nm, regex)) {
-    match <- re_matches(nm, regex, locations = TRUE)
-    nm <- substr(nm, start = 1L, stop = match[1L, "end"])
+    match_data <- re_matches(nm, regex, locations = TRUE)
+    nm <- substr(nm, start = 1L, stop = match_data[1L, "end"])
     nm <- re_substitutes(nm, rex(start, alnums, "::"), "")
   }
   nm
 }
 
 auto_names <- function(x) {
   nms <- names2(x)
-  missing <- nms == ""
-  if (!any(missing)) {
+  empty <- !nzchar(nms, keepNA = TRUE)
+  if (!any(empty)) {
     return(nms)
   }
 
@@ -75,9 +75,9 @@ auto_names <- function(x) {
       paste(deparse(x, 500L), collapse = " ")
     }
   }
-  defaults <- vapply(x[missing], default_name, character(1L), USE.NAMES = FALSE)
+  defaults <- vapply(x[empty], default_name, character(1L), USE.NAMES = FALSE)
 
-  nms[missing] <- defaults
+  nms[empty] <- defaults
   nms
 }
 

R/with.R

@@ -220,14 +220,14 @@ call_linter_factory <- function(linter_factory, linter_name, package) {
 #' @keywords internal
 #' @noRd
 guess_names <- function(..., missing_index) {
-  args <- as.character(eval(substitute(alist(...)[missing_index])))
+  arguments <- as.character(eval(substitute(alist(...)[missing_index])))
   # foo_linter(x=1) => "foo"
   # var[["foo"]]    => "foo"
   # strip call: foo_linter(x=1) --> foo_linter
   # NB: Very long input might have newlines which are not caught
   #  by . in a perl regex; see #774
-  args <- re_substitutes(args, rex("(", anything), "", options = "s")
+  arguments <- re_substitutes(arguments, rex("(", anything), "", options = "s")
   # strip extractors: pkg::foo_linter, var[["foo_linter"]] --> foo_linter
-  args <- re_substitutes(args, rex(start, anything, '["' %or% "::"), "")
-  re_substitutes(args, rex('"]', anything, end), "")
+  arguments <- re_substitutes(arguments, rex(start, anything, '["' %or% "::"), "")
+  re_substitutes(arguments, rex('"]', anything, end), "")
 }

vignettes/lintr.Rmd

@@ -181,17 +181,17 @@ linters_with_args <- lapply(
 )
 
 make_setting_string <- function(linter_name) {
-  args <- linters_with_args[[linter_name]]
-  if (is.null(args)) {
+  linter_args <- linters_with_args[[linter_name]]
+  if (is.null(linter_args)) {
     return("")
   }
 
-  arglist <- vapply(args, function(arg) {
+  arglist <- vapply(linter_args, function(arg) {
     env <- environment(default_linters[[linter_name]])
     deparse(env[[arg]])
   }, character(1L))
 
-  paste0(args, " = ", arglist, collapse = ", ")
+  paste0(linter_args, " = ", arglist, collapse = ", ")
 }
 
 defaults_table <- data.frame(