diff --git a/.Rbuildignore b/.Rbuildignore index feedcc6d7..2f35b7cf3 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -18,3 +18,5 @@ ^tools$ ^revdep$ ^CRAN-SUBMISSION$ +^[.]?air[.]toml$ +^\.vscode$ diff --git a/.vscode/extensions.json b/.vscode/extensions.json new file mode 100644 index 000000000..344f76eba --- /dev/null +++ b/.vscode/extensions.json @@ -0,0 +1,5 @@ +{ + "recommendations": [ + "Posit.air-vscode" + ] +} diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 000000000..a9f69fe41 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,10 @@ +{ + "[r]": { + "editor.formatOnSave": true, + "editor.defaultFormatter": "Posit.air-vscode" + }, + "[quarto]": { + "editor.formatOnSave": true, + "editor.defaultFormatter": "quarto.quarto" + } +} diff --git a/R/batch-update-requests.R b/R/batch-update-requests.R index 07508256d..64bbce055 100644 --- a/R/batch-update-requests.R +++ b/R/batch-update-requests.R @@ -1,10 +1,12 @@ # https://developers.google.com/sheets/api/samples/formatting#format_a_header_row # returns: a wrapped instance of RepeatCellRequest -bureq_header_row <- function(row = 1, - sheetId = NULL, - backgroundColor = 0.92, - horizontalAlignment = "CENTER", - bold = TRUE) { +bureq_header_row <- function( + row = 1, + sheetId = NULL, + backgroundColor = 0.92, + horizontalAlignment = "CENTER", + bold = TRUE +) { row <- row - 1 # indices are zero-based; intervals are half open: [start, end) grid_range <- new( "GridRange", @@ -19,9 +21,9 @@ bureq_header_row <- function(row = 1, backgroundColor = new( "Color", # I want a shade of grey - red = backgroundColor, + red = backgroundColor, green = backgroundColor, - blue = backgroundColor + blue = backgroundColor ), textFormat = new( "TextFormat", @@ -35,30 +37,37 @@ bureq_header_row <- function(row = 1, # example: Color's other child, alpha fields <- "userEnteredFormat(horizontalAlignment,backgroundColor,textFormat)" - list(repeatCell = new( - "RepeatCellRequest", - range = grid_range, - cell = cell_data, - fields = fields - )) + list( + repeatCell = new( + "RepeatCellRequest", + range = grid_range, + cell = cell_data, + fields = fields + ) + ) } # based on this, except I clear everything by sending 'fields = "*"' # https://developers.google.com/sheets/api/samples/sheet#clear_a_sheet_of_all_values_while_preserving_formats # returns: a wrapped instance of RepeatCellRequest bureq_clear_sheet <- function(sheetId) { - list(repeatCell = new( - "RepeatCellRequest", - range = new("GridRange", sheetId = sheetId), - fields = "*" - )) + list( + repeatCell = new( + "RepeatCellRequest", + range = new("GridRange", sheetId = sheetId), + fields = "*" + ) + ) } # https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets/request#UpdateSheetPropertiesRequest -bureq_set_grid_properties <- function(sheetId, - nrow = NULL, ncol = NULL, - frozenRowCount = 1, - frozenColumnCount = NULL) { +bureq_set_grid_properties <- function( + sheetId, + nrow = NULL, + ncol = NULL, + frozenRowCount = 1, + frozenColumnCount = NULL +) { gp <- new("GridProperties", rowCount = nrow, columnCount = ncol) if (!is.null(frozenRowCount) && frozenRowCount > 0) { gp <- patch(gp, frozenRowCount = frozenRowCount) @@ -71,19 +80,23 @@ bureq_set_grid_properties <- function(sheetId, } sp <- new("SheetProperties", sheetId = sheetId, gridProperties = gp) - list(updateSheetProperties = new( - "UpdateSheetPropertiesRequest", - properties = sp, - fields = gargle::field_mask(sp) - )) + list( + updateSheetProperties = new( + "UpdateSheetPropertiesRequest", + properties = sp, + fields = gargle::field_mask(sp) + ) + ) } # https://developers.google.com/sheets/api/samples/rowcolumn#automatically_resize_a_column # https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets/request#AutoResizeDimensionsRequest -bureq_auto_resize_dimensions <- function(sheetId, - dimension = c("COLUMNS", "ROWS"), - start = NULL, - end = NULL) { +bureq_auto_resize_dimensions <- function( + sheetId, + dimension = c("COLUMNS", "ROWS"), + start = NULL, + end = NULL +) { dimension <- match.arg(dimension) # https://developers.google.com/sheets/api/reference/rest/v4/DimensionRange # A range along a single dimension on a sheet. All indexes are zero-based. @@ -102,8 +115,10 @@ bureq_auto_resize_dimensions <- function(sheetId, check_non_negative_integer(end) dimension_range <- patch(dimension_range, endIndex = end) } - list(autoResizeDimensions = new( - "AutoResizeDimensionsRequest", - dimensions = dimension_range - )) + list( + autoResizeDimensions = new( + "AutoResizeDimensionsRequest", + dimensions = dimension_range + ) + ) } diff --git a/R/ctype.R b/R/ctype.R index d6f56dcbb..d08646bbd 100644 --- a/R/ctype.R +++ b/R/ctype.R @@ -1,10 +1,11 @@ -## ctype = cell or column type -## most types are valid for a cell or a column -## however, a couple are valid only for cells or only for a column +# ctype = cell or column type +# most types are valid for a cell or a column +# however, a couple are valid only for cells or only for a column -## Type can be Type can be Type can be -## shortcode discovered guessed for imposed on -## = ctype from a cell a column a column +# Type can be Type can be Type can be +# shortcode discovered guessed for imposed on +# = ctype from a cell a column a column +# fmt: skip .ctypes <- c( `_` = "COL_SKIP", # -- no yes `-` = "COL_SKIP", @@ -22,12 +23,12 @@ `?` = "COL_GUESS" # -- -- -- ) -## TODO: add to above: -## CELL_DURATION -## COL_FACTOR +# TODO: add to above: +# CELL_DURATION +# COL_FACTOR -## this generic is "dumb": it only reports ctype -## it doesn't implement any logic about guessing, coercion, etc. +# this generic is "dumb": it only reports ctype +# it doesn't implement any logic about guessing, coercion, etc. ctype <- function(x, ...) { UseMethod("ctype") } @@ -63,9 +64,10 @@ ctype.default <- function(x, ...) { abort_unsupported_conversion(x, to = "ctype") } +# fmt: skip .discovered_to_effective_type <- c( - ## If discovered Then effective - ## cell type is: cell type is: + # If discovered Then effective + # cell type is: cell type is: CELL_BLANK = "CELL_BLANK", CELL_LOGICAL = "CELL_LOGICAL", CELL_INTEGER = "CELL_NUMERIC", ## integers are jsonlite being helpful @@ -76,24 +78,25 @@ ctype.default <- function(x, ...) { CELL_TEXT = "CELL_TEXT" ) -## input: cell type, presumably discovered -## output: effective cell type -## -## Where do we use this? -## * To choose cell-specific parser when col type is COL_LIST == "L" -## * Pre-processing cell types prior to forming a consensus for an entire -## column when col type is COL_GUESS = "?" -## This is the where we store type-guessing fiddliness that is specific to -## Google Sheets. +# input: cell type, presumably discovered +# output: effective cell type +# +# Where do we use this? +# * To choose cell-specific parser when col type is COL_LIST == "L" +# * Pre-processing cell types prior to forming a consensus for an entire +# column when col type is COL_GUESS = "?" +# This is the where we store type-guessing fiddliness that is specific to +# Google Sheets. effective_cell_type <- function(ctype) .discovered_to_effective_type[ctype] -## input: a ctype -## output: vector of ctypes that can hold such input with no data loss, going -## from most generic (list) to most specific (type of that cell) -## examples: -## CELL_LOGICAL --> COL_LIST, CELL_NUMERIC, CELL_INTEGER, CELL_LOGICAL -## CELL_DATE --> COL_LIST, CELL_DATETIME, CELL_DATE -## CELL_BLANK --> NULL +# input: a ctype +# output: vector of ctypes that can hold such input with no data loss, going +# from most generic (list) to most specific (type of that cell) +# examples: +# CELL_LOGICAL --> COL_LIST, CELL_NUMERIC, CELL_INTEGER, CELL_LOGICAL +# CELL_DATE --> COL_LIST, CELL_DATETIME, CELL_DATE +# CELL_BLANK --> NULL +# fmt: skip admissible_types <- function(x) { z <- c( CELL_LOGICAL = "CELL_INTEGER", @@ -116,16 +119,16 @@ admissible_types <- function(x) { c(admissible_types(z[[x[[1]]]]), x) } -## find the most specific ctype that is admissible for a pair of ctypes -## the limiting case is COL_LIST -## HOWEVER use ctypes that are good for cells, i.e. "two blanks make a blank" +# find the most specific ctype that is admissible for a pair of ctypes +# the limiting case is COL_LIST +# HOWEVER use ctypes that are good for cells, i.e. "two blanks make a blank" upper_type <- function(x, y) { upper_bound(admissible_types(x), admissible_types(y)) %||% "CELL_BLANK" } -## find the most specific ctype that is admissible for a set of ctypes -## HOWEVER use ctypes that are good for columns, i.e. "two blanks make a -## logical" +# find the most specific ctype that is admissible for a set of ctypes +# HOWEVER use ctypes that are good for columns, i.e. "two blanks make a +# logical" consensus_col_type <- function(ctype) { out <- Reduce(upper_type, unique(ctype), init = "CELL_BLANK") blank_to_logical(out) @@ -135,11 +138,11 @@ blank_to_logical <- function(ctype) { modify_if(ctype, ~ identical(.x, "CELL_BLANK"), ~"CELL_LOGICAL") } -## input: an instance of CellData -## https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets#CellData -## returns same, but applies a class vector: -## [1] a ctype, inspired by the CellType enum in readxl -## [2] SHEETS_CELL +# input: an instance of CellData +# https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets#CellData +# returns same, but applies a class vector: +# [1] a ctype, inspired by the CellType enum in readxl +# [2] SHEETS_CELL apply_ctype <- function(cell_list, na = "", trim_ws = TRUE) { ctypes <- map_chr(cell_list, infer_ctype, na = na, trim_ws = trim_ws) map2(cell_list, ctypes, ~ structure(.x, class = c(.y, "SHEETS_CELL"))) @@ -150,9 +153,10 @@ infer_ctype <- function(cell, na = "", trim_ws = TRUE) { # * cell is NULL or list() # * cell has no effectiveValue # * formattedValue matches an `na` string - if (length(cell) == 0 || - length(cell[["effectiveValue"]]) == 0 || - is_na_string(cell[["formattedValue"]], na = na, trim_ws = trim_ws) + if ( + length(cell) == 0 || + length(cell[["effectiveValue"]]) == 0 || + is_na_string(cell[["formattedValue"]], na = na, trim_ws = trim_ws) ) { return("CELL_BLANK") } @@ -160,15 +164,18 @@ infer_ctype <- function(cell, na = "", trim_ws = TRUE) { effective_type <- .extended_value[[names(cell[["effectiveValue"]])]] if (!identical(effective_type, "number")) { - return(switch(effective_type, + return(switch( + effective_type, error = "CELL_BLANK", string = "CELL_TEXT", boolean = "CELL_LOGICAL", formula = { - cli::cli_warn(" + cli::cli_warn( + " Internal warning from googlesheets4: \\ Cell has formula as effectiveValue. \\ - I thought this was impossible!") + I thought this was impossible!" + ) "CELL_TEXT" }, gs4_abort( @@ -181,17 +188,19 @@ infer_ctype <- function(cell, na = "", trim_ws = TRUE) { nf_type <- pluck( cell, - "effectiveFormat", "numberFormat", "type", - ## in theory, should consult hosting spreadsheet for a default format - ## if that's absent, should consult locale (of spreadsheet? user? unclear) - ## for now, I punt on this + "effectiveFormat", + "numberFormat", + "type", + # in theory, should consult hosting spreadsheet for a default format + # if that's absent, should consult locale (of spreadsheet? user? unclear) + # for now, I punt on this .default = "NUMBER" ) .number_types[[nf_type]] } -## userEnteredValue and effectiveValue hold an instance of ExtendedValue -## https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets#ExtendedValue +# userEnteredValue and effectiveValue hold an instance of ExtendedValue +# https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets#ExtendedValue # { # // Union field value can be only one of the following: # "numberValue": number, @@ -203,6 +212,7 @@ infer_ctype <- function(cell, na = "", trim_ws = TRUE) { # }, # // End of list of possible types for union field value. # } +# fmt: skip .extended_value <- c( numberValue = "number", stringValue = "string", @@ -211,14 +221,15 @@ infer_ctype <- function(cell, na = "", trim_ws = TRUE) { errorValue = "error" ) +# fmt: skip .number_types <- c( TEXT = "CELL_NUMERIC", NUMBER = "CELL_NUMERIC", PERCENT = "CELL_NUMERIC", CURRENCY = "CELL_NUMERIC", SCIENTIFIC = "CELL_NUMERIC", - ## on the R side, all of the above are treated as numeric - ## no current reason to distinguish them, for col type guessing or coercion + # on the R side, all of the above are treated as numeric + # no current reason to distinguish them, for col type guessing or coercion DATE = "CELL_DATE", TIME = "CELL_TIME", DATE_TIME = "CELL_DATETIME" @@ -232,13 +243,13 @@ is_na_string <- function(x, na = "", trim_ws = TRUE) { any(fv == na) } -## compares x[i] to y[i] and returns the last element where they are equal -## example: -## upper_bound(c("a", "b"), c("a", "b", "c")) is "b" +# compares x[i] to y[i] and returns the last element where they are equal +# example: +# upper_bound(c("a", "b"), c("a", "b", "c")) is "b" upper_bound <- function(x, y) { nx <- length(x) ny <- length(y) - ## these brackets make covr happy + # these brackets make covr happy if (nx + ny == 0) { return() } @@ -249,8 +260,8 @@ upper_bound <- function(x, y) { return(x[[nx]]) } comp <- seq_len(min(nx, ny)) - ## TODO: if our DAG were more complicated, I think this would need to be - ## based on a set operation + # TODO: if our DAG were more complicated, I think this would need to be + # based on a set operation res <- x[comp] == y[comp] if (!any(res)) { return() diff --git a/R/get_cells.R b/R/get_cells.R index 2b96223df..dfbd647d4 100644 --- a/R/get_cells.R +++ b/R/get_cells.R @@ -1,12 +1,15 @@ ## this is the "cell getter" for range_read_cells() and read_sheet() -get_cells <- function(ss, - sheet = NULL, - range = NULL, - col_names_in_sheet = TRUE, - skip = 0, n_max = Inf, - detail_level = c("default", "full"), - discard_empty = TRUE, - call = caller_env()) { +get_cells <- function( + ss, + sheet = NULL, + range = NULL, + col_names_in_sheet = TRUE, + skip = 0, + n_max = Inf, + detail_level = c("default", "full"), + discard_empty = TRUE, + call = caller_env() +) { ssid <- as_sheets_id(ss) maybe_sheet(sheet, call = call) @@ -26,8 +29,10 @@ get_cells <- function(ss, ## user's range, sheet, skip --> qualified A1 range, suitable for API range_spec <- as_range_spec( range, - sheet = sheet, skip = skip, - sheets_df = x$sheets, nr_df = x$named_ranges + sheet = sheet, + skip = skip, + sheets_df = x$sheets, + nr_df = x$named_ranges ) # if we send no range, we get all cells from all sheets; not what we want effective_range <- as_A1_range(range_spec) %||% first_visible_name(x$sheets) @@ -69,21 +74,25 @@ get_cells <- function(ss, # I want a separate worker so there is a version of this available that # accepts `fields` (or `includeGridData`), yet I don't want a user-facing # function that exposes those details -read_cells_impl_ <- function(ssid, - ranges, - fields = NULL, - detail_level = c("default", "full")) { +read_cells_impl_ <- function( + ssid, + ranges, + fields = NULL, + detail_level = c("default", "full") +) { # there are 2 ways to control the level of detail re: cell data: # 1. Supply a field mask. What we currently do. # 2. Set `includeGridData` to true. This gets *everything* about the # Spreadsheet and the Sheet(s). So far, this seems like TMI. detail_level <- match.arg(detail_level) - cell_mask <- switch(detail_level, + cell_mask <- switch( + detail_level, "default" = ".values(effectiveValue,formattedValue,effectiveFormat.numberFormat)", "full" = "" ) default_fields <- c( - "spreadsheetId", "properties.title", + "spreadsheetId", + "properties.title", "sheets.properties(sheetId,title)", glue("sheets.data(startRow,startColumn,rowData{cell_mask})") ) @@ -145,14 +154,14 @@ insert_shims <- function(df, cell_limits) { ## 1-based indices, referring to cell coordinates in the spreadsheet start_row <- cell_limits$ul[[1]] - end_row <- cell_limits$lr[[1]] + end_row <- cell_limits$lr[[1]] start_col <- cell_limits$ul[[2]] - end_col <- cell_limits$lr[[2]] + end_col <- cell_limits$lr[[2]] - shim_up <- notNA(start_row) && start_row < min(df$row) - shim_left <- notNA(start_col) && start_col < min(df$col) - shim_down <- notNA(end_row) && end_row > max(df$row) - shim_right <- notNA(end_col) && end_col > max(df$col) + shim_up <- notNA(start_row) && start_row < min(df$row) + shim_left <- notNA(start_col) && start_col < min(df$col) + shim_down <- notNA(end_row) && end_row > max(df$row) + shim_right <- notNA(end_col) && end_col > max(df$col) ## add placeholder to establish upper left corner if (shim_up || shim_left) { diff --git a/R/gs4_auth.R b/R/gs4_auth.R index e1da4eb44..19e973691 100644 --- a/R/gs4_auth.R +++ b/R/gs4_auth.R @@ -7,11 +7,11 @@ ## The roxygen comments for these functions are mostly generated from data ## in this list and template text maintained in gargle. gargle_lookup_table <- list( - PACKAGE = "googlesheets4", - YOUR_STUFF = "your Google Sheets", - PRODUCT = "Google Sheets", - API = "Sheets API", - PREFIX = "gs4" + PACKAGE = "googlesheets4", + YOUR_STUFF = "your Google Sheets", + PRODUCT = "Google Sheets", + API = "Sheets API", + PREFIX = "gs4" ) #' Authorize googlesheets4 @@ -55,12 +55,15 @@ gargle_lookup_table <- list( #' #' # use a service account token #' gs4_auth(path = "foofy-83ee9e7c9c48.json") -gs4_auth <- function(email = gargle::gargle_oauth_email(), - path = NULL, subject = NULL, - scopes = "spreadsheets", - cache = gargle::gargle_oauth_cache(), - use_oob = gargle::gargle_oob_default(), - token = NULL) { +gs4_auth <- function( + email = gargle::gargle_oauth_email(), + path = NULL, + subject = NULL, + scopes = "spreadsheets", + cache = gargle::gargle_oauth_cache(), + use_oob = gargle::gargle_oob_default(), + token = NULL +) { gargle::check_is_service_account(path, hint = "gs4_auth_configure") scopes <- gs4_scopes(scopes) @@ -198,7 +201,9 @@ gs4_auth_configure <- function(client, path, api_key, app = deprecated()) { } if (!missing(client) && !missing(path)) { - gs4_abort("Must supply exactly one of {.arg client} and {.arg path}, not both.") + gs4_abort( + "Must supply exactly one of {.arg client} and {.arg path}, not both." + ) } stopifnot(missing(api_key) || is.null(api_key) || is_string(api_key)) @@ -206,7 +211,11 @@ gs4_auth_configure <- function(client, path, api_key, app = deprecated()) { stopifnot(is_string(path)) client <- gargle::gargle_oauth_client_from_json(path) } - stopifnot(missing(client) || is.null(client) || inherits(client, "gargle_oauth_client")) + stopifnot( + missing(client) || + is.null(client) || + inherits(client, "gargle_oauth_client") + ) if (!missing(client) || !missing(path)) { .auth$set_client(client) @@ -304,11 +313,11 @@ gs4_scopes <- function(scopes = NULL) { } sheets_scopes <- c( - spreadsheets = "https://www.googleapis.com/auth/spreadsheets", + spreadsheets = "https://www.googleapis.com/auth/spreadsheets", spreadsheets.readonly = "https://www.googleapis.com/auth/spreadsheets.readonly", - drive = "https://www.googleapis.com/auth/drive", - drive.readonly = "https://www.googleapis.com/auth/drive.readonly", - drive.file = "https://www.googleapis.com/auth/drive.file" + drive = "https://www.googleapis.com/auth/drive", + drive.readonly = "https://www.googleapis.com/auth/drive.readonly", + drive.file = "https://www.googleapis.com/auth/drive.file" ) resolve_scopes <- function(user_scopes, package_scopes) { @@ -317,9 +326,11 @@ resolve_scopes <- function(user_scopes, package_scopes) { } # unexported helpers that are nice for internal use ---- -gs4_auth_internal <- function(account = c("docs", "testing"), - scopes = NULL, - drive = TRUE) { +gs4_auth_internal <- function( + account = c("docs", "testing"), + scopes = NULL, + drive = TRUE +) { account <- match.arg(account) can_decrypt <- gargle::secret_has_key("GOOGLESHEETS4_KEY") online <- !is.null(curl::nslookup("sheets.googleapis.com", error = FALSE)) @@ -331,15 +342,20 @@ gs4_auth_internal <- function(account = c("docs", "testing"), c("x" = "Can't decrypt the {.field {account}} service account token.") }, if (!online) { - c("x" = "We don't appear to be online. Or maybe the Sheets API is down?") + c( + "x" = "We don't appear to be online. Or maybe the Sheets API is down?" + ) } ), class = "googlesheets4_auth_internal_error", - can_decrypt = can_decrypt, online = online + can_decrypt = can_decrypt, + online = online ) } - if (!is_interactive()) local_gs4_quiet() + if (!is_interactive()) { + local_gs4_quiet() + } filename <- glue("googlesheets4-{account}.json") # TODO: revisit when I do PKG_scopes() # https://github.com/r-lib/gargle/issues/103 @@ -399,8 +415,9 @@ local_deauth <- function(env = parent.frame()) { #' @export gs4_oauth_app <- function() { lifecycle::deprecate_warn( - "1.1.0", "gs4_oauth_app()", "gs4_oauth_client()" + "1.1.0", + "gs4_oauth_app()", + "gs4_oauth_client()" ) gs4_oauth_client() } - diff --git a/R/gs4_create.R b/R/gs4_create.R index 0134d77ab..7c1a0a88b 100644 --- a/R/gs4_create.R +++ b/R/gs4_create.R @@ -57,9 +57,9 @@ #' gs4_find("gs4-create-demo") %>% #' googledrive::drive_trash() gs4_create <- function(name = gs4_random(), ..., sheets = NULL) { - sheets <- enlist_sheets(enquo(sheets)) + sheets <- enlist_sheets(enquo(sheets)) sheets_given <- !is.null(sheets) - data_given <- sheets_given && !is.null(unlist(sheets$value)) + data_given <- sheets_given && !is.null(unlist(sheets$value)) # create the (spread)Sheet --------------------------------------------------- gs4_bullets(c(v = "Creating new Sheet: {.s_sheet {name}}.")) @@ -114,17 +114,21 @@ prepare_df <- function(sheet_id, df, skip = 0) { if (skip > 0) { start <- patch(start, rowIndex = skip) } - request_values <- list(updateCells = new( - "UpdateCellsRequest", - start = start, - rows = as_RowData(df), # an array of instances of RowData - fields = "userEnteredValue,userEnteredFormat" - )) + request_values <- list( + updateCells = new( + "UpdateCellsRequest", + start = start, + rows = as_RowData(df), # an array of instances of RowData + fields = "userEnteredValue,userEnteredFormat" + ) + ) # set sheet dimensions and freeze top row ------------------------------------- request_sheet_properties <- bureq_set_grid_properties( sheetId = sheet_id, - nrow = nrow(df) + skip + 1, ncol = ncol(df), frozenRowCount = skip + 1 + nrow = nrow(df) + skip + 1, + ncol = ncol(df), + frozenRowCount = skip + 1 ) c( diff --git a/R/gs4_example.R b/R/gs4_example.R index 39b9206ba..75e91faad 100644 --- a/R/gs4_example.R +++ b/R/gs4_example.R @@ -30,8 +30,8 @@ NULL #' @export gs4_examples <- function(matches) { many_sheets( - needle = matches, - haystack = example_and_test_sheets("example"), + needle = matches, + haystack = example_and_test_sheets("example"), adjective = "example" ) } @@ -40,8 +40,8 @@ gs4_examples <- function(matches) { #' @export gs4_example <- function(matches) { one_sheet( - needle = matches, - haystack = example_and_test_sheets("example"), + needle = matches, + haystack = example_and_test_sheets("example"), adjective = "example" ) } @@ -55,7 +55,8 @@ many_sheets <- function(needle, haystack, adjective, call = caller_env()) { if (!any(sel)) { gs4_abort( "Can't find {adjective} Sheet that matches {.q {needle}}.", - call = call) + call = call + ) } out <- as_id(out[sel]) } @@ -89,7 +90,8 @@ example_and_test_sheets <- function(purpose = NULL) { if (!env_has(.googlesheets4, "example_and_test_sheets")) { inventory_id <- "1dSIZ2NkEPDWiEbsg9G80Hr9Xe7HZglEAPwGhVa-OSyA" local_gs4_quiet() - if (!gs4_has_token()) { # don't trigger auth just for this + if (!gs4_has_token()) { + # don't trigger auth just for this local_deauth() } dat <- read_sheet(as_sheets_id(inventory_id)) @@ -107,16 +109,16 @@ example_and_test_sheets <- function(purpose = NULL) { # test sheet management ---- test_sheets <- function(matches) { many_sheets( - needle = matches, - haystack = example_and_test_sheets("test"), + needle = matches, + haystack = example_and_test_sheets("test"), adjective = "test" ) } test_sheet <- function(matches = "googlesheets4-cell-tests") { one_sheet( - needle = matches, - haystack = example_and_test_sheets("test"), + needle = matches, + haystack = example_and_test_sheets("test"), adjective = "test" ) } @@ -127,9 +129,11 @@ test_sheet_create <- function(name = "googlesheets4-cell-tests") { user <- gs4_user() if (!grepl("^googlesheets4-sheet-keeper", user)) { user <- sub("@.+$", "", user) - gs4_abort(" + gs4_abort( + " Must be auth'd as {.email googlesheets4-sheet-keeper}, \\ - not {.email {user}}.") + not {.email {user}}." + ) } existing <- gs4_find() @@ -146,7 +150,9 @@ test_sheet_create <- function(name = "googlesheets4-cell-tests") { ssid <- as_sheets_id(ss) # it's fiddly to check current sharing status, so just re-share - gs4_bullets(c(v = 'Making sure "anyone with a link" can read {.s_sheet {name}}.')) + gs4_bullets(c( + v = 'Making sure "anyone with a link" can read {.s_sheet {name}}.' + )) gs4_share(ssid) ssid } diff --git a/R/gs4_formula.R b/R/gs4_formula.R index 468271a7f..2fd6aaebc 100644 --- a/R/gs4_formula.R +++ b/R/gs4_formula.R @@ -73,9 +73,13 @@ vec_ptype2.googlesheets4_formula <- function(x, y, ...) { #' @method vec_ptype2.googlesheets4_formula default #' @export -vec_ptype2.googlesheets4_formula.default <- function(x, y, - ..., - x_arg = "x", y_arg = "y") { +vec_ptype2.googlesheets4_formula.default <- function( + x, + y, + ..., + x_arg = "x", + y_arg = "y" +) { vec_default_ptype2(x, y, x_arg = x_arg, y_arg = y_arg) } diff --git a/R/gs4_get.R b/R/gs4_get.R index 5ad1c181b..ef7032cb9 100644 --- a/R/gs4_get.R +++ b/R/gs4_get.R @@ -22,9 +22,9 @@ gs4_get <- function(ss) { ## I want a separate worker so there is a version of this available that ## accepts `fields`, yet I don't want a user-facing function with `fields` arg -gs4_get_impl_ <- function(ssid, - fields = NULL) { - fields <- fields %||% "spreadsheetId,properties,spreadsheetUrl,sheets.properties,sheets.protectedRanges,namedRanges" +gs4_get_impl_ <- function(ssid, fields = NULL) { + fields <- fields %||% + "spreadsheetId,properties,spreadsheetUrl,sheets.properties,sheets.protectedRanges,namedRanges" req <- request_generate( "sheets.spreadsheets.get", params = list( diff --git a/R/gs4_share.R b/R/gs4_share.R index f1cfdc2d4..514d20ac8 100644 --- a/R/gs4_share.R +++ b/R/gs4_share.R @@ -14,13 +14,18 @@ # gs4_share(ss) # gs4_share(ss, type = "user", emailAddress = "jane@example.com") # gs4_share(ss, type = "user", emailAddress = "jane@example.com", role = "writer") -gs4_share <- function(ss, - ..., - role = c( - "reader", "commenter", "writer", - "owner", "organizer" - ), - type = c("anyone", "user", "group", "domain")) { +gs4_share <- function( + ss, + ..., + role = c( + "reader", + "commenter", + "writer", + "owner", + "organizer" + ), + type = c("anyone", "user", "group", "domain") +) { check_gs4_email_is_drive_email() role <- match.arg(role) type <- match.arg(type) diff --git a/R/make_column.R b/R/make_column.R index 44a1ccc94..0e40851c6 100644 --- a/R/make_column.R +++ b/R/make_column.R @@ -7,11 +7,12 @@ make_column <- function(df, ctype, ..., nr, guess_max = min(1000, nr)) { return() } fodder <- rep_len(NA, length.out = nr) - column <- switch(ctype, + column <- switch( + ctype, ## NAs must be numeric in order to initialize datetimes with a timezone - CELL_DATE = as_Date(as.numeric(fodder)), + CELL_DATE = as_Date(as.numeric(fodder)), ## TODO: time of day not really implemented yet - CELL_TIME = as_POSIXct(as.numeric(fodder)), + CELL_TIME = as_POSIXct(as.numeric(fodder)), CELL_DATETIME = as_POSIXct(as.numeric(fodder)), COL_LIST = vector(mode = "list", length = nr), as.vector(fodder, mode = typeof(parsed)) @@ -36,7 +37,9 @@ resolve_col_type <- function(cell, ctype = "COL_GUESS") { gs4_parse <- function(x, ctype, ...) { stopifnot(is_string(ctype)) - parse_fun <- switch(ctype, + # fmt: skip + parse_fun <- switch( + ctype, COL_SKIP = as_skip, CELL_LOGICAL = as_logical, CELL_INTEGER = as_integer, @@ -73,7 +76,8 @@ as_list <- function(cell, ...) { ## prepare to coerce to logical, integer, double cell_content <- function(cell, na = "", trim_ws = TRUE) { - switch(ctype(cell), + switch( + ctype(cell), CELL_BLANK = NA, CELL_LOGICAL = pluck(cell, "effectiveValue", "boolValue"), CELL_NUMERIC = pluck(cell, "effectiveValue", "numberValue"), @@ -106,7 +110,8 @@ as_double <- function(cell, na = "", trim_ws = TRUE) { ## prepare to coerce to date, time, datetime cell_content_datetime <- function(cell, na = "", trim_ws = TRUE) { - switch(ctype(cell), + switch( + ctype(cell), CELL_BLANK = NA, CELL_LOGICAL = NA, CELL_NUMERIC = NA, @@ -141,7 +146,6 @@ as_date <- function(cell, na = "", trim_ws = TRUE) { # as_POSIXct() # } - ## prepare to coerce to character cell_content_chr <- function(cell, na = "", trim_ws = TRUE) { fv <- pluck(cell, "formattedValue", .default = NA_character_) diff --git a/R/range_add_named.R b/R/range_add_named.R index b8134407c..744080dad 100644 --- a/R/range_add_named.R +++ b/R/range_add_named.R @@ -25,10 +25,7 @@ #' # clean up #' gs4_find("range-add-named-demo") %>% #' googledrive::drive_trash() -range_add_named <- function(ss, - name, - sheet = NULL, - range = NULL) { +range_add_named <- function(ss, name, sheet = NULL, range = NULL) { ssid <- as_sheets_id(ss) name <- check_string(name) maybe_sheet(sheet) @@ -41,15 +38,19 @@ range_add_named <- function(ss, range_spec <- as_range_spec( range, sheet = sheet, - sheets_df = x$sheets, nr_df = x$named_ranges + sheets_df = x$sheets, + nr_df = x$named_ranges ) - range_spec$sheet_name <- range_spec$sheet_name %||% first_visible_name(x$sheets) + range_spec$sheet_name <- range_spec$sheet_name %||% + first_visible_name(x$sheets) # form batch update request -------------------------------------------------- - req <- list(addNamedRange = new( - "AddNamedRangeRequest", - namedRange = as_NamedRange(range_spec, name = name) - )) + req <- list( + addNamedRange = new( + "AddNamedRangeRequest", + namedRange = as_NamedRange(range_spec, name = name) + ) + ) # do it ---------------------------------------------------------------------- req <- request_generate( @@ -68,7 +69,9 @@ range_add_named <- function(ss, reply <- as.list(as_tibble(reply)) reply$sheet_name <- vlookup( reply$sheet_id, - data = x$sheets, key = "id", value = "name" + data = x$sheets, + key = "id", + value = "name" ) A1_range <- qualified_A1(reply$sheet_name, do.call(make_cell_range, reply)) gs4_bullets(c( diff --git a/R/range_add_protection.R b/R/range_add_protection.R index 7a6f35cc1..3dd18c511 100644 --- a/R/range_add_protection.R +++ b/R/range_add_protection.R @@ -103,9 +103,7 @@ #' # clean up #' gs4_find("range-add-protection-example") %>% #' googledrive::drive_trash() -range_add_protection <- function(ss, - sheet = NULL, - range = NULL, ...) { +range_add_protection <- function(ss, sheet = NULL, range = NULL, ...) { ssid <- as_sheets_id(ss) maybe_sheet(sheet) check_range(range) @@ -117,10 +115,12 @@ range_add_protection <- function(ss, range_spec <- as_range_spec( range, sheet = sheet, - sheets_df = x$sheets, nr_df = x$named_ranges + sheets_df = x$sheets, + nr_df = x$named_ranges ) if (is.null(range_spec$named_range)) { - range_spec$sheet_name <- range_spec$sheet_name %||% first_visible_name(x$sheets) + range_spec$sheet_name <- range_spec$sheet_name %||% + first_visible_name(x$sheets) gs4_bullets(c( v = "Protecting cells on sheet: {.w_sheet {range_spec$sheet_name}}." )) @@ -131,10 +131,12 @@ range_add_protection <- function(ss, } # form batch update request -------------------------------------------------- - prot_req <- list(addProtectedRange = new( - "AddProtectedRangeRequest", - protectedRange = new_ProtectedRange(range_spec, ...) - )) + prot_req <- list( + addProtectedRange = new( + "AddProtectedRangeRequest", + protectedRange = new_ProtectedRange(range_spec, ...) + ) + ) # do it ---------------------------------------------------------------------- req <- request_generate( @@ -157,7 +159,12 @@ new_ProtectedRange <- function(range_spec, ...) { } else { out <- new( "ProtectedRange", - namedRangeId = vlookup(range_spec$named_range, range_spec$nr_df, "name", "id") + namedRangeId = vlookup( + range_spec$named_range, + range_spec$nr_df, + "name", + "id" + ) ) } out <- patch(out, editors = new("Editors", domainUsersCanEdit = FALSE)) @@ -177,11 +184,13 @@ range_update_protection <- function(ss, ...) { # I have no idea why this is necessary, but it's the only way I've been able # to updated editors mask <- sub("editors.users", "editors", mask) - prot_req <- list(updateProtectedRange = new( - "UpdateProtectedRangeRequest", - protectedRange = protected_range, - fields = mask - )) + prot_req <- list( + updateProtectedRange = new( + "UpdateProtectedRangeRequest", + protectedRange = protected_range, + fields = mask + ) + ) # do it ---------------------------------------------------------------------- req <- request_generate( @@ -204,10 +213,12 @@ range_delete_protection <- function(ss, id) { gs4_bullets(c(v = "Editing {.s_sheet {x$name}}.")) # form batch update request -------------------------------------------------- - prot_req <- list(deleteProtectedRange = new( - "DeleteProtectedRangeRequest", - protectedRangeId = id - )) + prot_req <- list( + deleteProtectedRange = new( + "DeleteProtectedRangeRequest", + protectedRangeId = id + ) + ) # do it ---------------------------------------------------------------------- req <- request_generate( diff --git a/R/range_add_validation.R b/R/range_add_validation.R index 9a4c113ed..7bdeade49 100644 --- a/R/range_add_validation.R +++ b/R/range_add_validation.R @@ -73,10 +73,7 @@ #' # clean up #' gs4_find("range-add-validation-demo") %>% #' googledrive::drive_trash() -range_add_validation <- function(ss, - sheet = NULL, - range = NULL, - rule) { +range_add_validation <- function(ss, sheet = NULL, range = NULL, rule) { ssid <- as_sheets_id(ss) maybe_sheet(sheet) check_range(range) @@ -91,18 +88,22 @@ range_add_validation <- function(ss, range_spec <- as_range_spec( range, sheet = sheet, - sheets_df = x$sheets, nr_df = x$named_ranges + sheets_df = x$sheets, + nr_df = x$named_ranges ) - range_spec$sheet_name <- range_spec$sheet_name %||% first_visible_name(x$sheets) + range_spec$sheet_name <- range_spec$sheet_name %||% + first_visible_name(x$sheets) s <- lookup_sheet(range_spec$sheet_name, sheets_df = x$sheets) gs4_bullets(c(v = "Editing sheet {.w_sheet {range_spec$sheet_name}}.")) # form batch update request -------------------------------------------------- - sdv_req <- list(setDataValidation = new( - "SetDataValidationRequest", - range = as_GridRange(range_spec), - rule = rule - )) + sdv_req <- list( + setDataValidation = new( + "SetDataValidationRequest", + range = as_GridRange(range_spec), + rule = rule + ) + ) # do it ---------------------------------------------------------------------- req <- request_generate( @@ -132,7 +133,10 @@ new_BooleanCondition <- function(type = "NOT_BLANK", values = NULL) { } needs_relative_date <- c( - "DATE_BEFORE", "DATE_AFTER", "DATE_ON_OR_BEFORE", "DATE_ON_OR_AFTER" + "DATE_BEFORE", + "DATE_AFTER", + "DATE_ON_OR_BEFORE", + "DATE_ON_OR_AFTER" ) if (type %in% needs_relative_date) { gs4_abort( diff --git a/R/range_autofit.R b/R/range_autofit.R index fc4ca68b4..3d1d5a54e 100644 --- a/R/range_autofit.R +++ b/R/range_autofit.R @@ -53,10 +53,12 @@ #' # clean up #' gs4_find("range-autofit-demo") %>% #' googledrive::drive_trash() -range_autofit <- function(ss, - sheet = NULL, - range = NULL, - dimension = c("columns", "rows")) { +range_autofit <- function( + ss, + sheet = NULL, + range = NULL, + dimension = c("columns", "rows") +) { ssid <- as_sheets_id(ss) maybe_sheet(sheet) check_range(range) @@ -67,23 +69,29 @@ range_autofit <- function(ss, range_spec <- as_range_spec( range, sheet = sheet, - sheets_df = x$sheets, nr_df = x$named_ranges + sheets_df = x$sheets, + nr_df = x$named_ranges ) - range_spec$sheet_name <- range_spec$sheet_name %||% first_visible_name(x$sheets) + range_spec$sheet_name <- range_spec$sheet_name %||% + first_visible_name(x$sheets) s <- lookup_sheet(range_spec$sheet_name, sheets_df = x$sheets) # form request --------------------------------------------------------------- if (is.null(range)) { dimension <- match.arg(dimension) resize_req <- list(bureq_auto_resize_dimensions( - sheetId = s$id, dimension = toupper(dimension) + sheetId = s$id, + dimension = toupper(dimension) )) } else { resize_req <- prepare_auto_resize_request(s$id, range_spec) } resize_dim <- pluck( resize_req, - 1, "autoResizeDimensions", "dimensions", "dimension" + 1, + "autoResizeDimensions", + "dimensions", + "dimension" ) gs4_bullets(c( diff --git a/R/range_delete.R b/R/range_delete.R index f6091f5b9..c434ea99f 100644 --- a/R/range_delete.R +++ b/R/range_delete.R @@ -51,10 +51,7 @@ #' # clean up #' gs4_find("range-delete-example") %>% #' googledrive::drive_trash() -range_delete <- function(ss, - sheet = NULL, - range, - shift = NULL) { +range_delete <- function(ss, sheet = NULL, range, shift = NULL) { ssid <- as_sheets_id(ss) maybe_sheet(sheet) check_range(range) @@ -63,10 +60,7 @@ range_delete <- function(ss, shift_dimension <- NULL } else { shift <- match.arg(shift, c("up", "left")) - shift_dimension <- switch(shift, - up = "ROWS", - left = "COLUMNS" - ) + shift_dimension <- switch(shift, up = "ROWS", left = "COLUMNS") } x <- gs4_get(ssid) @@ -76,15 +70,19 @@ range_delete <- function(ss, range_spec <- as_range_spec( range, sheet = sheet, - sheets_df = x$sheets, nr_df = x$named_ranges + sheets_df = x$sheets, + nr_df = x$named_ranges ) if (is.null(range_spec$cell_range) && is.null(range_spec$cell_limits)) { gs4_abort("{.fun range_delete} requires a cell range.") } - range_spec$sheet_name <- range_spec$sheet_name %||% first_visible_name(x$sheets) + range_spec$sheet_name <- range_spec$sheet_name %||% + first_visible_name(x$sheets) # as_GridRange() throws an error for a named range grid_range <- as_GridRange(range_spec) - gs4_bullets(c(v = "Deleting cells in sheet {.w_sheet {range_spec$sheet_name}}.")) + gs4_bullets(c( + v = "Deleting cells in sheet {.w_sheet {range_spec$sheet_name}}." + )) # form batch update request -------------------------------------------------- shift_dimension <- shift_dimension %||% determine_shift(grid_range) @@ -96,11 +94,13 @@ range_delete <- function(ss, } # form batch update request -------------------------------------------------- - delete_req <- list(deleteRange = new( - "DeleteRangeRequest", - range = grid_range, - shiftDimension = shift_dimension - )) + delete_req <- list( + deleteRange = new( + "DeleteRangeRequest", + range = grid_range, + shiftDimension = shift_dimension + ) + ) # do it ---------------------------------------------------------------------- req <- request_generate( @@ -121,15 +121,18 @@ determine_shift <- function(gr, call = caller_env()) { bounded_on_bottom <- !is.null(gr$endRowIndex) && notNA(gr$endRowIndex) bounded_on_right <- !is.null(gr$endColumnIndex) && notNA(gr$endColumnIndex) - if (bounded_on_bottom && bounded_on_right) { # user must specify shift + if (bounded_on_bottom && bounded_on_right) { + # user must specify shift return(NULL) } - if (bounded_on_bottom) { # and not bounded_on_right + if (bounded_on_bottom) { + # and not bounded_on_right return("ROWS") } - if (bounded_on_right) { # and not bounded_on_bottom + if (bounded_on_right) { + # and not bounded_on_bottom return("COLUMNS") } diff --git a/R/range_flood.R b/R/range_flood.R index 26c65b717..c6b1562bb 100644 --- a/R/range_flood.R +++ b/R/range_flood.R @@ -55,11 +55,13 @@ #' # clean up #' gs4_find("range-flood-demo") %>% #' googledrive::drive_trash() -range_flood <- function(ss, - sheet = NULL, - range = NULL, - cell = NULL, - reformat = TRUE) { +range_flood <- function( + ss, + sheet = NULL, + range = NULL, + cell = NULL, + reformat = TRUE +) { ssid <- as_sheets_id(ss) maybe_sheet(sheet) check_range(range) @@ -72,9 +74,11 @@ range_flood <- function(ss, range_spec <- as_range_spec( range, sheet = sheet, - sheets_df = x$sheets, nr_df = x$named_ranges + sheets_df = x$sheets, + nr_df = x$named_ranges ) - range_spec$sheet_name <- range_spec$sheet_name %||% first_visible_name(x$sheets) + range_spec$sheet_name <- range_spec$sheet_name %||% + first_visible_name(x$sheets) s <- lookup_sheet(range_spec$sheet_name, sheets_df = x$sheets) gs4_bullets(c(v = "Editing sheet {.w_sheet {range_spec$sheet_name}}.")) @@ -84,16 +88,22 @@ range_flood <- function(ss, fields <- gargle::field_mask(cell) } else { cell <- as_CellData(cell %||% NA)[[1]] - fields <- if (reformat) "userEnteredValue,userEnteredFormat" else "userEnteredValue" + fields <- if (reformat) { + "userEnteredValue,userEnteredFormat" + } else { + "userEnteredValue" + } } # form batch update request -------------------------------------------------- - repeat_req <- list(repeatCell = new( - "RepeatCellRequest", - range = as_GridRange(range_spec), - cell = cell, - fields = fields - )) + repeat_req <- list( + repeatCell = new( + "RepeatCellRequest", + range = as_GridRange(range_spec), + cell = cell, + fields = fields + ) + ) # do it ---------------------------------------------------------------------- req <- request_generate( @@ -111,10 +121,7 @@ range_flood <- function(ss, #' @rdname range_flood #' @export -range_clear <- function(ss, - sheet = NULL, - range = NULL, - reformat = TRUE) { +range_clear <- function(ss, sheet = NULL, range = NULL, reformat = TRUE) { range_flood( ss = ss, sheet = sheet, diff --git a/R/range_read.R b/R/range_read.R index c946147e5..2a23e112e 100644 --- a/R/range_read.R +++ b/R/range_read.R @@ -85,14 +85,19 @@ #' range = "A:D", #' col_types = "ccid" #' ) -range_read <- function(ss, - sheet = NULL, - range = NULL, - col_names = TRUE, col_types = NULL, - na = "", trim_ws = TRUE, - skip = 0, n_max = Inf, - guess_max = min(1000, n_max), - .name_repair = "unique") { +range_read <- function( + ss, + sheet = NULL, + range = NULL, + col_names = TRUE, + col_types = NULL, + na = "", + trim_ws = TRUE, + skip = 0, + n_max = Inf, + guess_max = min(1000, n_max), + .name_repair = "unique" +) { # check these first, so we don't download cells in vain col_spec <- standardise_col_spec(col_names, col_types, call = current_env()) check_character(na) @@ -103,14 +108,19 @@ range_read <- function(ss, # ss, sheet, range, skip, n_max df <- get_cells( ss = ss, - sheet = sheet, range = range, + sheet = sheet, + range = range, col_names_in_sheet = isTRUE(col_spec$col_names), - skip = skip, n_max = n_max + skip = skip, + n_max = n_max ) spread_sheet_impl_( df, - col_spec = col_spec, na = na, trim_ws = trim_ws, guess_max = guess_max, + col_spec = col_spec, + na = na, + trim_ws = trim_ws, + guess_max = guess_max, .name_repair = .name_repair ) } @@ -145,11 +155,15 @@ read_sheet <- range_read #' #' # ^^ gets same result as ... #' read_sheet(gs4_example("mini-gap")) -spread_sheet <- function(df, - col_names = TRUE, col_types = NULL, - na = "", trim_ws = TRUE, - guess_max = min(1000, max(df$row)), - .name_repair = "unique") { +spread_sheet <- function( + df, + col_names = TRUE, + col_types = NULL, + na = "", + trim_ws = TRUE, + guess_max = min(1000, max(df$row)), + .name_repair = "unique" +) { col_spec <- standardise_col_spec(col_names, col_types, call = current_env()) check_character(na) check_bool(trim_ws) @@ -157,19 +171,26 @@ spread_sheet <- function(df, spread_sheet_impl_( df, - col_spec = col_spec, na = na, trim_ws = trim_ws, guess_max = guess_max, + col_spec = col_spec, + na = na, + trim_ws = trim_ws, + guess_max = guess_max, .name_repair = .name_repair ) } -spread_sheet_impl_ <- function(df, - col_spec = list( - col_names = TRUE, col_types = NULL - ), - na = "", trim_ws = TRUE, - guess_max = min(1000, max(df$row)), - .name_repair = "unique", - call = caller_env()) { +spread_sheet_impl_ <- function( + df, + col_spec = list( + col_names = TRUE, + col_types = NULL + ), + na = "", + trim_ws = TRUE, + guess_max = min(1000, max(df$row)), + .name_repair = "unique", + call = caller_env() +) { if (nrow(df) == 0) { return(tibble::tibble()) } @@ -235,7 +256,10 @@ spread_sheet_impl_ <- function(df, df_split, ctypes, make_column, - na = na, trim_ws = trim_ws, nr = nr, guess_max = guess_max + na = na, + trim_ws = trim_ws, + nr = nr, + guess_max = guess_max ) %>% set_names(col_names) %>% discard(is.null) @@ -277,7 +301,8 @@ standardise_ctypes <- function(col_types, call = caller_env()) { check_string(col_types, call = call) if (identical(col_types, "")) { - gs4_abort(" + gs4_abort( + " {.arg col_types}, when provided, must be a string that contains at \\ least one readr-style shortcode.", call = call diff --git a/R/range_read_cells.R b/R/range_read_cells.R index 281f1a81c..a0ac0368e 100644 --- a/R/range_read_cells.R +++ b/R/range_read_cells.R @@ -43,20 +43,25 @@ #' cell_data = "full", #' discard_empty = FALSE #' ) -range_read_cells <- function(ss, - sheet = NULL, - range = NULL, - skip = 0, n_max = Inf, - cell_data = c("default", "full"), - discard_empty = TRUE) { +range_read_cells <- function( + ss, + sheet = NULL, + range = NULL, + skip = 0, + n_max = Inf, + cell_data = c("default", "full"), + discard_empty = TRUE +) { cell_data <- match.arg(cell_data) # range spec params are checked inside get_cells(): # ss, sheet, range, skip, n_max out <- get_cells( ss = ss, - sheet = sheet, range = range, - skip = skip, n_max = n_max, + sheet = sheet, + range = range, + skip = skip, + n_max = n_max, col_names_in_sheet = FALSE, detail_level = cell_data, discard_empty = discard_empty diff --git a/R/range_spec.R b/R/range_spec.R index ed92432ae..0719ac089 100644 --- a/R/range_spec.R +++ b/R/range_spec.R @@ -3,13 +3,13 @@ new_range_spec <- function(...) { l <- list2(...) structure( list( - sheet_name = l$sheet_name %||% NULL, + sheet_name = l$sheet_name %||% NULL, named_range = l$named_range %||% NULL, - cell_range = l$cell_range %||% NULL, + cell_range = l$cell_range %||% NULL, cell_limits = l$cell_limits %||% NULL, - shim = FALSE, - sheets_df = l$sheets_df %||% NULL, - nr_df = l$nr_df %||% NULL + shim = FALSE, + sheets_df = l$sheets_df %||% NULL, + nr_df = l$nr_df %||% NULL ), # useful when debugging range specification, but otherwise this is TMI # .input = l$.input, @@ -46,18 +46,23 @@ as_range_spec.default <- function(x, ...) { # Sheet1 A1:B2 **** # 3 A1:B2 **** #' @export -as_range_spec.character <- function(x, - ..., - sheet = NULL, - skip = 0, - sheets_df = NULL, - nr_df = NULL) { +as_range_spec.character <- function( + x, + ..., + sheet = NULL, + skip = 0, + sheets_df = NULL, + nr_df = NULL +) { check_length_one(x) out <- new_range_spec( - sheets_df = sheets_df, nr_df = nr_df, + sheets_df = sheets_df, + nr_df = nr_df, .input = list( - sheet = sheet, range = x, skip = skip + sheet = sheet, + range = x, + skip = skip ) ) @@ -67,7 +72,7 @@ as_range_spec.character <- function(x, if (notNA(m[[".match"]])) { out$sheet_name <- lookup_sheet_name(m$sheet, sheets_df) out$cell_range <- m$cell_range - out$shim <- TRUE + out$shim <- TRUE return(out) } @@ -115,11 +120,13 @@ as_range_spec.character <- function(x, # >0 Express skip request in cell_limits object and re-dispatch. # Sheet1 / 2 >0 #' @export -as_range_spec.NULL <- function(x, - ..., - sheet = NULL, - skip = 0, - sheets_df = NULL) { +as_range_spec.NULL <- function( + x, + ..., + sheet = NULL, + skip = 0, + sheets_df = NULL +) { out <- new_range_spec( sheets_df = sheets_df, .input = list(sheet = sheet, skip = skip) @@ -134,7 +141,8 @@ as_range_spec.NULL <- function(x, as_range_spec( cell_rows(c(skip + 1, NA)), - sheet = sheet, sheets_df = sheets_df, + sheet = sheet, + sheets_df = sheets_df, shim = FALSE ) } @@ -151,11 +159,13 @@ as_range_spec.NULL <- function(x, # Sheet1 / 2 cell_limits Resolve sheet name, make A1 range, send combined # result. #' @export -as_range_spec.cell_limits <- function(x, - ..., - shim = TRUE, - sheet = NULL, - sheets_df = NULL) { +as_range_spec.cell_limits <- function( + x, + ..., + shim = TRUE, + sheet = NULL, + sheets_df = NULL +) { out <- new_range_spec( sheets_df = sheets_df, .input = list(sheet = sheet, range = x, shim = shim) diff --git a/R/range_speedread.R b/R/range_speedread.R index 8871cdd95..ab603120c 100644 --- a/R/range_speedread.R +++ b/R/range_speedread.R @@ -52,11 +52,7 @@ #' #' # clean up #' googledrive::drive_trash(ss) -range_speedread <- function(ss, - sheet = NULL, - range = NULL, - skip = 0, - ...) { +range_speedread <- function(ss, sheet = NULL, range = NULL, skip = 0, ...) { check_installed("readr", "to use `range_speedread()`.") ssid <- as_sheets_id(ss) @@ -75,8 +71,10 @@ range_speedread <- function(ss, range_msg <- "" range_spec <- as_range_spec( range, - sheet = sheet, skip = skip, - sheets_df = x$sheets, nr_df = x$named_ranges + sheet = sheet, + skip = skip, + sheets_df = x$sheets, + nr_df = x$named_ranges ) if (!is.null(range_spec$named_range)) { gs4_abort("{.fun range_speedread} cannot work with a named range.") @@ -93,9 +91,11 @@ range_speedread <- function(ss, params[["gid"]] <- s$id sheet_msg <- ", sheet {.w_sheet {range_spec$sheet_name}}" } - msg <- glue(" + msg <- glue( + " Reading from {.s_sheet {x$name}}<><>.", - .open = "<<", .close = ">>" + .open = "<<", + .close = ">>" ) gs4_bullets(c(v = msg)) diff --git a/R/range_write.R b/R/range_write.R index 3c69cea4d..b7b389ee8 100644 --- a/R/range_write.R +++ b/R/range_write.R @@ -101,12 +101,14 @@ #' # clean up #' gs4_find("range-write-demo") %>% #' googledrive::drive_trash() -range_write <- function(ss, - data, - sheet = NULL, - range = NULL, - col_names = TRUE, # not sure about this default - reformat = TRUE) { +range_write <- function( + ss, + data, + sheet = NULL, + range = NULL, + col_names = TRUE, # not sure about this default + reformat = TRUE +) { ssid <- as_sheets_id(ss) check_data_frame(data) maybe_sheet(sheet) @@ -121,9 +123,11 @@ range_write <- function(ss, range_spec <- as_range_spec( range, sheet = sheet, - sheets_df = x$sheets, nr_df = x$named_ranges + sheets_df = x$sheets, + nr_df = x$named_ranges ) - range_spec$sheet_name <- range_spec$sheet_name %||% first_visible_name(x$sheets) + range_spec$sheet_name <- range_spec$sheet_name %||% + first_visible_name(x$sheets) gs4_bullets(c(v = "Writing to sheet {.w_sheet {range_spec$sheet_name}}.")) # initialize the batch update requests; store details on target sheet s ------ @@ -145,7 +149,9 @@ range_write <- function(ss, if (!is.null(resize_req)) { new_dims <- pluck( resize_req, - "updateSheetProperties", "properties", "gridProperties" + "updateSheetProperties", + "properties", + "gridProperties" ) gs4_bullets(c( v = "Changing dims: ({s$grid_rows} x {s$grid_columns}) --> \\ @@ -156,7 +162,11 @@ range_write <- function(ss, } # pack the data, specify field mask ------------------------------------------ - fields <- if (reformat) "userEnteredValue,userEnteredFormat" else "userEnteredValue" + fields <- if (reformat) { + "userEnteredValue,userEnteredFormat" + } else { + "userEnteredValue" + } data_req <- new( "UpdateCellsRequest", rows = as_RowData(data, col_names = col_names), @@ -211,7 +221,7 @@ prepare_dims <- function(write_loc, data, col_names) { # * `range` is an instance of GridRange if (has_name(write_loc, "start")) { return(list( - nrow = (write_loc$start$rowIndex %||% 0) + nrow(data) + col_names, + nrow = (write_loc$start$rowIndex %||% 0) + nrow(data) + col_names, ncol = (write_loc$start$columnIndex %||% 0) + ncol(data) )) } diff --git a/R/request_generate.R b/R/request_generate.R index 1fb9a1f7f..2fcbae560 100644 --- a/R/request_generate.R +++ b/R/request_generate.R @@ -45,10 +45,12 @@ #' token = NULL #' ) #' req -request_generate <- function(endpoint = character(), - params = list(), - key = NULL, - token = gs4_token()) { +request_generate <- function( + endpoint = character(), + params = list(), + key = NULL, + token = gs4_token() +) { ept <- .endpoints[[endpoint]] if (is.null(ept)) { gs4_abort(c("Endpoint not recognized:", x = "{.field {endpoint}}")) @@ -59,8 +61,10 @@ request_generate <- function(endpoint = character(), force(params) ## modifications specific to googlesheets4 package - params$key <- key %||% params$key %||% - gs4_api_key() %||% gargle::tidyverse_api_key() + params$key <- key %||% + params$key %||% + gs4_api_key() %||% + gargle::tidyverse_api_key() req <- gargle::request_develop( endpoint = ept, diff --git a/R/request_make.R b/R/request_make.R index 7b3af6065..8b971c782 100644 --- a/R/request_make.R +++ b/R/request_make.R @@ -46,16 +46,24 @@ #' @family low-level API functions request_make <- function(x, ..., encode = "json") { gargle::request_retry( - x, ..., - encode = encode, user_agent = gs4_user_agent() + x, + ..., + encode = encode, + user_agent = gs4_user_agent() ) } gs4_user_agent <- function() { httr::user_agent(paste0( - "googlesheets4/", utils::packageVersion("googlesheets4"), " ", - "(GPN:RStudio; )", " ", - "gargle/", utils::packageVersion("gargle"), " ", - "httr/", utils::packageVersion("httr") + "googlesheets4/", + utils::packageVersion("googlesheets4"), + " ", + "(GPN:RStudio; )", + " ", + "gargle/", + utils::packageVersion("gargle"), + " ", + "httr/", + utils::packageVersion("httr") )) } diff --git a/R/roxygen.R b/R/roxygen.R index d5575760d..180bc9bb6 100644 --- a/R/roxygen.R +++ b/R/roxygen.R @@ -2,7 +2,8 @@ ### ss ---- param_ss <- function(..., pname = "ss") { - template <- glue(" + template <- glue( + " @param {pname} \\ Something that identifies a Google Sheet: * its file id as a string or [`drive_id`][googledrive::as_id] @@ -12,7 +13,8 @@ param_ss <- function(..., pname = "ss") { * an instance of `googlesheets4_spreadsheet`, which is what [gs4_get()] returns - Processed through [as_sheets_id()].") + Processed through [as_sheets_id()]." + ) dots <- list2(...) if (length(dots) > 0) { template <- c(template, dots) @@ -22,12 +24,14 @@ param_ss <- function(..., pname = "ss") { ### sheet ---- param_sheet <- function(..., action = "act on", pname = "sheet") { - template <- glue(" + template <- glue( + " @param {pname} \\ Sheet to {action}, in the sense of \"worksheet\" or \"tab\". \\ You can identify a sheet by name, with a string, or by position, \\ with a number. - ") + " + ) dots <- list2(...) if (length(dots) > 0) { template <- c(template, dots) @@ -36,11 +40,13 @@ param_sheet <- function(..., action = "act on", pname = "sheet") { } param_before_after <- function(sheet_text) { - glue(" + glue( + " @param .before,.after \\ Optional specification of where to put the new {sheet_text}. \\ Specify, at most, one of `.before` and `.after`. Refer to an existing \\ sheet by name (via a string) or by position (via a number). If \\ unspecified, Sheets puts the new {sheet_text} at the end. - ") + " + ) } diff --git a/R/schema_CellData.R b/R/schema_CellData.R index 73688113f..52f2d3cba 100644 --- a/R/schema_CellData.R +++ b/R/schema_CellData.R @@ -2,9 +2,14 @@ # an attribute for each cell. Possibly a premature concern. new_CellData <- function(...) { # explicit 'list' class is a bit icky but it makes jsonlite happy - structure(list2(...), class = c( - "googlesheets4_schema_CellData", "googlesheets4_schema", "list" - )) + structure( + list2(...), + class = c( + "googlesheets4_schema_CellData", + "googlesheets4_schema", + "list" + ) + ) } # Use this instead of `new_CellData()` when (light) validation makes sense. diff --git a/R/schema_GridRange.R b/R/schema_GridRange.R index 5b8f0f0e3..4814e0147 100644 --- a/R/schema_GridRange.R +++ b/R/schema_GridRange.R @@ -10,17 +10,17 @@ as_tibble.googlesheets4_schema_GridRange <- function(x, ...) { # if there is only 1 sheet, sheetId might not be sent! # https://github.com/tidyverse/googlesheets4/issues/29 # don't be shocked if this is NA - sheet_id = glean_int(x, "sheetId"), + sheet_id = glean_int(x, "sheetId"), # API sends zero-based row and column # => we add one # API indices are half-open, i.e. [start, end) # => we substract one from end_[row|column] # net effect # => we add one to start_[row|column] but not to end_[row|column] - start_row = glean_int(x, "startRowIndex") + 1L, - end_row = glean_int(x, "endRowIndex"), + start_row = glean_int(x, "startRowIndex") + 1L, + end_row = glean_int(x, "endRowIndex"), start_column = glean_int(x, "startColumnIndex") + 1L, - end_column = glean_int(x, "endColumnIndex") + end_column = glean_int(x, "endColumnIndex") ) } @@ -49,10 +49,10 @@ as_GridRange.range_spec <- function(x, ...) { } cl <- list( - startRowIndex = x$cell_limits$ul[1] - 1, - endRowIndex = x$cell_limits$lr[1], + startRowIndex = x$cell_limits$ul[1] - 1, + endRowIndex = x$cell_limits$lr[1], startColumnIndex = x$cell_limits$ul[2] - 1, - endColumnIndex = x$cell_limits$lr[2] + endColumnIndex = x$cell_limits$lr[2] ) cl <- discard(cl, is.na) patch(out, !!!cl) diff --git a/R/schema_NamedRange.R b/R/schema_NamedRange.R index 3601b421b..e7699eca5 100644 --- a/R/schema_NamedRange.R +++ b/R/schema_NamedRange.R @@ -5,7 +5,7 @@ as_tibble.googlesheets4_schema_NamedRange <- function(x, ...) { tibble::tibble( name = glean_chr(x, "name"), - id = glean_chr(x, "namedRangeId"), + id = glean_chr(x, "namedRangeId"), !!!grid_range ) } diff --git a/R/schema_ProtectedRange.R b/R/schema_ProtectedRange.R index 5e2cc2921..357494ad5 100644 --- a/R/schema_ProtectedRange.R +++ b/R/schema_ProtectedRange.R @@ -4,13 +4,13 @@ as_tibble.googlesheets4_schema_ProtectedRange <- function(x, ...) { grid_range <- as_tibble(grid_range) tibble::tibble( - protected_range_id = glean_int(x, "protectedRangeId"), - description = glean_chr(x, "description"), + protected_range_id = glean_int(x, "protectedRangeId"), + description = glean_chr(x, "description"), requesting_user_can_edit = glean_lgl(x, "requestingUserCanEdit"), - warning_only = glean_lgl(x, "warningOnly"), - has_unprotected_ranges = rlang::has_name(x, "unprotectedRanges"), - editors = x$editors %||% list(), - named_range_id = glean_chr(x, "namedRangeId"), + warning_only = glean_lgl(x, "warningOnly"), + has_unprotected_ranges = rlang::has_name(x, "unprotectedRanges"), + editors = x$editors %||% list(), + named_range_id = glean_chr(x, "namedRangeId"), !!!grid_range ) } diff --git a/R/schema_Sheet.R b/R/schema_Sheet.R index 0215359a2..42e6f97af 100644 --- a/R/schema_Sheet.R +++ b/R/schema_Sheet.R @@ -39,15 +39,16 @@ as_Sheet.data.frame <- function(x, ...) { sp, gridProperties = new( "GridProperties", - rowCount = nrow(x) + 1, # make room for column names - columnCount = ncol(x), + rowCount = nrow(x) + 1, # make room for column names + columnCount = ncol(x), ) ) new( "Sheet", properties = sp, - data = list( # an array of instances of GridData + data = list( + # an array of instances of GridData list( rowData = as_RowData(x) # an array of instances of RowData ) diff --git a/R/schema_SheetProperties.R b/R/schema_SheetProperties.R index 0d55f54ab..ca84bf95b 100644 --- a/R/schema_SheetProperties.R +++ b/R/schema_SheetProperties.R @@ -1,5 +1,6 @@ #' @export as_tibble.googlesheets4_schema_SheetProperties <- function(x, ...) { + # fmt: skip tibble::tibble( # TODO: open question whether I should explicitly unescape title here name = glean_chr(x, "title"), diff --git a/R/schema_Spreadsheet.R b/R/schema_Spreadsheet.R index 5245029fd..b9e9564c2 100644 --- a/R/schema_Spreadsheet.R +++ b/R/schema_Spreadsheet.R @@ -1,6 +1,7 @@ # input: a named list, usually an instance of googlesheets4_schema_Spreadsheet # output: instance of googlesheets4_spreadsheet, which is actually useful new_googlesheets4_spreadsheet <- function(x = list()) { + # fmt: skip ours_theirs <- list( spreadsheet_id = "spreadsheetId", spreadsheet_url = "spreadsheetUrl", @@ -64,6 +65,7 @@ new_googlesheets4_spreadsheet <- function(x = list()) { #' @export format.googlesheets4_spreadsheet <- function(x, ...) { cli::cli_div(theme = gs4_theme()) + # fmt: skip meta <- list( `Spreadsheet name` = cli::format_inline("{.s_sheet {x$name}}"), ID = as.character(x$spreadsheet_id), @@ -79,7 +81,10 @@ format.googlesheets4_spreadsheet <- function(x, ...) { meta <- c(meta, `# of named ranges` = as.character(nrow(x$named_ranges))) } if (!is.null(x$protected_ranges)) { - meta <- c(meta, `# of protected ranges` = as.character(nrow(x$protected_ranges))) + meta <- c( + meta, + `# of protected ranges` = as.character(nrow(x$protected_ranges)) + ) } out <- c( cli::cli_format_method( @@ -113,7 +118,10 @@ format.googlesheets4_spreadsheet <- function(x, ...) { col1 <- fr(c( "(Named range)", sapply( - gargle::gargle_map_cli(x$named_ranges$name, template = "{.range <>}"), + gargle::gargle_map_cli( + x$named_ranges$name, + template = "{.range <>}" + ), cli::format_inline ) )) diff --git a/R/schemas.R b/R/schemas.R index 430069989..d19a94a7a 100644 --- a/R/schemas.R +++ b/R/schemas.R @@ -23,9 +23,11 @@ check_against_schema <- function(x, schema = NULL, id = NA_character_) { .tidy_schemas[[id %|% id_from_class(x)]] %||% attr(x, "schema") if (is.null(schema)) { - gs4_abort(" + gs4_abort( + " Trying to check an object of class {.cls {class(x)}}, \\ - but can't get a schema.") + but can't get a schema." + ) } stopifnot(is_dictionaryish(x)) unexpected <- setdiff(names(x), schema$property) @@ -56,8 +58,10 @@ patch <- function(x, ...) { #' @export patch.default <- function(x, ...) { - gs4_abort(" - Don't know how to {.fun patch} an object of class {.cls {class(x)}}.") + gs4_abort( + " + Don't know how to {.fun patch} an object of class {.cls {class(x)}}." + ) } #' @export diff --git a/R/sheet_add.R b/R/sheet_add.R index 6c9d1565e..b62678c07 100644 --- a/R/sheet_add.R +++ b/R/sheet_add.R @@ -50,11 +50,7 @@ #' # clean up #' gs4_find("add-sheets-to-me") %>% #' googledrive::drive_trash() -sheet_add <- function(ss, - sheet = NULL, - ..., - .before = NULL, - .after = NULL) { +sheet_add <- function(ss, sheet = NULL, ..., .before = NULL, .after = NULL) { maybe_character(sheet) ssid <- as_sheets_id(ss) x <- gs4_get(ssid) @@ -72,9 +68,7 @@ sheet_add <- function(ss, invisible(ssid) } -sheet_add_impl_ <- function(ssid, - sheet_name = NULL, - index = NULL, ...) { +sheet_add_impl_ <- function(ssid, sheet_name = NULL, index = NULL, ...) { sheet_name <- sheet_name %||% list(NULL) dots <- list2(...) requests <- map( @@ -95,10 +89,12 @@ sheet_add_impl_ <- function(ssid, new_googlesheets4_spreadsheet(resp$updatedSpreadsheet) } -resolve_index <- function(sheets_df, - .before = NULL, - .after = NULL, - call = caller_env()) { +resolve_index <- function( + sheets_df, + .before = NULL, + .after = NULL, + call = caller_env() +) { if (is.null(.before) && is.null(.after)) { return(NULL) } @@ -121,8 +117,10 @@ make_addSheet <- function(title = NULL, index = NULL, dots = list()) { return(list(addSheet = NULL)) } - list(addSheet = new( - "AddSheetRequest", - properties = new("SheetProperties", title = title, index = index, !!!dots) - )) + list( + addSheet = new( + "AddSheetRequest", + properties = new("SheetProperties", title = title, index = index, !!!dots) + ) + ) } diff --git a/R/sheet_append.R b/R/sheet_append.R index db83ce47a..8856645ef 100644 --- a/R/sheet_append.R +++ b/R/sheet_append.R @@ -66,10 +66,12 @@ sheet_append <- function(ss, data, sheet = 1) { } prepare_rows <- function(sheet_id, df) { - list(appendCells = new( - "AppendCellsRequest", - sheetId = sheet_id, - rows = as_RowData(df, col_names = FALSE), # an array of instances of RowData - fields = "userEnteredValue,userEnteredFormat.numberFormat" - )) + list( + appendCells = new( + "AppendCellsRequest", + sheetId = sheet_id, + rows = as_RowData(df, col_names = FALSE), # an array of instances of RowData + fields = "userEnteredValue,userEnteredFormat.numberFormat" + ) + ) } diff --git a/R/sheet_copy.R b/R/sheet_copy.R index b040f5ffb..8edfad0bf 100644 --- a/R/sheet_copy.R +++ b/R/sheet_copy.R @@ -66,12 +66,14 @@ #' # clean up #' gs4_find("sheet-copy-demo") %>% #' googledrive::drive_trash() -sheet_copy <- function(from_ss, - from_sheet = NULL, - to_ss = from_ss, - to_sheet = NULL, - .before = NULL, - .after = NULL) { +sheet_copy <- function( + from_ss, + from_sheet = NULL, + to_ss = from_ss, + to_sheet = NULL, + .before = NULL, + .after = NULL +) { from_ssid <- as_sheets_id(from_ss) to_ssid <- as_sheets_id(to_ss) maybe_sheet(from_sheet) @@ -96,16 +98,20 @@ sheet_copy <- function(from_ss, } } -sheet_copy_internal <- function(ssid, - from_sheet = NULL, - to_sheet = NULL, - .before = NULL, - .after = NULL, - call = caller_env()) { +sheet_copy_internal <- function( + ssid, + from_sheet = NULL, + to_sheet = NULL, + .before = NULL, + .after = NULL, + call = caller_env() +) { maybe_string(to_sheet, call = call) x <- gs4_get(ssid) s <- lookup_sheet(from_sheet, sheets_df = x$sheets, call = call) - gs4_bullets(c(v = "Duplicating sheet {.w_sheet {s$name}} in {.s_sheet {x$name}}.")) + gs4_bullets(c( + v = "Duplicating sheet {.w_sheet {s$name}} in {.s_sheet {x$name}}." + )) index <- resolve_index(x$sheets, .before, .after, call = call) dup_request <- new( @@ -130,13 +136,15 @@ sheet_copy_internal <- function(ssid, invisible(ssid) } -sheet_copy_external <- function(from_ssid, - from_sheet = NULL, - to_ssid, - to_sheet = NULL, - .before = NULL, - .after = NULL, - call = caller_env()) { +sheet_copy_external <- function( + from_ssid, + from_sheet = NULL, + to_ssid, + to_sheet = NULL, + .before = NULL, + .after = NULL, + call = caller_env() +) { from_x <- gs4_get(from_ssid) to_x <- gs4_get(to_ssid) maybe_string(to_sheet, "sheet_copy", call = call) diff --git a/R/sheet_freeze.R b/R/sheet_freeze.R index 203e67da0..b5e629a7b 100644 --- a/R/sheet_freeze.R +++ b/R/sheet_freeze.R @@ -34,9 +34,7 @@ #' # clean up #' gs4_find("sheet-freeze-example") %>% #' googledrive::drive_trash() -sheet_freeze <- function(ss, - sheet = NULL, - nrow = NULL, ncol = NULL) { +sheet_freeze <- function(ss, sheet = NULL, nrow = NULL, ncol = NULL) { ssid <- as_sheets_id(ss) maybe_sheet(sheet) maybe_non_negative_integer(nrow) diff --git a/R/sheet_relocate.R b/R/sheet_relocate.R index 21622b013..59b9acde9 100644 --- a/R/sheet_relocate.R +++ b/R/sheet_relocate.R @@ -61,10 +61,12 @@ #' # clean up #' gs4_find("sheet-relocate-demo") %>% #' googledrive::drive_trash() -sheet_relocate <- function(ss, - sheet, - .before = if (is.null(.after)) 1, - .after = NULL) { +sheet_relocate <- function( + ss, + sheet, + .before = if (is.null(.after)) 1, + .after = NULL +) { ssid <- as_sheets_id(ss) walk(sheet, check_sheet) maybe_sheet(.before) @@ -80,7 +82,8 @@ sheet_relocate <- function(ss, sheet, ~ make_UpdateSheetPropertiesRequest( sheet = .x, - .before = .before, .after = .after, + .before = .before, + .after = .after, sheets_df = x$sheets, call = quote(sheet_relocate()) ) @@ -98,10 +101,13 @@ sheet_relocate <- function(ss, invisible(ssid) } -make_UpdateSheetPropertiesRequest <- function(sheet, - .before, .after, - sheets_df, - call = caller_env()) { +make_UpdateSheetPropertiesRequest <- function( + sheet, + .before, + .after, + sheets_df, + call = caller_env() +) { s <- lookup_sheet(sheet, sheets_df = sheets_df, call = call) index <- resolve_index(sheets_df, .before, .after, call = call) sp <- new("SheetProperties", sheetId = s$id, index = index) diff --git a/R/sheet_rename.R b/R/sheet_rename.R index 94a7d07cd..532395acd 100644 --- a/R/sheet_rename.R +++ b/R/sheet_rename.R @@ -29,9 +29,7 @@ #' # clean up #' gs4_find("sheet-rename-demo") %>% #' googledrive::drive_trash() -sheet_rename <- function(ss, - sheet = NULL, - new_name) { +sheet_rename <- function(ss, sheet = NULL, new_name) { ssid <- as_sheets_id(ss) maybe_sheet(sheet) check_string(new_name) diff --git a/R/sheet_resize.R b/R/sheet_resize.R index 463c152b4..c7b9a3adc 100644 --- a/R/sheet_resize.R +++ b/R/sheet_resize.R @@ -45,10 +45,13 @@ #' # clean up #' gs4_find("sheet-resize-demo") %>% #' googledrive::drive_trash() -sheet_resize <- function(ss, - sheet = NULL, - nrow = NULL, ncol = NULL, - exact = FALSE) { +sheet_resize <- function( + ss, + sheet = NULL, + nrow = NULL, + ncol = NULL, + exact = FALSE +) { ssid <- as_sheets_id(ss) maybe_sheet(sheet) maybe_non_negative_integer(nrow) @@ -57,9 +60,16 @@ sheet_resize <- function(ss, x <- gs4_get(ssid) s <- lookup_sheet(sheet, sheets_df = x$sheets) - gs4_bullets(c(v = "Resizing sheet {.w_sheet {s$name}} in {.s_sheet {x$name}}.")) + gs4_bullets(c( + v = "Resizing sheet {.w_sheet {s$name}} in {.s_sheet {x$name}}." + )) - bureq <- prepare_resize_request(s, nrow_needed = nrow, ncol_needed = ncol, exact = exact) + bureq <- prepare_resize_request( + s, + nrow_needed = nrow, + ncol_needed = ncol, + exact = exact + ) if (is.null(bureq)) { gs4_bullets(c( @@ -68,7 +78,12 @@ sheet_resize <- function(ss, return(invisible(ssid)) } - new_grid_properties <- pluck(bureq, "updateSheetProperties", "properties", "gridProperties") + new_grid_properties <- pluck( + bureq, + "updateSheetProperties", + "properties", + "gridProperties" + ) new_nrow <- pluck(new_grid_properties, "rowCount") %||% s$grid_rows new_ncol <- pluck(new_grid_properties, "columnCount") %||% s$grid_columns @@ -90,10 +105,12 @@ sheet_resize <- function(ss, invisible(ssid) } -prepare_resize_request <- function(sheet_info, - nrow_needed, - ncol_needed, - exact = FALSE) { +prepare_resize_request <- function( + sheet_info, + nrow_needed, + ncol_needed, + exact = FALSE +) { nrow_sheet <- sheet_info$grid_rows ncol_sheet <- sheet_info$grid_columns @@ -107,7 +124,8 @@ prepare_resize_request <- function(sheet_info, } else { bureq_set_grid_properties( sheetId = sheet_info$id, - nrow = new_dims$nrow, ncol = new_dims$ncol, + nrow = new_dims$nrow, + ncol = new_dims$ncol, frozenRowCount = NULL ) } diff --git a/R/sheet_write.R b/R/sheet_write.R index 6395e10f0..d070f47e6 100644 --- a/R/sheet_write.R +++ b/R/sheet_write.R @@ -77,9 +77,7 @@ #' # clean up #' gs4_find("sheet-write-demo") %>% #' googledrive::drive_trash() -sheet_write <- function(data, - ss = NULL, - sheet = NULL) { +sheet_write <- function(data, ss = NULL, sheet = NULL) { data_quo <- enquo(data) data <- eval_tidy(data_quo) check_data_frame(data) diff --git a/R/utils-cell-ranges.R b/R/utils-cell-ranges.R index a01806822..160c6e699 100644 --- a/R/utils-cell-ranges.R +++ b/R/utils-cell-ranges.R @@ -88,7 +88,7 @@ resolve_limits <- function(cell_limits, sheet_data = NULL) { # Rows: Max number of cells is 10 million. So that must be the maximum # number of rows (imagine a spreadsheet with 1 sheet and 1 column). # Columns: Max col is "ZZZ" = cellranger::letter_to_num("ZZZ") = 18278 - MAX_ROW <- sheet_data$grid_rows %||% 10000000L + MAX_ROW <- sheet_data$grid_rows %||% 10000000L MAX_COL <- sheet_data$grid_columns %||% 18278L limits <- c(cell_limits$ul, cell_limits$lr) @@ -171,7 +171,11 @@ limits_from_range <- function(x) { if (anyNA(corners$.match)) { gs4_abort("Invalid range: {.range {x}}") } - corners$column <- ifelse(nzchar(corners$column), corners$column, NA_character_) + corners$column <- ifelse( + nzchar(corners$column), + corners$column, + NA_character_ + ) corners$row <- ifelse(nzchar(corners$row), corners$row, NA_character_) corners$row <- as.integer(corners$row) if (nrow(corners) == 1) { @@ -201,8 +205,14 @@ check_range <- function(range = NULL, call = caller_env()) { } ## the `...` are used to absorb extra variables when this is used inside pmap() -make_cell_range <- function(start_row, end_row, start_column, end_column, - sheet_name, ...) { +make_cell_range <- function( + start_row, + end_row, + start_column, + end_column, + sheet_name, + ... +) { cl <- cellranger::cell_limits( ul = c(start_row, start_column), lr = c(end_row, end_column), diff --git a/R/utils-sheet.R b/R/utils-sheet.R index f3797baa0..2e8bcd9cc 100644 --- a/R/utils-sheet.R +++ b/R/utils-sheet.R @@ -1,7 +1,9 @@ -lookup_sheet <- function(sheet = NULL, - sheets_df, - visible = NA, - call = caller_env()) { +lookup_sheet <- function( + sheet = NULL, + sheets_df, + visible = NA, + call = caller_env() +) { maybe_sheet(sheet, call = call) if (is.null(sheets_df)) { gs4_abort( @@ -85,9 +87,11 @@ check_sheet <- function(sheet, arg = caller_arg(sheet), call = caller_env()) { sheet } -maybe_sheet <- function(sheet = NULL, - arg = caller_arg(sheet), - call = caller_env()) { +maybe_sheet <- function( + sheet = NULL, + arg = caller_arg(sheet), + call = caller_env() +) { if (is.null(sheet)) { sheet } else { diff --git a/R/utils-ui.R b/R/utils-ui.R index 602ee283e..9201a4a6a 100644 --- a/R/utils-ui.R +++ b/R/utils-ui.R @@ -53,10 +53,12 @@ with_no_color <- function(code) { } message <- function(...) { - gs4_abort(" + gs4_abort( + " Internal error: use the UI functions in {.pkg googlesheets4} \\ instead of {.fun message}", - .internal = TRUE) + .internal = TRUE + ) } fr <- function(x) { @@ -146,11 +148,13 @@ gs4_bullets <- function(text, .envir = parent.frame()) { #' @noRd NULL -gs4_abort <- function(message, - ..., - class = NULL, - .envir = parent.frame(), - call = caller_env()) { +gs4_abort <- function( + message, + ..., + class = NULL, + .envir = parent.frame(), + call = caller_env() +) { cli::cli_div(theme = gs4_theme()) cli::cli_abort( message = message, @@ -169,9 +173,11 @@ abort_unsupported_conversion <- function(from, to) { } else { msg_from <- "something of class {.cls {class(from)}}" } - msg <- glue(" + msg <- glue( + " Don't know how to make an instance of {.cls {to}} from <>.", - .open = "<<", .close = ">>" + .open = "<<", + .close = ">>" ) gs4_abort(msg) } diff --git a/R/utils.R b/R/utils.R index 065025fe6..a48af7e4c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -81,11 +81,14 @@ maybe_character <- function(x, arg = caller_arg(x), call = caller_env()) { } } -check_non_negative_integer <- function(i, - arg = caller_arg(i), - call = caller_env()) { - if (length(i) != 1 || !is.numeric(i) || - !is_integerish(i) || is.na(i) || i < 0) { +check_non_negative_integer <- function( + i, + arg = caller_arg(i), + call = caller_env() +) { + if ( + length(i) != 1 || !is.numeric(i) || !is_integerish(i) || is.na(i) || i < 0 + ) { gs4_abort( c( "{.arg {arg}} must be a positive integer:", @@ -97,9 +100,11 @@ check_non_negative_integer <- function(i, i } -maybe_non_negative_integer <- function(i, - arg = caller_arg(i), - call = caller_env()) { +maybe_non_negative_integer <- function( + i, + arg = caller_arg(i), + call = caller_env() +) { if (is.null(i)) { i } else { @@ -107,9 +112,7 @@ maybe_non_negative_integer <- function(i, } } -check_bool <- function(bool, - arg = caller_arg(bool), - call = caller_env()) { +check_bool <- function(bool, arg = caller_arg(bool), call = caller_env()) { if (!is_bool(bool)) { gs4_abort( "{.arg {arg}} must be either {.code TRUE} or {.code FALSE}.", @@ -119,9 +122,7 @@ check_bool <- function(bool, bool } -maybe_bool <- function(bool, - arg = caller_arg(bool), - call = caller_env()) { +maybe_bool <- function(bool, arg = caller_arg(bool), call = caller_env()) { if (is.null(bool)) { bool } else { diff --git a/R/zzz.R b/R/zzz.R index b41dc9a1a..1e3c308af 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,5 +1,4 @@ .onLoad <- function(libname, pkgname) { - # .auth is created in R/gs4_auth.R # this is to insure we get an instance of gargle's AuthState using the # current, locally installed version of gargle diff --git a/air.toml b/air.toml new file mode 100644 index 000000000..552154841 --- /dev/null +++ b/air.toml @@ -0,0 +1,2 @@ +[format] +skip = ["tribble"] diff --git a/data-raw/discovery-doc-prep.R b/data-raw/discovery-doc-prep.R index 06d139dfb..c84459243 100644 --- a/data-raw/discovery-doc-prep.R +++ b/data-raw/discovery-doc-prep.R @@ -17,21 +17,23 @@ if (length(existing) < 1) { rlang::inform("Downloading Discovery Document") x <- download_discovery_document("sheets:v4") } else { - msg <- glue::glue(" + msg <- glue::glue( + " Using existing Discovery Document: * {existing} - ") + " + ) rlang::inform(msg) x <- here::here("data-raw", existing) } dd <- read_discovery_document(x) -methods <- get_raw_methods(dd) +methods <- get_raw_methods(dd) more_methods <- get_raw_methods(pluck(dd, "resources", "spreadsheets")) methods <- c(methods, more_methods) -methods <- methods %>% map(groom_properties, dd) +methods <- methods %>% map(groom_properties, dd) methods <- methods %>% map(add_schema_params, dd) methods <- methods %>% map(add_global_params, dd) @@ -98,6 +100,9 @@ write_one <- function(data, id) { iwalk(.tidy_schemas, write_one) usethis::use_data( - .endpoints, .schemas, .tidy_schemas, - internal = TRUE, overwrite = TRUE + .endpoints, + .schemas, + .tidy_schemas, + internal = TRUE, + overwrite = TRUE ) diff --git a/data-raw/gapminder-example-sheets.R b/data-raw/gapminder-example-sheets.R index 4e7e913e3..2fb0d756a 100644 --- a/data-raw/gapminder-example-sheets.R +++ b/data-raw/gapminder-example-sheets.R @@ -19,11 +19,11 @@ ss <- gs4_find("gapminder") %>% as_sheets_id() # gs4_browse(ss) gapminder_split <- split(gapminder, gapminder$continent) -sheet_write(gapminder_split$Africa, ss = ss, sheet = "Africa") +sheet_write(gapminder_split$Africa, ss = ss, sheet = "Africa") sheet_write(gapminder_split$Americas, ss = ss, sheet = "Americas") -sheet_write(gapminder_split$Asia, ss = ss, sheet = "Asia") -sheet_write(gapminder_split$Europe, ss = ss, sheet = "Europe") -sheet_write(gapminder_split$Oceania, ss = ss, sheet = "Oceania") +sheet_write(gapminder_split$Asia, ss = ss, sheet = "Asia") +sheet_write(gapminder_split$Europe, ss = ss, sheet = "Europe") +sheet_write(gapminder_split$Oceania, ss = ss, sheet = "Oceania") ## Update mini-gap example Sheet ---- mini_gap <- gapminder %>% @@ -35,8 +35,8 @@ mini_gap <- gapminder %>% (ss <- gs4_find("mini-gap") %>% as_sheets_id()) # gs4_browse(ss) -sheet_write(mini_gap$Africa, ss = ss, sheet = "Africa") +sheet_write(mini_gap$Africa, ss = ss, sheet = "Africa") sheet_write(mini_gap$Americas, ss = ss, sheet = "Americas") -sheet_write(mini_gap$Asia, ss = ss, sheet = "Asia") -sheet_write(mini_gap$Europe, ss = ss, sheet = "Europe") -sheet_write(mini_gap$Oceania, ss = ss, sheet = "Oceania") +sheet_write(mini_gap$Asia, ss = ss, sheet = "Asia") +sheet_write(mini_gap$Europe, ss = ss, sheet = "Europe") +sheet_write(mini_gap$Oceania, ss = ss, sheet = "Oceania") diff --git a/data-raw/schema-rectangling.R b/data-raw/schema-rectangling.R index 6c07bfc20..5ba20333b 100644 --- a/data-raw/schema-rectangling.R +++ b/data-raw/schema-rectangling.R @@ -12,12 +12,12 @@ schema_rectangle <- function(s) { properties <- pluck(schema, "properties") scaffold <- list( - description = "Just a placeholder", - type = "scaffold", - "$ref" = "SCHEMA", - items = list("$ref" = "SCHEMA"), - format = "FORMAT", - enum = letters[1:3], + description = "Just a placeholder", + type = "scaffold", + "$ref" = "SCHEMA", + items = list("$ref" = "SCHEMA"), + format = "FORMAT", + enum = letters[1:3], enumDescriptions = LETTERS[1:3] ) df <- tibble(properties = c(scaffold = list(scaffold), properties)) @@ -41,7 +41,7 @@ schema_rectangle <- function(s) { make_enum_tibble <- function(x, y) { tibble( - enum = x %||% character(), + enum = x %||% character(), enumDesc = y %||% character() ) } diff --git a/data-raw/see-all-examples.R b/data-raw/see-all-examples.R index 4cb61cd0d..77646c0f1 100644 --- a/data-raw/see-all-examples.R +++ b/data-raw/see-all-examples.R @@ -19,7 +19,8 @@ do_one <- function(x) { cat( readLines(tmp), file = here("examples", "googlesheets4-examples.R"), - append = TRUE, sep = "\n" + append = TRUE, + sep = "\n" ) } else { print(" ^ no examples!!") diff --git a/tests/spelling.R b/tests/spelling.R index 13f77d963..d60e024c2 100644 --- a/tests/spelling.R +++ b/tests/spelling.R @@ -1,6 +1,7 @@ if (requireNamespace("spelling", quietly = TRUE)) { spelling::spell_check_test( - vignettes = TRUE, error = FALSE, + vignettes = TRUE, + error = FALSE, skip_on_cran = TRUE ) } diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 03e76f6e7..507ce3f89 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -33,11 +33,14 @@ local_ss <- function(name, ..., env = parent.frame()) { { trash_me <- gs4_find(name) if (nrow(trash_me) < 1) { - cli::cli_warn(" - The spreadsheet named {.s_sheet name} already seems to be deleted.") + cli::cli_warn( + "The spreadsheet named {.s_sheet name} already seems to be deleted." + ) } else { quiet <- gs4_quiet() %|% is_testing() - if (quiet) googledrive::local_drive_quiet() + if (quiet) { + googledrive::local_drive_quiet() + } googledrive::drive_trash(trash_me) } }, diff --git a/tests/testthat/test-gs4_auth.R b/tests/testthat/test-gs4_auth.R index 04663abe6..775416404 100644 --- a/tests/testthat/test-gs4_auth.R +++ b/tests/testthat/test-gs4_auth.R @@ -17,7 +17,8 @@ test_that("gs4_auth_configure works", { expect_s3_class(gs4_oauth_client(), "gargle_oauth_client") path_to_json <- system.file( - "extdata", "client_secret_installed.googleusercontent.com.json", + "extdata", + "client_secret_installed.googleusercontent.com.json", package = "gargle" ) gs4_auth_configure(path = path_to_json) @@ -45,7 +46,8 @@ test_that("gs4_auth_configure(app =) is deprecated in favor of client", { client <- gargle::gargle_oauth_client_from_json( system.file( - "extdata", "client_secret_installed.googleusercontent.com.json", + "extdata", + "client_secret_installed.googleusercontent.com.json", package = "gargle" ), name = "test-client" diff --git a/tests/testthat/test-range_delete.R b/tests/testthat/test-range_delete.R index 66f7d3ce3..ad37da9a1 100644 --- a/tests/testthat/test-range_delete.R +++ b/tests/testthat/test-range_delete.R @@ -29,9 +29,9 @@ test_that("determine_shift() 'works' for ranges where user input is required", { # us how to shift cells into the deleted region bounded_bottom_and_right <- list( cell_limits(c(NA, NA), c(3, 5)), - cell_limits(c( 1, NA), c(3, 5)), - cell_limits(c(NA, 3), c(3, 5)), - cell_limits(c( 1, 3), c(3, 5)) + cell_limits(c(1, NA), c(3, 5)), + cell_limits(c(NA, 3), c(3, 5)), + cell_limits(c(1, 3), c(3, 5)) ) out <- purrr::map( @@ -47,9 +47,9 @@ test_that("determine_shift() detects ranges where we shift ROWS up", { # these are bounded on the bottom, but not the on the right bounded_bottom <- list( cell_limits(c(NA, NA), c(3, NA)), - cell_limits(c( 1, NA), c(3, NA)), - cell_limits(c(NA, 3), c(3, NA)), - cell_limits(c( 1, 3), c(3, NA)) + cell_limits(c(1, NA), c(3, NA)), + cell_limits(c(NA, 3), c(3, NA)), + cell_limits(c(1, 3), c(3, NA)) ) out <- purrr::map_chr( @@ -65,9 +65,9 @@ test_that("determine_shift() detects ranges where we shift COLUMNS left", { # these are bounded on the bottom, but not the on the right bounded_right <- list( cell_limits(c(NA, NA), c(NA, 5)), - cell_limits(c( 1, NA), c(NA, 5)), - cell_limits(c(NA, 3), c(NA, 5)), - cell_limits(c( 1, 3), c(NA, 5)) + cell_limits(c(1, NA), c(NA, 5)), + cell_limits(c(NA, 3), c(NA, 5)), + cell_limits(c(1, 3), c(NA, 5)) ) out <- purrr::map_chr( @@ -83,9 +83,9 @@ test_that("determine_shift() detects ranges where we must error", { # these are not bounded at on either the bottom or the right not_bounded <- list( cell_limits(c(NA, NA), c(NA, NA)), - cell_limits(c( 1, NA), c(NA, NA)), - cell_limits(c(NA, 3), c(NA, NA)), - cell_limits(c( 1, 3), c(NA, NA)) + cell_limits(c(1, NA), c(NA, NA)), + cell_limits(c(NA, 3), c(NA, NA)), + cell_limits(c(1, 3), c(NA, NA)) ) expect_bad_range <- function(x) { diff --git a/tests/testthat/test-range_flood.R b/tests/testthat/test-range_flood.R index a10548ab7..2396a85c4 100644 --- a/tests/testthat/test-range_flood.R +++ b/tests/testthat/test-range_flood.R @@ -34,6 +34,12 @@ test_that("range_flood() works", { expect_true(all(unlist(fmts) == 1)) column_C_header <- out[out$col == 3 & out$row == 1, ] - fmt <- purrr::pluck(column_C_header, "cell", 1, "effectiveFormat", "backgroundColor") + fmt <- purrr::pluck( + column_C_header, + "cell", + 1, + "effectiveFormat", + "backgroundColor" + ) expect_true(all(unlist(fmt) < 1)) }) diff --git a/tests/testthat/test-range_read.R b/tests/testthat/test-range_read.R index adaeac98d..3e89fc30e 100644 --- a/tests/testthat/test-range_read.R +++ b/tests/testthat/test-range_read.R @@ -6,13 +6,13 @@ test_that("read_sheet() works and discovers reasonable types", { test_sheet("googlesheets4-col-types"), sheet = "lots-of-types" ) - expect_type( dat$logical, "logical") - expect_type( dat$character, "character") - expect_type( dat$factor, "character") - expect_type( dat$integer, "double") - expect_type( dat$double, "double") - expect_s3_class(dat$date, "POSIXct") - expect_s3_class(dat$datetime, "POSIXct") + expect_type(dat$logical, "logical") + expect_type(dat$character, "character") + expect_type(dat$factor, "character") + expect_type(dat$integer, "double") + expect_type(dat$double, "double") + expect_s3_class(dat$date, "POSIXct") + expect_s3_class(dat$datetime, "POSIXct") }) test_that("read_sheet() enacts user-specified coltypes", { @@ -24,13 +24,13 @@ test_that("read_sheet() enacts user-specified coltypes", { sheet = "lots-of-types", col_types = "lccinDT" ) - expect_type( dat$logical, "logical") - expect_type( dat$character, "character") - expect_type( dat$factor, "character") # TODO: revisit when 'f' means factor - expect_type( dat$integer, "integer") - expect_type( dat$double, "double") - expect_s3_class(dat$date, "Date") - expect_s3_class(dat$datetime, "POSIXct") + expect_type(dat$logical, "logical") + expect_type(dat$character, "character") + expect_type(dat$factor, "character") # TODO: revisit when 'f' means factor + expect_type(dat$integer, "integer") + expect_type(dat$double, "double") + expect_s3_class(dat$date, "Date") + expect_s3_class(dat$datetime, "POSIXct") }) test_that("read_sheet() can skip columns", { @@ -43,8 +43,8 @@ test_that("read_sheet() can skip columns", { col_types = "?-_-_-?" ) expect_equal(ncol(dat), 2) - expect_type( dat$logical, "logical") - expect_s3_class(dat$datetime, "POSIXct") + expect_type(dat$logical, "logical") + expect_s3_class(dat$datetime, "POSIXct") }) # https://github.com/tidyverse/googlesheets4/issues/73 @@ -86,7 +86,8 @@ test_that("read_sheet() honors `na`", { dat <- read_sheet( test_sheet("googlesheets4-col-types"), sheet = "NAs", - na = character(), trim_ws = FALSE + na = character(), + trim_ws = FALSE ) expect_equal(dat$space[2], " ") @@ -156,10 +157,19 @@ test_that("standardise_ctypes() understands and requires readr shortcodes", { expect_equal( standardise_ctypes(good), c( - `_` = "COL_SKIP", `-` = "COL_SKIP", l = "CELL_LOGICAL", - i = "CELL_INTEGER", d = "CELL_NUMERIC", n = "CELL_NUMERIC", - D = "CELL_DATE", t = "CELL_TIME", T = "CELL_DATETIME", c = "CELL_TEXT", - C = "COL_CELL", L = "COL_LIST", `?` = "COL_GUESS" + `_` = "COL_SKIP", + `-` = "COL_SKIP", + l = "CELL_LOGICAL", + i = "CELL_INTEGER", + d = "CELL_NUMERIC", + n = "CELL_NUMERIC", + D = "CELL_DATE", + t = "CELL_TIME", + T = "CELL_DATETIME", + c = "CELL_TEXT", + C = "COL_CELL", + L = "COL_LIST", + `?` = "COL_GUESS" ) ) expect_error(standardise_ctypes("abe"), "Unrecognized") diff --git a/tests/testthat/test-range_read_cells.R b/tests/testthat/test-range_read_cells.R index 2864e3d7a..51c7fb941 100644 --- a/tests/testthat/test-range_read_cells.R +++ b/tests/testthat/test-range_read_cells.R @@ -49,7 +49,8 @@ test_that("full cell data and empties are within reach", { out <- range_read_cells( test_sheet("googlesheets4-cell-tests"), sheet = "empties-and-formats", - cell_data = "full", discard_empty = FALSE + cell_data = "full", + discard_empty = FALSE ) # B2 is empty; make sure it's here @@ -79,7 +80,8 @@ test_that("formula cells are parsed based on effectiveValue", { test_sheet("googlesheets4-cell-tests"), sheet = "formulas", range = "B:B", - cell_data = "full", discard_empty = FALSE + cell_data = "full", + discard_empty = FALSE ) expect_s3_class(out$cell[[which(out$loc == "B2")]], "CELL_TEXT") diff --git a/tests/testthat/test-range_write.R b/tests/testthat/test-range_write.R index 6eece5df5..98b42706a 100644 --- a/tests/testthat/test-range_write.R +++ b/tests/testthat/test-range_write.R @@ -8,7 +8,8 @@ test_that("range_write() works", { n <- 3 m <- 5 - data <- suppressMessages( # silence messages about name repair + data <- suppressMessages( + # silence messages about name repair tibble::as_tibble( matrix(head(letters, n * m), nrow = n, ncol = m), .name_repair = "unique" @@ -69,24 +70,25 @@ test_that("prepare_loc() makes the right call re: `start` vs. `range`", { expect_named(out, loc) } - expect_loc(NULL, "start") + expect_loc(NULL, "start") expect_loc("Sheet1", "start") - expect_loc("D4", "start") - expect_loc("B5:B5", "start") + expect_loc("D4", "start") + expect_loc("B5:B5", "start") expect_loc(cell_limits(c(5, 2), c(5, 2)), "start") expect_loc("B4:G9", "range") - expect_loc("A2:F", "range") - expect_loc("A2:5", "range") - expect_loc("C:E", "range") - expect_loc("5:7", "range") + expect_loc("A2:F", "range") + expect_loc("A2:5", "range") + expect_loc("C:E", "range") + expect_loc("5:7", "range") expect_loc(cell_limits(c(2, 4), c(NA, NA)), "range") }) test_that("prepare_dims() works when write_loc is a `start` (a GridCoordinate)", { n <- 3 m <- 5 - data <- suppressMessages( # silence messages about name repair + data <- suppressMessages( + # silence messages about name repair tibble::as_tibble( matrix(head(letters, n * m), nrow = n, ncol = m), .name_repair = "unique" @@ -99,31 +101,32 @@ test_that("prepare_dims() works when write_loc is a `start` (a GridCoordinate)", # no row or column info --> default offset is 0 (remember these are 0-indexed) loc <- list(start = new("GridCoordinate", sheetId = 123)) - expect_dims(loc, col_names = TRUE, list(nrow = n + 1, ncol = m)) - expect_dims(loc, col_names = FALSE, list(nrow = n, ncol = m)) + expect_dims(loc, col_names = TRUE, list(nrow = n + 1, ncol = m)) + expect_dims(loc, col_names = FALSE, list(nrow = n, ncol = m)) # row offset loc <- list(start = new("GridCoordinate", sheetId = 123, rowIndex = 2)) - expect_dims(loc, col_names = TRUE, list(nrow = 2 + n + 1, ncol = m)) - expect_dims(loc, col_names = FALSE, list(nrow = 2 + n, ncol = m)) + expect_dims(loc, col_names = TRUE, list(nrow = 2 + n + 1, ncol = m)) + expect_dims(loc, col_names = FALSE, list(nrow = 2 + n, ncol = m)) # column offset loc <- list(start = new("GridCoordinate", sheetId = 123, columnIndex = 3)) - expect_dims(loc, col_names = TRUE, list(nrow = n + 1, ncol = 3 + m)) - expect_dims(loc, col_names = FALSE, list(nrow = n, ncol = 3 + m)) + expect_dims(loc, col_names = TRUE, list(nrow = n + 1, ncol = 3 + m)) + expect_dims(loc, col_names = FALSE, list(nrow = n, ncol = 3 + m)) # row and column offset loc <- list( start = new("GridCoordinate", sheetId = 123, rowIndex = 2, columnIndex = 3) ) - expect_dims(loc, col_names = TRUE, list(nrow = 2 + n + 1, ncol = 3 + m)) - expect_dims(loc, col_names = FALSE, list(nrow = 2 + n, ncol = 3 + m)) + expect_dims(loc, col_names = TRUE, list(nrow = 2 + n + 1, ncol = 3 + m)) + expect_dims(loc, col_names = FALSE, list(nrow = 2 + n, ncol = 3 + m)) }) test_that("prepare_dims() works when write_loc is a `range` (a GridRange)", { n <- 3 m <- 5 - data <- suppressMessages( # silence messages about name repair + data <- suppressMessages( + # silence messages about name repair tibble::as_tibble( matrix(head(letters, n * m), nrow = n, ncol = m), .name_repair = "unique" @@ -137,28 +140,60 @@ test_that("prepare_dims() works when write_loc is a `range` (a GridRange)", { } # fully specified range; lower right cell is all that matters - expect_dims("B4:G9", col_names = TRUE, list(nrow = 9, ncol = which(LETTERS == "G"))) - expect_dims("B4:G9", col_names = FALSE, list(nrow = 9, ncol = which(LETTERS == "G"))) + expect_dims( + "B4:G9", + col_names = TRUE, + list(nrow = 9, ncol = which(LETTERS == "G")) + ) + expect_dims( + "B4:G9", + col_names = FALSE, + list(nrow = 9, ncol = which(LETTERS == "G")) + ) # range is open on the bottom # get row extent from upper left of range + data, column extent from range - expect_dims("B3:D", col_names = TRUE, list(nrow = 2 + n + 1, ncol = which(LETTERS == "D"))) - expect_dims("B3:D", col_names = FALSE, list(nrow = 2 + n , ncol = which(LETTERS == "D"))) + expect_dims( + "B3:D", + col_names = TRUE, + list(nrow = 2 + n + 1, ncol = which(LETTERS == "D")) + ) + expect_dims( + "B3:D", + col_names = FALSE, + list(nrow = 2 + n, ncol = which(LETTERS == "D")) + ) # range is open on the right # get row extent from range, column extent from range + data - expect_dims("C3:5", col_names = TRUE, list(nrow = 5, ncol = which(LETTERS == "C") + m - 1)) - expect_dims("C3:5", col_names = FALSE, list(nrow = 5, ncol = which(LETTERS == "C") + m - 1)) + expect_dims( + "C3:5", + col_names = TRUE, + list(nrow = 5, ncol = which(LETTERS == "C") + m - 1) + ) + expect_dims( + "C3:5", + col_names = FALSE, + list(nrow = 5, ncol = which(LETTERS == "C") + m - 1) + ) # range is open on left (trivially) and on the right # get row extent from range, column extent from the data - expect_dims("5:7", col_names = TRUE, list(nrow = 7, ncol = m)) + expect_dims("5:7", col_names = TRUE, list(nrow = 7, ncol = m)) expect_dims("5:7", col_names = FALSE, list(nrow = 7, ncol = m)) # range is open on the top (trivially) and bottom # get row extent from data, column extent from range - expect_dims("B:H", col_names = TRUE, list(nrow = n + 1, ncol = which(LETTERS == "H"))) - expect_dims("B:H", col_names = FALSE, list(nrow = n, ncol = which(LETTERS == "H"))) + expect_dims( + "B:H", + col_names = TRUE, + list(nrow = n + 1, ncol = which(LETTERS == "H")) + ) + expect_dims( + "B:H", + col_names = FALSE, + list(nrow = n, ncol = which(LETTERS == "H")) + ) # range is open on the bottom and right # get row extent from range + data, column extent from range + data diff --git a/tests/testthat/test-schema_CellData.R b/tests/testthat/test-schema_CellData.R index 7a2618e27..ef09609aa 100644 --- a/tests/testthat/test-schema_CellData.R +++ b/tests/testthat/test-schema_CellData.R @@ -104,9 +104,12 @@ test_that("as_CellData() works for POSIXct", { (naked_input[[3]] / 86400) + 25569 ) - fmt <- list(numberFormat = list( - type = "DATE_TIME", pattern = "yyyy-mm-dd hh:mm:ss" - )) + fmt <- list( + numberFormat = list( + type = "DATE_TIME", + pattern = "yyyy-mm-dd hh:mm:ss" + ) + ) expect_cell_format(out[[1]], fmt) expect_cell_format(out[[2]], fmt) expect_cell_format(out[[3]], fmt) diff --git a/tests/testthat/test-schema_GridCoordinate.R b/tests/testthat/test-schema_GridCoordinate.R index 35fbec9f8..bd4e4b45e 100644 --- a/tests/testthat/test-schema_GridCoordinate.R +++ b/tests/testthat/test-schema_GridCoordinate.R @@ -7,7 +7,9 @@ test_that("we can make a GridCoordinate from a range_spec, simplest case", { expect_length(out, 1) spec <- new_range_spec( - sheet_name = "abc", cell_range = "G3", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "G3", + sheets_df = sheets_df ) out <- as_GridCoordinate(spec) expect_equal(out$rowIndex, 2) @@ -18,12 +20,16 @@ test_that("we can (or won't) make a GridCoordinate from a mutli-cell range", { sheets_df <- tibble::tibble(name = "abc", id = 123) spec <- new_range_spec( - sheet_name = "abc", cell_range = "A3:B4", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "A3:B4", + sheets_df = sheets_df ) expect_error(as_GridCoordinate(spec), "Invalid cell range") spec2 <- new_range_spec( - sheet_name = "abc", cell_range = "A3", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "A3", + sheets_df = sheets_df ) expect_equal( as_GridCoordinate(spec, strict = FALSE), @@ -31,14 +37,18 @@ test_that("we can (or won't) make a GridCoordinate from a mutli-cell range", { ) spec <- new_range_spec( - sheet_name = "abc", cell_range = "A:B", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "A:B", + sheets_df = sheets_df ) out <- as_GridCoordinate(spec, strict = FALSE) expect_null(out$rowIndex) expect_equal(out$columnIndex, 0) spec <- new_range_spec( - sheet_name = "abc", cell_range = "2:4", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "2:4", + sheets_df = sheets_df ) out <- as_GridCoordinate(spec, strict = FALSE) expect_equal(out$rowIndex, 1) diff --git a/tests/testthat/test-schema_GridRange.R b/tests/testthat/test-schema_GridRange.R index 6d5a4c44c..e2ff98c16 100644 --- a/tests/testthat/test-schema_GridRange.R +++ b/tests/testthat/test-schema_GridRange.R @@ -8,7 +8,9 @@ test_that("we can make a GridRange from a range_spec", { expect_equal(out$sheetId, 123) spec <- new_range_spec( - sheet_name = "abc", cell_range = "A3:B4", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "A3:B4", + sheets_df = sheets_df ) out <- as_GridRange(spec) expect_equal(out$sheetId, 123) @@ -18,7 +20,9 @@ test_that("we can make a GridRange from a range_spec", { expect_equal(out$endColumnIndex, 2) spec <- new_range_spec( - sheet_name = "abc", cell_range = "A5:B", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "A5:B", + sheets_df = sheets_df ) out <- as_GridRange(spec) expect_equal(out$sheetId, 123) @@ -28,7 +32,9 @@ test_that("we can make a GridRange from a range_spec", { expect_equal(out$endColumnIndex, 2) spec <- new_range_spec( - sheet_name = "abc", cell_range = "A:B", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "A:B", + sheets_df = sheets_df ) out <- as_GridRange(spec) expect_equal(out$sheetId, 123) @@ -38,7 +44,9 @@ test_that("we can make a GridRange from a range_spec", { expect_equal(out$endColumnIndex, 2) spec <- new_range_spec( - sheet_name = "abc", cell_range = "A1:A1", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "A1:A1", + sheets_df = sheets_df ) out <- as_GridRange(spec) expect_equal(out$sheetId, 123) @@ -48,10 +56,14 @@ test_that("we can make a GridRange from a range_spec", { expect_equal(out$endColumnIndex, 1) spec1 <- new_range_spec( - sheet_name = "abc", cell_range = "C3:C3", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "C3:C3", + sheets_df = sheets_df ) spec2 <- new_range_spec( - sheet_name = "abc", cell_range = "C3", sheets_df = sheets_df + sheet_name = "abc", + cell_range = "C3", + sheets_df = sheets_df ) expect_equal(as_GridRange(spec1), as_GridRange(spec2)) }) diff --git a/tests/testthat/test-sheet_add.R b/tests/testthat/test-sheet_add.R index 95216bc42..02aaf1b36 100644 --- a/tests/testthat/test-sheet_add.R +++ b/tests/testthat/test-sheet_add.R @@ -37,7 +37,9 @@ test_that("sheet_add() works", { sheet = "eggplant", .before = 1, gridProperties = list( - rowCount = 3, columnCount = 6, frozenRowCount = 1 + rowCount = 3, + columnCount = 6, + frozenRowCount = 1 ) ) ) @@ -46,7 +48,15 @@ test_that("sheet_add() works", { expect_identical( sheets_df$name, - c("eggplant", "Sheet1", "apple", "banana", "Sheet2", "coconut", "dragonfruit") + c( + "eggplant", + "Sheet1", + "apple", + "banana", + "Sheet2", + "coconut", + "dragonfruit" + ) ) expect_identical(vlookup("eggplant", sheets_df, "name", "grid_rows"), 3L) expect_identical(vlookup("eggplant", sheets_df, "name", "grid_columns"), 6L) diff --git a/tests/testthat/test-sheet_copy.R b/tests/testthat/test-sheet_copy.R index 51c761f02..35344d5dc 100644 --- a/tests/testthat/test-sheet_copy.R +++ b/tests/testthat/test-sheet_copy.R @@ -28,7 +28,9 @@ test_that("external copy works", { sheet_copy( ss_source, from_sheet = "chickwts", - to_ss = ss_dest, to_sheet = "chicks-two", .before = 1 + to_ss = ss_dest, + to_sheet = "chicks-two", + .before = 1 ) out <- sheet_names(ss_dest) expect_equal(out, c("chicks-two", "Sheet1")) diff --git a/tests/testthat/test-sheet_resize.R b/tests/testthat/test-sheet_resize.R index 173831d03..98c12a177 100644 --- a/tests/testthat/test-sheet_resize.R +++ b/tests/testthat/test-sheet_resize.R @@ -29,7 +29,11 @@ test_that("prepare_resize_request() works for resize & no resize", { # 3 * 3 * 2 = 18 combinations # exact = FALSE - df <- expand.grid(nrow_needed = n + -1:1, ncol_needed = m + -1:1, exact = FALSE) + df <- expand.grid( + nrow_needed = n + -1:1, + ncol_needed = m + -1:1, + exact = FALSE + ) req <- pmap(df, prepare_resize_request, sheet_info = sheet_info) grid_properties <- purrr::map( req, @@ -55,7 +59,11 @@ test_that("prepare_resize_request() works for resize & no resize", { ) # exact = TRUE - df <- expand.grid(nrow_needed = n + -1:1, ncol_needed = m + -1:1, exact = TRUE) + df <- expand.grid( + nrow_needed = n + -1:1, + ncol_needed = m + -1:1, + exact = TRUE + ) req <- pmap(df, prepare_resize_request, sheet_info = sheet_info) grid_properties <- purrr::map( req, diff --git a/tests/testthat/test-sheet_write.R b/tests/testthat/test-sheet_write.R index e2c56c89a..1d20c934d 100644 --- a/tests/testthat/test-sheet_write.R +++ b/tests/testthat/test-sheet_write.R @@ -20,7 +20,8 @@ test_that("sheet_write() writes what it should", { # the main interesting bit to test is whether we successfully sent # correct value for the date and datetime, with a sane (= ISO 8601) format expect_equal( - purrr::pluck(x, "date", 1, "formattedValue"), format(dat$date[1]) + purrr::pluck(x, "date", 1, "formattedValue"), + format(dat$date[1]) ) expect_equal( purrr::pluck(x, "date", 1, "effectiveFormat", "numberFormat", "type"), @@ -32,14 +33,22 @@ test_that("sheet_write() writes what it should", { ) expect_equal( - purrr::pluck(x, "datetime", 1, "formattedValue"), format(dat$datetime[1]) + purrr::pluck(x, "datetime", 1, "formattedValue"), + format(dat$datetime[1]) ) expect_equal( purrr::pluck(x, "datetime", 1, "effectiveFormat", "numberFormat", "type"), "DATE_TIME" ) expect_equal( - purrr::pluck(x, "datetime", 1, "effectiveFormat", "numberFormat", "pattern"), + purrr::pluck( + x, + "datetime", + 1, + "effectiveFormat", + "numberFormat", + "pattern" + ), "yyyy-mm-dd hh:mm:ss" ) }) diff --git a/tests/testthat/test-utils-cell-ranges.R b/tests/testthat/test-utils-cell-ranges.R index dfb7a9c9d..fea1d09ee 100644 --- a/tests/testthat/test-utils-cell-ranges.R +++ b/tests/testthat/test-utils-cell-ranges.R @@ -186,15 +186,15 @@ test_that("as_sheets_range() deals when one of lr limits is missing", { # commenting out, not skipping, because this is the only with_mock() #test_that("as_sheets_range() errors for limits that should be fixed by resolve_limits()", { - # I think cellranger::cell_limits() should do much less. - # Already planning here for such a change there. - # Here's a very crude version of what I have in mind. - # cl <- function(ul, lr) { - # structure( - # list(ul = as.integer(ul), lr = as.integer(lr), sheet = NA_character_), - # class = c("cell_limits", "list") - # ) - # } +# I think cellranger::cell_limits() should do much less. +# Already planning here for such a change there. +# Here's a very crude version of what I have in mind. +# cl <- function(ul, lr) { +# structure( +# list(ul = as.integer(ul), lr = as.integer(lr), sheet = NA_character_), +# class = c("cell_limits", "list") +# ) +# } # with_mock( # resolve_limits = function(x) x, # `cellranger:::cell_limits` = function(ul, lr, sheet) cl(ul, lr), { diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index c0fe1f1ef..1944f47e4 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -42,18 +42,18 @@ test_that("enforce_na() works", { expect_identical( enforce_na(c("a", "", "c")), - c("a", NA, "c") + c("a", NA, "c") ) expect_identical( enforce_na(c("a", "", "c"), na = "c"), - c("a", "", NA) + c("a", "", NA) ) expect_identical( enforce_na(c("abc", "", "cab"), na = c("abc", "")), - c( NA, NA, "cab") + c(NA, NA, "cab") ) expect_identical( enforce_na(c("a", "", "c"), na = character()), - c("a", "", "c") + c("a", "", "c") ) }) diff --git a/tools/test-fixtures/googlesheets4-col-types/lots-of-column-types.R b/tools/test-fixtures/googlesheets4-col-types/lots-of-column-types.R index 024ccc595..a77753efe 100644 --- a/tools/test-fixtures/googlesheets4-col-types/lots-of-column-types.R +++ b/tools/test-fixtures/googlesheets4-col-types/lots-of-column-types.R @@ -14,8 +14,12 @@ df <- tibble( integer = 1:4, double = 4:1 - 2.5, date = as.Date(c("2003-06-06", "1982-12-05", "2014-02-14", "1999-08-27")), - datetime = as.POSIXct(c("1978-05-31 04:24:32", "2006-07-19 23:27:37", - "2003-12-21 09:20:29", "1975-04-14 13:31:03")) + datetime = as.POSIXct(c( + "1978-05-31 04:24:32", + "2006-07-19 23:27:37", + "2003-12-21 09:20:29", + "1975-04-14 13:31:03" + )) ) sheet_write(df, ss, sheet = "lots-of-types")