Format with Air (#7662)

* Add `air.toml` * Format `data-raw/` * Format `bench/` * Format `R/` * Format `tests/` * Fix manually adjusted typo * Reformat again with better hugging and `~` behavior * Add in `~` terminal tweaks * Reformat with tight `()` hugging
tidyverse · Feb 21, 2025 · 893dbac · 893dbac
1 parent 861c8a5
commit 893dbac
Show file tree

Hide file tree

Showing 143 changed files with 3,877 additions and 1,863 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -43,3 +43,4 @@
 ^compile_commands\.json$
 ^\.cache$
 ^\.vscode$
+^air.toml$
diff --git a/.vscode/settings.json b/.vscode/settings.json
@@ -0,0 +1,5 @@
+{
+    "[r]": {
+        "editor.formatOnSave": true
+    }
+}
diff --git a/R/across.R b/R/across.R
@@ -204,11 +204,7 @@
 #'
 #' @export
 #' @seealso [c_across()] for a function that returns a vector
-across <- function(.cols,
-                   .fns,
-                   ...,
-                   .names = NULL,
-                   .unpack = FALSE) {
+across <- function(.cols, .fns, ..., .names = NULL, .unpack = FALSE) {
   mask <- peek_mask()
   caller_env <- caller_env()
 
@@ -323,7 +319,8 @@ across <- function(.cols,
         out[[k]] <- fn(col, ...)
         k <- k + 1L
       }
-    }, error = function(cnd) {
+    },
+    error = function(cnd) {
       bullets <- c(
         glue("Can't compute column `{names[k]}`.")
       )
@@ -416,18 +413,22 @@ across_glue_mask <- function(.col, .fn, .caller_env) {
   glue_mask <- env(.caller_env, .col = .col, .fn = .fn)
   # TODO: we can make these bindings louder later
   env_bind_active(
-    glue_mask, col = function() glue_mask$.col, fn = function() glue_mask$.fn
+    glue_mask,
+    col = function() glue_mask$.col,
+    fn = function() glue_mask$.fn
   )
   glue_mask
 }
 
-across_setup <- function(cols,
-                         fns,
-                         names,
-                         .caller_env,
-                         mask,
-                         error_call = caller_env(),
-                         across_if_fn = "across") {
+across_setup <- function(
+  cols,
+  fns,
+  names,
+  .caller_env,
+  mask,
+  error_call = caller_env(),
+  across_if_fn = "across"
+) {
   cols <- enquo(cols)
 
   # `across()` is evaluated in a data mask so we need to remove the
@@ -439,7 +440,9 @@ across_setup <- function(cols,
   if (is.null(fns) && quo_is_call(cols, "~")) {
     bullets <- c(
       "Must supply a column selection.",
-      i = glue("You most likely meant: `{across_if_fn}(everything(), {as_label(cols)})`."),
+      i = glue(
+        "You most likely meant: `{across_if_fn}(everything(), {as_label(cols)})`."
+      ),
       i = "The first argument `.cols` selects a set of columns.",
       i = "The second argument `.fns` operates on each selected columns."
     )
@@ -495,9 +498,10 @@ across_setup <- function(cols,
     }
   }
 
-  glue_mask <- across_glue_mask(.caller_env,
+  glue_mask <- across_glue_mask(
+    .caller_env,
     .col = rep(names_vars, each = length(fns)),
-    .fn  = rep(names_fns , length(vars))
+    .fn = rep(names_fns, length(vars))
   )
   names <- vec_as_names(
     glue(names, .envir = glue_mask),
@@ -785,7 +789,7 @@ expand_across <- function(quo) {
   n_fns <- length(fns)
 
   seq_vars <- seq_len(n_vars)
-  seq_fns  <- seq_len(n_fns)
+  seq_fns <- seq_len(n_fns)
 
   exprs <- new_list(n_vars * n_fns, names = names)
 

diff --git a/R/all-equal.R b/R/all-equal.R
@@ -31,24 +31,43 @@
 #'   mtcars,
 #'   mtcars2[rownames(mtcars), names(mtcars)]
 #' )
-all_equal <- function(target, current, ignore_col_order = TRUE,
-                      ignore_row_order = TRUE, convert = FALSE, ...) {
-
-  lifecycle::deprecate_warn("1.1.0",
+all_equal <- function(
+  target,
+  current,
+  ignore_col_order = TRUE,
+  ignore_row_order = TRUE,
+  convert = FALSE,
+  ...
+) {
+  lifecycle::deprecate_warn(
+    "1.1.0",
     "all_equal()",
     "all.equal()",
     details = "And manually order the rows/cols as needed"
   )
 
-  equal_data_frame(target, current,
+  equal_data_frame(
+    target,
+    current,
     ignore_col_order = ignore_col_order,
     ignore_row_order = ignore_row_order,
     convert = convert
   )
 }
 
-equal_data_frame <- function(x, y, ignore_col_order = TRUE, ignore_row_order = TRUE, convert = FALSE) {
-  compat <- is_compatible(x, y, ignore_col_order = ignore_col_order, convert = convert)
+equal_data_frame <- function(
+  x,
+  y,
+  ignore_col_order = TRUE,
+  ignore_row_order = TRUE,
+  convert = FALSE
+) {
+  compat <- is_compatible(
+    x,
+    y,
+    ignore_col_order = ignore_col_order,
+    convert = convert
+  )
   if (!isTRUE(compat)) {
     # revert the bulleting from is_compatible()
     return(glue_collapse(compat, sep = "\n"))
@@ -65,8 +84,8 @@ equal_data_frame <- function(x, y, ignore_col_order = TRUE, ignore_row_order = T
   }
 
   # suppressMessages({
-    x <- as_tibble(x, .name_repair = "universal")
-    y <- as_tibble(y, .name_repair = "universal")
+  x <- as_tibble(x, .name_repair = "universal")
+  y <- as_tibble(y, .name_repair = "universal")
   # })
 
   x_split <- dplyr_locate_sorted_groups(x)
@@ -76,12 +95,22 @@ equal_data_frame <- function(x, y, ignore_col_order = TRUE, ignore_row_order = T
   msg <- ""
   if (any(wrong <- !vec_in(x_split$key, y_split$key))) {
     rows <- sort(map_int(x_split$loc[which(wrong)], function(.x) .x[1L]))
-    msg <- paste0(msg, "- Rows in x but not in y: ", glue_collapse(rows, sep = ", "), "\n")
+    msg <- paste0(
+      msg,
+      "- Rows in x but not in y: ",
+      glue_collapse(rows, sep = ", "),
+      "\n"
+    )
   }
 
   if (any(wrong <- !vec_in(y_split$key, x_split$key))) {
     rows <- sort(map_int(y_split$loc[which(wrong)], function(.x) .x[1L]))
-    msg <- paste0(msg, "- Rows in y but not in x: ", glue_collapse(rows, sep = ", "), "\n")
+    msg <- paste0(
+      msg,
+      "- Rows in y but not in x: ",
+      glue_collapse(rows, sep = ", "),
+      "\n"
+    )
   }
   if (msg != "") {
     return(msg)
@@ -90,7 +119,8 @@ equal_data_frame <- function(x, y, ignore_col_order = TRUE, ignore_row_order = T
   # keys are identical, check that rows occur the same number of times
   if (any(wrong <- lengths(x_split$loc) != lengths(y_split$loc))) {
     rows <- sort(map_int(x_split$loc[which(wrong)], function(.x) .x[1L]))
-    return(paste0("- Rows with difference occurrences in x and y: ",
+    return(paste0(
+      "- Rows with difference occurrences in x and y: ",
       glue_collapse(rows, sep = ", "),
       "\n"
     ))

diff --git a/R/arrange.R b/R/arrange.R
@@ -85,10 +85,7 @@ arrange <- function(.data, ..., .by_group = FALSE) {
 
 #' @rdname arrange
 #' @export
-arrange.data.frame <- function(.data,
-                               ...,
-                               .by_group = FALSE,
-                               .locale = NULL) {
+arrange.data.frame <- function(.data, ..., .by_group = FALSE, .locale = NULL) {
   dots <- enquos(...)
 
   if (.by_group) {
@@ -101,10 +98,7 @@ arrange.data.frame <- function(.data,
 
 # Helpers -----------------------------------------------------------------
 
-arrange_rows <- function(data,
-                         dots,
-                         locale,
-                         error_call = caller_env()) {
+arrange_rows <- function(data, dots, locale, error_call = caller_env()) {
   dplyr_local_error_call(error_call)
 
   size <- nrow(data)
@@ -123,7 +117,10 @@ arrange_rows <- function(data,
     if (is_desc_call(dot)) {
       expr <- quo_get_expr(dot)
       if (!has_length(expr, 2L)) {
-        abort("`desc()` must be called with exactly one argument.", call = error_call)
+        abort(
+          "`desc()` must be called with exactly one argument.",
+          call = error_call
+        )
       }
 
       dot <- new_quosure(expr[[2]], quo_get_env(dot))
@@ -189,10 +186,12 @@ arrange_rows <- function(data,
   )
 }
 
-locale_to_chr_proxy_collate <- function(locale,
-                                        ...,
-                                        has_stringi = has_minimum_stringi(),
-                                        error_call = caller_env()) {
+locale_to_chr_proxy_collate <- function(
+  locale,
+  ...,
+  has_stringi = has_minimum_stringi(),
+  error_call = caller_env()
+) {
   check_dots_empty0(...)
 
   if (is.null(locale) || is_string(locale, string = "C")) {
@@ -201,13 +200,22 @@ locale_to_chr_proxy_collate <- function(locale,
 
   if (is_character(locale)) {
     if (!is_string(locale)) {
-      abort("If `.locale` is a character vector, it must be a single string.", call = error_call)
+      abort(
+        "If `.locale` is a character vector, it must be a single string.",
+        call = error_call
+      )
     }
     if (!has_stringi) {
-      abort("stringi >=1.5.3 is required to arrange in a different locale.", call = error_call)
+      abort(
+        "stringi >=1.5.3 is required to arrange in a different locale.",
+        call = error_call
+      )
     }
     if (!locale %in% stringi::stri_locale_list()) {
-      abort("`.locale` must be one of the locales within `stringi::stri_locale_list()`.", call = error_call)
+      abort(
+        "`.locale` must be one of the locales within `stringi::stri_locale_list()`.",
+        call = error_call
+      )
     }
 
     return(sort_key_generator(locale))
@@ -264,7 +272,13 @@ dplyr_proxy_order_legacy <- function(x, direction) {
     return(out)
   }
 
-  if (!is_character(x) && !is_logical(x) && !is_integer(x) && !is_double(x) && !is_complex(x)) {
+  if (
+    !is_character(x) &&
+      !is_logical(x) &&
+      !is_integer(x) &&
+      !is_double(x) &&
+      !is_complex(x)
+  ) {
     abort("Invalid type returned by `vec_proxy_order()`.", .internal = TRUE)
   }
 

diff --git a/R/bind-cols.R b/R/bind-cols.R
@@ -1,4 +1,3 @@
-
 #' Bind multiple data frames by column
 #'
 #' @description
@@ -25,7 +24,10 @@
 #'
 #' # Row sizes must be compatible when column-binding
 #' try(bind_cols(tibble(x = 1:3), tibble(y = 1:2)))
-bind_cols <- function(..., .name_repair = c("unique", "universal", "check_unique", "minimal")) {
+bind_cols <- function(
+  ...,
+  .name_repair = c("unique", "universal", "check_unique", "minimal")
+) {
   dots <- list2(...)
 
   dots <- list_flatten(dots, recursive = TRUE)
@@ -34,7 +36,11 @@ bind_cols <- function(..., .name_repair = c("unique", "universal", "check_unique
   # Strip names off of data frame components so that vec_cbind() unpacks them
   names2(dots)[map_lgl(dots, is.data.frame)] <- ""
 
-  out <- vec_cbind(!!!dots, .name_repair = .name_repair, .error_call = current_env())
+  out <- vec_cbind(
+    !!!dots,
+    .name_repair = .name_repair,
+    .error_call = current_env()
+  )
   if (!any(map_lgl(dots, is.data.frame))) {
     out <- as_tibble(out)
   }