diff --git a/NAMESPACE b/NAMESPACE index 54fea664a..aef9ffa92 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,18 +1,22 @@ # Generated by roxygen2: do not edit by hand +S3method(as_Sheet,data.frame) S3method(as_sheets_id,"NULL") S3method(as_sheets_id,character) S3method(as_sheets_id,default) S3method(as_sheets_id,dribble) S3method(as_sheets_id,drive_id) +S3method(as_sheets_id,sheets_Spreadsheet) S3method(as_sheets_id,sheets_id) S3method(ctype,"NULL") S3method(ctype,SHEETS_CELL) S3method(ctype,character) S3method(ctype,default) S3method(ctype,list) -S3method(format,sheets_meta) -S3method(print,sheets_meta) +S3method(format,sheets_Spreadsheet) +S3method(print,sheets_Spreadsheet) +S3method(tibblify,googlesheets4_Sheet) +S3method(tibblify,googlesheets4_SheetProperties) export("%>%") export(anchored) export(as_sheets_id) @@ -27,6 +31,7 @@ export(sheets_auth) export(sheets_auth_configure) export(sheets_browse) export(sheets_cells) +export(sheets_create) export(sheets_deauth) export(sheets_endpoints) export(sheets_example) @@ -52,6 +57,7 @@ importFrom(purrr,"%||%") importFrom(purrr,compact) importFrom(purrr,discard) importFrom(purrr,flatten) +importFrom(purrr,imap) importFrom(purrr,keep) importFrom(purrr,map) importFrom(purrr,map2) @@ -63,4 +69,5 @@ importFrom(purrr,modify_if) importFrom(purrr,pluck) importFrom(purrr,pmap_chr) importFrom(purrr,set_names) +importFrom(purrr,transpose) importFrom(purrr,walk) diff --git a/NEWS.md b/NEWS.md index 761207c06..4937ab2a4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # googlesheets4 (development version) +* `sheets_create()` is a new function to create a new Sheet and, optionally, write one or more data frames into it (#61). *caution: function still under development* + # googlesheets4 0.1.0 * Added a `NEWS.md` file to track changes to the package. diff --git a/R/googlesheets4-package.R b/R/googlesheets4-package.R index 9b9b6994b..bb2b05c1f 100644 --- a/R/googlesheets4-package.R +++ b/R/googlesheets4-package.R @@ -1,4 +1,4 @@ #' @keywords internal #' @importFrom purrr %||% map_lgl map_int map_dbl map_chr map map2 pluck walk -#' pmap_chr set_names discard keep flatten modify_if compact +#' pmap_chr set_names discard keep flatten modify_if compact transpose imap "_PACKAGE" diff --git a/R/rectangle.R b/R/rectangle.R new file mode 100644 index 000000000..17402b463 --- /dev/null +++ b/R/rectangle.R @@ -0,0 +1,12 @@ +# low-tech typed version of tidyr::hoist() that is "list in, vector out" +hoist_lgl <- function(.x, ..., .default = NA) { + map_lgl(.x, ..., .default = .default) +} + +hoist_chr <- function(.x, ..., .default = NA) { + map_chr(.x, ..., .default = .default) +} + +hoist_int <- function(.x, ..., .default = NA) { + map_int(.x, ..., .default = .default) +} diff --git a/R/schema_Sheet.R b/R/schema_Sheet.R new file mode 100644 index 000000000..b60f9edd7 --- /dev/null +++ b/R/schema_Sheet.R @@ -0,0 +1,65 @@ +#' @export +tibblify.googlesheets4_Sheet <- function(x, ...) { + out <- tibblify(new("SheetProperties", !!!x$properties)) + # TODO: come back to deal with `data` + tibble::add_column(out, data = list(NULL)) +} + +as_Sheet <- function(df, name) { + UseMethod("as_Sheet") +} + +as_Sheet.default <- function(df, name) { + stop_glue( + "Don't know how to make an instance of {bt('Sheet')} from something of ", + "class {class_collapse(x)}." + ) +} + +#' @export +as_Sheet.data.frame <- function(df, name) { + check_string(name) + x <- new( + id = "Sheet", + properties = new( + id = "SheetProperties", + title = name, + gridProperties = list(rowCount = nrow(df) + 1, columnCount = ncol(df)) + ), + data = list( # an array of instances of GridData + list( + rowData = as_RowData(df) # an array of instances of RowData + ) + ) + ) +} + +as_RowData <- function(df) { + df_rows <- c(list(names(df)), transpose(df)) + make_row <- function(x) { + map(x, ~ list(userEnteredValue = list(stringValue = as.character(.x)))) + } + map(df_rows, ~ list(values = make_row(unname(.x)))) + # list( + # list( # row 1 + # values = list( + # list( # row 1 cell 1 + # userEnteredValue = list(stringValue = "A1") + # ), + # list( # row 1 cell 2 + # userEnteredValue = list(stringValue = "B1") + # ) + # ) + # ), + # list( # row 2 + # values = list( + # list( # row 2 cell 1 + # userEnteredValue = list(stringValue = "A2") + # ), + # list( # row 2 cell 2 + # userEnteredValue = list(stringValue = "B2") + # ) + # ) + # ) + # ) +} diff --git a/R/schema_SheetProperties.R b/R/schema_SheetProperties.R new file mode 100644 index 000000000..891937e6c --- /dev/null +++ b/R/schema_SheetProperties.R @@ -0,0 +1,16 @@ +#' @export +tibblify.googlesheets4_SheetProperties <- function(x, ...) { + # weird-looking workaround for the (current) lack of typed pluck() + # revisit this when I depend on vctrs directly + x <- list(x) + tibble::tibble( + # TODO: open question whether I should explicitly unescape title here + name = hoist_chr(x, "title"), + index = hoist_int(x, "index"), + id = hoist_int(x, "sheetId"), + type = hoist_chr(x, "sheetType"), + visible = !hoist_lgl(x, "hidden", .default = FALSE), + grid_rows = hoist_int(x, c("gridProperties", "rowCount")), + grid_columns = hoist_int(x, c("gridProperties", "columnCount")) + ) +} diff --git a/R/schema_Spreadsheet.R b/R/schema_Spreadsheet.R new file mode 100644 index 000000000..a7d07f131 --- /dev/null +++ b/R/schema_Spreadsheet.R @@ -0,0 +1,105 @@ +# input: instance of Spreadsheet, in the Sheets API sense, as a named list +# output: instance of sheets_Spreadsheet, which is how I want to hold this info +sheets_Spreadsheet <- function(x = list()) { + ours_theirs <- list( + spreadsheet_id = "spreadsheetId", + spreadsheet_url = "spreadsheetUrl", + name = list("properties", "title"), + locale = list("properties", "locale"), + time_zone = list("properties", "timeZone") + ) + out <- map(ours_theirs, ~ pluck(x, !!!.x)) + + if (!is.null(x$sheets)) { + sheets <- map(x$sheets, ~ new("Sheet", !!!.x)) + sheets <- map(sheets, tibblify) + out$sheets <- do.call(rbind, sheets) + } + + if (!is.null(x$namedRanges)) { + # TODO: refactor in terms of a to-be-created sheets_NamedRange()? changes + # the angle of attack to NamedRange-wise, whereas here I work column-wise + nr <- x$namedRanges + out$named_ranges <- tibble::tibble( + name = map_chr(nr, "name"), + range = NA_character_, + id = map_chr(nr, "namedRangeId"), + # if there is only 1 sheet, sheetId might not be sent! + # https://github.com/tidyverse/googlesheets4/issues/29 + sheet_id = map_chr(nr, c("range", "sheetId"), .default = NA), + sheet_name = NA_character_, + # TODO: extract into functions re: GridRange? + ## 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 = map_int(nr, c("range", "startRowIndex"), .default = NA) + 1L, + end_row = map_int(nr, c("range", "endRowIndex"), .default = NA), + start_column = map_int(nr, c("range", "startColumnIndex"), .default = NA) + 1L, + end_column = map_int(nr, c("range", "endColumnIndex"), .default = NA) + ) + no_sheet <- is.na(out$named_ranges$sheet_id) + if (any(no_sheet)) { + # if no associated sheetId, assume it's the first (only?) sheet + # https://github.com/tidyverse/googlesheets4/issues/29 + out$named_ranges$sheet_id[no_sheet] <- out$sheets$id[[1]] + } + out$named_ranges$sheet_name <- vlookup( + out$named_ranges$sheet_id, + data = out$sheets, + key = "id", + value = "name" + ) + out$named_ranges$range <- pmap_chr(out$named_ranges, make_range) + } + + structure(out, class = c("sheets_Spreadsheet", "list")) +} + +#' @export +format.sheets_Spreadsheet <- function(x, ...) { + + meta <- glue_data( + x, + " + Spreadsheet name: {name} + ID: {spreadsheet_id} + Locale: {locale} + Time zone: {time_zone} + # of sheets: {nrow(x$sheets)} + ", + .sep = "\n" + ) + meta <- strsplit(meta, split = "\n")[[1]] + + col1 <- fr(c("(Sheet name)", x$sheets$name)) + col2 <- c( + "(Nominal extent in rows x columns)", + glue_data(x$sheets, "{grid_rows} x {grid_columns}") + ) + meta <- c( + meta, + "", + glue_data(list(col1 = col1, col2 = col2), "{col1}: {col2}") + ) + + if (!is.null(x$named_ranges)) { + col1 <- fr(c("(Named range)", x$named_ranges$name)) + col2 <- fl(c("(A1 range)", x$named_ranges$range)) + meta <- c( + meta, + "", + glue_data(list(col1 = col1, col2 = col2), "{col1}: {col2}") + ) + } + + meta +} + +#' @export +print.sheets_Spreadsheet <- function(x, ...) { + cat(format(x), sep = "\n") + invisible(x) +} diff --git a/R/schemas.R b/R/schemas.R new file mode 100644 index 000000000..cda91e4ec --- /dev/null +++ b/R/schemas.R @@ -0,0 +1,66 @@ +new <- function(id, ...) { + schema <- .tidy_schemas[[id]] + if (is.null(schema)) { + rlang::abort(glue("Can't find a tidy schema with id {sq(id)}")) + } + dots <- rlang::list2(...) + + check_against_schema(dots, schema = schema) + + structure( + dots, + # explicit 'list' class is a bit icky but makes jsonlite happy + # in various vctrs futures, this could need revisiting + class = c(id_as_class(id), "googlesheets4_schema", "list"), + schema = schema + ) +} + +# TODO: if it proves necessary, this could do more meaningful checks +check_against_schema <- function(x, schema = NULL) { + schema <- schema %||% attr(x, "schema") + unexpected <- setdiff(names(x), schema$property) + if (length(unexpected) > 0) { + msg <- glue(" + Properties not recognized for the {sq(attr(schema, 'id'))} schema: + * {glue_collapse(unexpected, sep = ', ')} + ") + rlang::abort(msg) + } + invisible(x) +} + +id_as_class <- function(id) glue("googlesheets4_{id}") + +id_from_class <- function(x) { + m <- grep("^googlesheets4_", class(x), value = TRUE)[[1]] + sub("^googlesheets4_", "", m) +} + +# patch ---- +patch <- function(x, ...) { + UseMethod("patch") +} + +patch.default <- function(x, ...) { + stop_glue(" + Don't know how to {bt('patch()')} an object of class {class_collapse(x)} + ") +} + +patch.googlesheets4_schema <- function(x, ...) { + dots <- rlang::list2(...) + x[names(dots)] <- dots + check_against_schema(x) +} + +# tibblify ---- +tibblify <- function(x, ...) { + UseMethod("tibblify") +} + +tibblify.default <- function(x, ...) { + stop_glue(" + Don't know how to {bt('tibblify()')} an object of class {class_collapse(x)} + ") +} diff --git a/R/sheets_create.R b/R/sheets_create.R new file mode 100644 index 000000000..9499958b6 --- /dev/null +++ b/R/sheets_create.R @@ -0,0 +1,54 @@ +#' Create a new Sheet +#' +#' Creates an entirely new Sheet (spreadsheet or workbook). Offers some control +#' over the initial set of sheets (worksheets or tabs). CAUTION: this function +#' is still being developed and, for example, currently sends all data as +#' character. +#' +#' @seealso Wraps the `spreadsheets.create` endpoint: +#' * +#' +#' @param name The name of the spreadsheet. +#' @param ... Optional spreadsheet properties that can be set through this API +#' endpoint, such as locale and time zone. +#' @param sheets Optional named list of data frames. One sheet is created for +#' each data frame. +#' +#' @inherit sheets_get return +#' @export +#' +#' @examples +#' if (sheets_has_token()) { +#' sheets_create("sheets-create-demo-1") +#' +#' sheets_create("sheets-create-demo-2", locale = "en_CA") +#' +#' sheets_create( +#' "sheets-create-demo-3", +#' locale = "fr_FR", +#' timeZone = "Europe/Paris" +#' ) +#' +#' sheets_create( +#' "sheets-create-demo-4", +#' sheets = list(iris = head(iris), mtcars = head(mtcars)) +#' ) +#' } +sheets_create <- function(name, ..., sheets = NULL) { + ss_body <- new("Spreadsheet") %>% + patch(properties = new( + id = "SpreadsheetProperties", + title = name, ... + )) + if (!is.null(sheets)) { + ss_body <- ss_body %>% + patch(sheets = unname(imap(sheets, as_Sheet))) + } + req <- request_generate( + "sheets.spreadsheets.create", + params = ss_body + ) + raw_resp <- request_make(req) + resp <- gargle::response_process(raw_resp) + sheets_Spreadsheet(resp) +} diff --git a/R/sheets_get.R b/R/sheets_get.R index 29018cbd9..113c70c8c 100644 --- a/R/sheets_get.R +++ b/R/sheets_get.R @@ -10,7 +10,7 @@ #' @inheritParams read_sheet #' #' @return -#' * `sheets_get()`: A list with S3 class `sheets_meta`, for printing +#' * `sheets_get()`: A list with S3 class `sheets_Spreadsheet`, for printing #' purposes. #' * `sheets_sheets()`: A character vector. #' @export @@ -21,7 +21,7 @@ #' } sheets_get <- function(ss) { resp <- sheets_get_impl_(as_sheets_id(ss)) - sheets_spreadsheet(resp) + sheets_Spreadsheet(resp) } #' @export @@ -50,115 +50,3 @@ sheets_get_impl_ <- function(ssid, raw_resp <- request_make(req) gargle::response_process(raw_resp) } - -## input: an instance of Spreadsheet -## https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets#Spreadsheet -## output: a list with S3 class `sheets_meta` -sheets_spreadsheet <- function(x = list()) { - ours_theirs <- list( - spreadsheet_id = "spreadsheetId", - spreadsheet_url = "spreadsheetUrl", - name = list("properties", "title"), - locale = list("properties", "locale"), - time_zone = list("properties", "timeZone") - ) - out <- map(ours_theirs, ~ pluck(x, !!!.x)) - - if (!is.null(x$sheets)) { - p <- map(x$sheets, "properties") - out$sheets <- tibble::tibble( - # TODO: open question whether I should explicitly unescape here - name = map_chr(p, "title"), - index = map_int(p, "index"), - id = map_chr(p, "sheetId"), - type = map_chr(p, "sheetType"), - visible = !map_lgl(p, "hidden", .default = FALSE), - grid_rows = map_int(p, c("gridProperties", "rowCount"), .default = NA), - grid_columns = map_int(p, c("gridProperties", "columnCount"), .default = NA) - ) - } - - if (!is.null(x$namedRanges)) { - nr <- x$namedRanges - out$named_ranges <- tibble::tibble( - name = map_chr(nr, "name"), - range = NA_character_, - id = map_chr(nr, "namedRangeId"), - # if there is only 1 sheet, sheetId might not be sent! - # https://github.com/tidyverse/googlesheets4/issues/29 - sheet_id = map_chr(nr, c("range", "sheetId"), .default = NA), - sheet_name = NA_character_, - ## 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 = map_int(nr, c("range", "startRowIndex"), .default = NA) + 1L, - end_row = map_int(nr, c("range", "endRowIndex"), .default = NA), - start_column = map_int(nr, c("range", "startColumnIndex"), .default = NA) + 1L, - end_column = map_int(nr, c("range", "endColumnIndex"), .default = NA) - ) - no_sheet <- is.na(out$named_ranges$sheet_id) - if (any(no_sheet)) { - # if no associated sheetId, assume it's the first (only?) sheet - # https://github.com/tidyverse/googlesheets4/issues/29 - out$named_ranges$sheet_id[no_sheet] <- out$sheets$id[[1]] - } - out$named_ranges$sheet_name <- vlookup( - out$named_ranges$sheet_id, - data = out$sheets, - key = "id", - value = "name" - ) - out$named_ranges$range <- purrr::pmap_chr(out$named_ranges, make_range) - } - - structure(out, class = c("sheets_meta", "list")) -} - -#' @export -format.sheets_meta <- function(x, ...) { - - meta <- glue_data( - x, - " - Spreadsheet name: {name} - ID: {spreadsheet_id} - Locale: {locale} - Time zone: {time_zone} - # of sheets: {nrow(x$sheets)} - ", - .sep = "\n" - ) - meta <- strsplit(meta, split = "\n")[[1]] - - col1 <- fr(c("(Sheet name)", x$sheets$name)) - col2 <- c( - "(Nominal extent in rows x columns)", - glue_data(x$sheets, "{grid_rows} x {grid_columns}") - ) - meta <- c( - meta, - "", - glue_data(list(col1 = col1, col2 = col2), "{col1}: {col2}") - ) - - if (!is.null(x$named_ranges)) { - col1 <- fr(c("(Named range)", x$named_ranges$name)) - col2 <- fl(c("(A1 range)", x$named_ranges$range)) - meta <- c( - meta, - "", - glue_data(list(col1 = col1, col2 = col2), "{col1}: {col2}") - ) - } - - meta -} - -#' @export -print.sheets_meta <- function(x, ...) { - cat(format(x), sep = "\n") - invisible(x) -} diff --git a/R/sheets_id.R b/R/sheets_id.R index d025ae73c..95921c5a7 100644 --- a/R/sheets_id.R +++ b/R/sheets_id.R @@ -56,18 +56,24 @@ sheets_id <- function(x) { #' * Spreadsheet id, "a string containing letters, numbers, and some special #' characters", typically 44 characters long, in our experience. Example: #' `1qpyC0XzvTcKT6EISywvqESX3A0MwQoFDE8p-Bll4hps`. -#' * A URL, from which we can excavate a spreadsheet or file id. Example: . +#' * A URL, from which we can excavate a spreadsheet or file id. Example: +#' . #' * A one-row [`dribble`][googledrive::dribble], a "Drive tibble" used by the -#' [googledrive] package. In general, a `dribble` can represent several files, -#' one row per file. Since googlesheets4 is not vectorized over spreadsheets, -#' we are only prepared to accept a one-row `dribble`. -#' - [`googledrive::drive_get("YOUR SHEET NAME")`][googledrive::drive_get()] +#' [googledrive] package. In general, a `dribble` can represent several +#' files, one row per file. Since googlesheets4 is not vectorized over +#' spreadsheets, we are only prepared to accept a one-row `dribble`. +#' - [`googledrive::drive_get("YOUR_SHEET_NAME")`][googledrive::drive_get()] #' is a great way to look up a Sheet via its name. +#' - [`sheets_find("YOUR_SHEET_NAME")`][sheets_find()] is another good way +#' to get your hands on a Sheet. +#' * Spreadsheet meta data, as returned by, e.g., [sheets_get()]. Literally, +#' this is an object of class `sheets_Spreadsheet`. #' #' @description This is a generic function. #' #' @param x Something that uniquely identifies a Google Sheet: a [`sheets_id`], -#' URL, or [`dribble`][googledrive::dribble]. +#' a URL, one-row [`dribble`][googledrive::dribble], or a +#' `sheets_Spreadsheet`. #' @param ... Other arguments passed down to methods. (Not used.) #' @export #' @examples @@ -134,6 +140,11 @@ as_sheets_id.character <- function(x, ...) { sheets_id(out) } +#' @export +as_sheets_id.sheets_Spreadsheet <- function(x, ...) { + new_sheets_id(x$spreadsheet_id) +} + ## copied from googledrive one_id <- function(x) { if (!grepl("^http|/", x)) return(x) diff --git a/R/sysdata.rda b/R/sysdata.rda index 9cb1e5198..dc5157146 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/utils.R b/R/utils.R index 0a1edd385..ec06bcd31 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,5 +1,8 @@ `%NA%` <- function(x, y) if (is.na(x)) y else x +# for development only +str1 <- function(x, ...) utils::str(x, ..., max.level = 1) + noNA <- Negate(anyNA) allNA <- function(x) all(is.na(x)) notNA <- Negate(is.na) diff --git a/README.md b/README.md index 6b53528bf..8e327a1c6 100644 --- a/README.md +++ b/README.md @@ -79,13 +79,13 @@ sheets_example("chicken-sheet") %>% #> Reading from 'chicken-sheet' #> #> # A tibble: 5 x 4 -#> chicken breed sex motto -#> -#> 1 Foghorn Leghorn Leghorn roost… That's a joke, ah say, that's a jo… -#> 2 Chicken Little unknown hen The sky is falling! -#> 3 Ginger Rhode Islan… hen Listen. We'll either die free chic… -#> 4 Camilla the Chic… Chantecler hen Bawk, buck, ba-gawk. -#> 5 Ernie The Giant … Brahma roost… Put Captain Solo in the cargo hold. +#> chicken breed sex motto +#> +#> 1 Foghorn Leghorn Leghorn roost… That's a joke, ah say, that's a joke,… +#> 2 Chicken Little unknown hen The sky is falling! +#> 3 Ginger Rhode Island… hen Listen. We'll either die free chicken… +#> 4 Camilla the Chick… Chantecler hen Bawk, buck, ba-gawk. +#> 5 Ernie The Giant C… Brahma roost… Put Captain Solo in the cargo hold. ``` Read specific cells, from a specific sheet, using an A1-style notation: @@ -96,19 +96,18 @@ sheets_example("deaths") %>% #> Reading from 'deaths' #> Range "'arts'!A5:F15" #> # A tibble: 10 x 6 -#> Name Profession Age `Has kids` `Date of birth` -#> -#> 1 Davi… musician 69 TRUE 1947-01-08 00:00:00 -#> 2 Carr… actor 60 TRUE 1956-10-21 00:00:00 -#> 3 Chuc… musician 90 TRUE 1926-10-18 00:00:00 -#> 4 Bill… actor 61 TRUE 1955-05-17 00:00:00 -#> 5 Prin… musician 57 TRUE 1958-06-07 00:00:00 -#> 6 Alan… actor 69 FALSE 1946-02-21 00:00:00 -#> 7 Flor… actor 82 TRUE 1934-02-14 00:00:00 -#> 8 Harp… author 89 FALSE 1926-04-28 00:00:00 -#> 9 Zsa … actor 99 TRUE 1917-02-06 00:00:00 -#> 10 Geor… musician 53 FALSE 1963-06-25 00:00:00 -#> # … with 1 more variable: `Date of death` +#> Name Profession Age `Has kids` `Date of birth` `Date of death` +#> +#> 1 David Bo… musician 69 TRUE 1947-01-08 00:00:00 2016-01-10 00:00:00 +#> 2 Carrie F… actor 60 TRUE 1956-10-21 00:00:00 2016-12-27 00:00:00 +#> 3 Chuck Be… musician 90 TRUE 1926-10-18 00:00:00 2017-03-18 00:00:00 +#> 4 Bill Pax… actor 61 TRUE 1955-05-17 00:00:00 2017-02-25 00:00:00 +#> 5 Prince musician 57 TRUE 1958-06-07 00:00:00 2016-04-21 00:00:00 +#> 6 Alan Ric… actor 69 FALSE 1946-02-21 00:00:00 2016-01-14 00:00:00 +#> 7 Florence… actor 82 TRUE 1934-02-14 00:00:00 2016-11-24 00:00:00 +#> 8 Harper L… author 89 FALSE 1926-04-28 00:00:00 2016-02-19 00:00:00 +#> 9 Zsa Zsa … actor 99 TRUE 1917-02-06 00:00:00 2016-12-18 00:00:00 +#> 10 George M… musician 53 FALSE 1963-06-25 00:00:00 2016-12-25 00:00:00 ``` Read from a named range or region and specify (some of the ) column @@ -120,18 +119,18 @@ sheets_example("deaths") %>% #> Reading from 'deaths' #> Range "arts_data" #> # A tibble: 10 x 6 -#> Name Profession Age `Has kids` `Date of birth` `Date of death` -#> -#> 1 David Bowie musician 69 TRUE 1947-01-08 2016-01-10 -#> 2 Carrie Fish… actor 60 TRUE 1956-10-21 2016-12-27 -#> 3 Chuck Berry musician 90 TRUE 1926-10-18 2017-03-18 -#> 4 Bill Paxton actor 61 TRUE 1955-05-17 2017-02-25 -#> 5 Prince musician 57 TRUE 1958-06-07 2016-04-21 -#> 6 Alan Rickman actor 69 FALSE 1946-02-21 2016-01-14 -#> 7 Florence He… actor 82 TRUE 1934-02-14 2016-11-24 -#> 8 Harper Lee author 89 FALSE 1926-04-28 2016-02-19 -#> 9 Zsa Zsa Gáb… actor 99 TRUE 1917-02-06 2016-12-18 -#> 10 George Mich… musician 53 FALSE 1963-06-25 2016-12-25 +#> Name Profession Age `Has kids` `Date of birth` `Date of death` +#> +#> 1 David Bowie musician 69 TRUE 1947-01-08 2016-01-10 +#> 2 Carrie Fisher actor 60 TRUE 1956-10-21 2016-12-27 +#> 3 Chuck Berry musician 90 TRUE 1926-10-18 2017-03-18 +#> 4 Bill Paxton actor 61 TRUE 1955-05-17 2017-02-25 +#> 5 Prince musician 57 TRUE 1958-06-07 2016-04-21 +#> 6 Alan Rickman actor 69 FALSE 1946-02-21 2016-01-14 +#> 7 Florence Henders… actor 82 TRUE 1934-02-14 2016-11-24 +#> 8 Harper Lee author 89 FALSE 1926-04-28 2016-02-19 +#> 9 Zsa Zsa Gábor actor 99 TRUE 1917-02-06 2016-12-18 +#> 10 George Michael musician 53 FALSE 1963-06-25 2016-12-25 ``` There are various ways to specify the target Sheet. The simplest, but @@ -144,13 +143,13 @@ read_sheet(url) #> Reading from 'chicken-sheet' #> #> # A tibble: 5 x 4 -#> chicken breed sex motto -#> -#> 1 Foghorn Leghorn Leghorn roost… That's a joke, ah say, that's a jo… -#> 2 Chicken Little unknown hen The sky is falling! -#> 3 Ginger Rhode Islan… hen Listen. We'll either die free chic… -#> 4 Camilla the Chic… Chantecler hen Bawk, buck, ba-gawk. -#> 5 Ernie The Giant … Brahma roost… Put Captain Solo in the cargo hold. +#> chicken breed sex motto +#> +#> 1 Foghorn Leghorn Leghorn roost… That's a joke, ah say, that's a joke,… +#> 2 Chicken Little unknown hen The sky is falling! +#> 3 Ginger Rhode Island… hen Listen. We'll either die free chicken… +#> 4 Camilla the Chick… Chantecler hen Bawk, buck, ba-gawk. +#> 5 Ernie The Giant C… Brahma roost… Put Captain Solo in the cargo hold. ``` For more information, see the package website: diff --git a/data-raw/discovery-doc-prep.R b/data-raw/discovery-doc-prep.R index d7eb628ae..11f443f21 100644 --- a/data-raw/discovery-doc-prep.R +++ b/data-raw/discovery-doc-prep.R @@ -4,6 +4,10 @@ source( system.file("discovery-doc-ingest", "ingest-functions.R", package = "gargle") ) +# if my use of schemas works out well, maybe this will migrate upstream into +# gargle and join the other ingest helpers +source(here::here("data-raw", "schema-rectangling.R")) + x <- download_discovery_document("sheets:v4") dd <- read_discovery_document(x) @@ -23,4 +27,30 @@ attr(.endpoints, "base_url") <- dd$rootUrl # to the "flattened" or "inlined" representation currently in .endpoints .schemas <- pluck(dd, "schemas") -usethis::use_data(.endpoints, .schemas, internal = TRUE, overwrite = TRUE) +these <- c( + "Spreadsheet", + "SpreadsheetProperties", + "Sheet", + "SheetProperties", + "NamedRange", + "GridRange" +) + +.tidy_schemas <- these %>% + set_names() %>% + map(schema_rectangle) +# View(.tidy_schemas) + +fs::dir_create(here::here("data-raw", "schemas")) +write_one <- function(data, id) { + sink(here::here("data-raw", "schemas", id)) + cat("#", id, " \n") + print(data) + sink() +} +iwalk(.tidy_schemas, write_one) + +usethis::use_data( + .endpoints, .schemas, .tidy_schemas, + internal = TRUE, overwrite = TRUE +) diff --git a/data-raw/schema-rectangling.R b/data-raw/schema-rectangling.R new file mode 100644 index 000000000..bc4e7ec31 --- /dev/null +++ b/data-raw/schema-rectangling.R @@ -0,0 +1,53 @@ +schema_rectangle <- function(s) { + if (!"tidyverse" %in% .packages()) { + stop("Attach the tidyverse package before using schema_rectangle()") + } + schema <- pluck(.schemas, s) + if (schema$type != "object") { + msg <- glue::glue( + "Schema must be of type {sq('object')}, not {sq(schema$type)}" + ) + stop(msg) + } + + properties <- pluck(schema, "properties") + scaffold <- list( + 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)) + + df <- df %>% + mutate(property = names(properties)) %>% + select(property, everything()) %>% + unnest_wider(properties) %>% + select(-description) %>% + mutate(type = replace_na(type, "object")) %>% + rename(instance_of = "$ref") + + # workaround for https://github.com/tidyverse/tidyr/issues/806 + repair <- function(x) { + map_if(x, ~ inherits(.x, "vctrs_unspecified"), ~ vctrs::unspecified(0)) + } + df <- modify_if(df, is_list, repair) + + df <- df %>% + hoist(items, array_of = "$ref") + + df <- df %>% + mutate(new = map2(enum, enumDescriptions, ~ tibble(enum = .x, enumDesc = .y))) %>% + select(-starts_with("enum")) %>% + rename(enum = new) %>% + mutate(type = if_else(map_lgl(enum, ~ nrow(.x) > 0), "enum", type)) + + attr(df, "id") <- s + + df %>% + filter(property != "scaffold") %>% + arrange(property) +} diff --git a/data-raw/schemas/GridRange b/data-raw/schemas/GridRange new file mode 100644 index 000000000..75126d78b --- /dev/null +++ b/data-raw/schemas/GridRange @@ -0,0 +1,9 @@ +# GridRange +# A tibble: 5 x 6 + property type instance_of array_of format enum + +1 endColumnIndex integer int32 +2 endRowIndex integer int32 +3 sheetId integer int32 +4 startColumnIndex integer int32 +5 startRowIndex integer int32 diff --git a/data-raw/schemas/NamedRange b/data-raw/schemas/NamedRange new file mode 100644 index 000000000..20998e7e5 --- /dev/null +++ b/data-raw/schemas/NamedRange @@ -0,0 +1,7 @@ +# NamedRange +# A tibble: 3 x 6 + property type instance_of array_of format enum + +1 name string +2 namedRangeId string +3 range object GridRange diff --git a/data-raw/schemas/Sheet b/data-raw/schemas/Sheet new file mode 100644 index 000000000..805c38818 --- /dev/null +++ b/data-raw/schemas/Sheet @@ -0,0 +1,17 @@ +# Sheet +# A tibble: 13 x 6 + property type instance_of array_of format enum + + 1 bandedRanges array BandedRange EmbeddedChart DimensionGroup ConditionalFormatR… GridData DeveloperMetadata FilterView GridRange ProtectedRange DimensionGroup Slicer +1 gridProperties object GridProperties +2 hidden boolean +3 index integer int32 +4 rightToLeft boolean +5 sheetId integer int32 +6 sheetType enum +7 tabColor object Color +8 title string diff --git a/data-raw/schemas/Spreadsheet b/data-raw/schemas/Spreadsheet new file mode 100644 index 000000000..cc14ecba6 --- /dev/null +++ b/data-raw/schemas/Spreadsheet @@ -0,0 +1,10 @@ +# Spreadsheet +# A tibble: 6 x 6 + property type instance_of array_of format enum + +1 developerMetada… array DeveloperMetad… NamedRange Sheet +1 autoRecalc enum