Add sheets_create()

NAMESPACE

@@ -11,8 +11,8 @@ 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)
 export("%>%")
 export(anchored)
 export(as_sheets_id)
@@ -27,6 +27,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)

R/schema_GridRange.R

@@ -0,0 +1,40 @@
+# https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets/other#GridRange
+new_GridRange <- function(sheetId,
+                          startRowIndex,
+                          endRowIndex,
+                          startColumnIndex,
+                          endColumnIndex) {
+
+  x <- list(
+    sheetId = sheetId,
+    startRowIndex = startRowIndex,
+    endRowIndex = endRowIndex,
+    startColumnIndex = startColumnIndex,
+    endColumnIndex = endColumnIndex
+  )
+  structure(x, class = "GridRange")
+}
+
+validate_GridRange <- function(x) {
+  check_non_negative_integer(x$sheetId)
+  check_non_negative_integer(x$startRowIndex)
+  check_non_negative_integer(x$endRowIndex)
+  check_non_negative_integer(x$startColumnIndex)
+  check_non_negative_integer(x$endColumnIndex)
+  x
+}
+
+GridRange <- function(sheetId,
+                      startRowIndex,
+                      endRowIndex,
+                      startColumnIndex,
+                      endColumnIndex) {
+  x <- new_GridRange(
+    sheetId = sheetId,
+    startRowIndex = startRowIndex,
+    endRowIndex = endRowIndex,
+    startColumnIndex = startColumnIndex,
+    endColumnIndex = endColumnIndex
+  )
+  validate_GridRange(x)
+}

R/schema_NamedRange.R

@@ -0,0 +1,30 @@
+# https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets#NamedRange
+new_NamedRange <- function(namedRangeId,
+                           name,
+                           range) {
+  x <- list(
+    namedRangeId = namedRangeId,
+    name = name,
+    range = range
+  )
+  structure(
+    validate_NamedRange(x),
+    class = "NamedRange"
+  )
+}
+
+validate_NamedRange <- function(x) {
+  # I think read-only vs. required vs. optional status of these elements
+  # depends on what you're trying to do
+  maybe_string(x$namedRangeId, "namedRangeId")
+  maybe_string(x$name, "name")
+
+  validate_GridRange(x$range)
+
+  x
+}
+
+NamedRange <- function(...) {
+  x <- new_NamedRange(...)
+  compact(x)
+}

R/schema_Sheet.R

@@ -0,0 +1,27 @@
+# https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets/sheets#Sheet
+new_Sheet <- function(properties = NULL,
+                      data = NULL) {
+  # a Sheet object has MANY more elements, so I'm just starting with the ones
+  # I plan to use soon
+  x <- list(
+    properties = properties,
+    data = data
+  )
+  structure(validate_Sheet(x), class = "Sheet")
+}
+
+validate_Sheet <- function(x) {
+  if (!is.null(x$properties)) {
+    validate_SheetProperties(x)
+  }
+
+  # data is an instance of GridData
+
+  x
+}
+
+Sheet <- function(...) {
+  x <- new_Sheet(...)
+  compact(x)
+}
+

R/schema_SheetProperties.R

@@ -0,0 +1,43 @@
+# https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets/sheets#SheetProperties
+new_SheetProperties <- function(sheetId = NULL,
+                                title = NULL,
+                                index = NULL,
+                                sheetType = NULL,
+                                gridProperties = NULL,
+                                hidden = NULL,
+                                tabColor = NULL,
+                                rightToLeft = NULL) {
+  x <- list(
+    sheetId = sheetId,
+    title = title,
+    index = index,
+    sheetType = sheetType,
+    gridProperties = gridProperties,
+    hidden = hidden,
+    tabColor = tabColor,
+    rightToLeft = rightToLeft
+  )
+  structure(validate_SheetProperties(x), class = "SheetProperties")
+}
+
+validate_SheetProperties <- function(x) {
+  maybe_non_negative_integer(x$sheetId, "sheetId")
+  maybe_string(x$title, "title")
+  maybe_non_negative_integer(x$index, "index")
+  maybe_string(x$sheetType, "sheetType") # enum
+
+  # gridProperties is an instance of GridProperties
+
+  maybe_bool(x$hidden, "hidden")
+
+  # tabColor is an instance of Color
+
+  maybe_bool(x$rightToLeft, "rightToLeft")
+
+  x
+}
+
+SheetProperties <- function(...) {
+  x <- new_SheetProperties(...)
+  compact(x)
+}

R/schema_Spreadsheet.R

@@ -0,0 +1,164 @@
+# https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets#Spreadsheet
+new_Spreadsheet <- function(spreadsheetId = NULL,
+                            properties = NULL,
+                            sheets = NULL,
+                            namedRanges = NULL,
+                            spreadsheetUrl = NULL,
+                            developerMetadata = NULL) {
+  x <- list(
+    spreadsheetId = spreadsheetId,
+    properties = properties,
+    sheets = sheets,
+    namedRanges = namedRanges,
+    spreadsheetUrl = spreadsheetUrl,
+    developerMetadata = developerMetadata
+  )
+  structure(
+    validate_Spreadsheet(x),
+    class = "Spreadsheet"
+  )
+}
+
+validate_Spreadsheet <- function(x) {
+  maybe_string(x$spreadsheetId, "spreadsheetId")
+
+  if (!is.null(x$properties)) {
+    validate_SpreadsheetProperties(x$properties)
+  }
+
+  if (!is.null(x$sheets)) {
+    walk(x$sheets, validate_Sheet)
+  }
+
+  if (!is.null(x$namedRanges)) {
+    walk(x$namedRanges, validate_NamedRange)
+  }
+
+  maybe_string(x$spreadsheetUrl, "spreadsheetUrl")
+
+  # developerMetadata is an instance of DeveloperMetadata
+
+  x
+}
+
+Spreadsheet <- function(...) {
+  x <- new_Spreadsheet(...)
+  compact(x)
+}
+
+#  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)) {
+    # TODO: refactor in terms of a to-be-created sheets_Sheet()? changes the
+    # angle of attack to Sheet-wise, whereas here I work property-wise
+    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),
+      # TODO: refactor in terms of methods created around GridData?
+      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)) {
+    # 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)
+}

R/schema_SpreadsheetProperties.R

@@ -0,0 +1,38 @@
+# https://developers.google.com/sheets/api/reference/rest/v4/spreadsheets#SpreadsheetProperties
+new_SpreadsheetProperties <- function(title,
+                                      locale = NULL,
+                                      autoRecalc = NULL,
+                                      timeZone = NULL,
+                                      defaultFormat = NULL,
+                                      iterativeCalculationSettings = NULL) {
+  x <- list(
+    title = title,
+    locale = locale,
+    autoRecalc = autoRecalc,
+    timeZone = timeZone,
+    defaultFormat = defaultFormat,
+    iterativeCalculationSettings = iterativeCalculationSettings
+  )
+  structure(
+    validate_SpreadsheetProperties(x),
+    class = "SpreadsheetProperties"
+  )
+}
+
+validate_SpreadsheetProperties <- function(x) {
+  check_string(x$title, "title")
+
+  maybe_string(x$locale, "locale")
+  maybe_string(x$locale, "autoRecalc") # enum
+  maybe_string(x$timeZone, "timeZone")
+
+  # defaultFormat is an instance of CellFormat
+  # iterativeCalculationSettings is an instance of IterativeCalculationSettings
+
+  x
+}
+
+SpreadsheetProperties <- function(title, ...) {
+  x <- new_SpreadsheetProperties(title = title, ...)
+  compact(x)
+}