Upgrade most errors to expose appropriate call

Closes #255

I haven't done this to a 100% level, but I think I've covered the vast majority of errors that users are likely to bump into.

Feels like an appropriate place to stop for now in terms of effort vs. payoff.

Author: jennybc

R/ctype.R

@@ -165,10 +165,16 @@ infer_ctype <- function(cell, na = "", trim_ws = TRUE) {
       string = "CELL_TEXT",
       boolean = "CELL_LOGICAL",
       formula = {
-        warn("Internal warning: Cell has formula as effectiveValue. I thought impossible!")
+        cli::cli_warn("
+          Internal warning from googlesheets4: \\
+          Cell has formula as effectiveValue. \\
+          I thought this was impossible!")
         "CELL_TEXT"
       },
-      gs4_abort("Unhandled effective_type: {.field {effective_type}}")
+      gs4_abort(
+        "Unhandled effective_type: {.field {effective_type}}",
+        .internal = TRUE
+      )
     ))
   }
   # only numeric cells remain

R/get_cells.R

@@ -5,16 +5,17 @@ get_cells <- function(ss,
                       col_names_in_sheet = TRUE,
                       skip = 0, n_max = Inf,
                       detail_level = c("default", "full"),
-                      discard_empty = TRUE) {
+                      discard_empty = TRUE,
+                      call = caller_env()) {
   ssid <- as_sheets_id(ss)
 
-  maybe_sheet(sheet)
-  check_range(range)
-  check_bool(col_names_in_sheet)
-  check_non_negative_integer(skip)
-  check_non_negative_integer(n_max)
+  maybe_sheet(sheet, call = call)
+  check_range(range, call = call)
+  check_bool(col_names_in_sheet, call = call)
+  check_non_negative_integer(skip, call = call)
+  check_non_negative_integer(n_max, call = call)
   detail_level <- match.arg(detail_level)
-  check_bool(discard_empty)
+  check_bool(discard_empty, call = call)
 
   ## retrieve spreadsheet metadata --------------------------------------------
   x <- gs4_get(ssid)

R/gs4_example.R

@@ -46,30 +46,40 @@ gs4_example <- function(matches) {
   )
 }
 
-many_sheets <- function(needle, haystack, adjective) {
+many_sheets <- function(needle, haystack, adjective, call = caller_env()) {
   out <- haystack
 
   if (!missing(needle)) {
-    check_string(needle)
+    check_string(needle, call = call)
     sel <- grepl(needle, names(out), ignore.case = TRUE)
     if (!any(sel)) {
-      gs4_abort("Can't find {adjective} Sheet that matches {.q {needle}}.")
+      gs4_abort(
+        "Can't find {adjective} Sheet that matches {.q {needle}}.",
+        call = call)
     }
     out <- as_id(out[sel])
   }
 
   out
 }
 
-one_sheet <- function(needle, haystack, adjective) {
-  check_string(needle)
-  out <- many_sheets(needle = needle, haystack = haystack, adjective = adjective)
+one_sheet <- function(needle, haystack, adjective, call = caller_env()) {
+  check_string(needle, call = call)
+  out <- many_sheets(
+    needle = needle,
+    haystack = haystack,
+    adjective = adjective,
+    call = call
+  )
   if (length(out) > 1) {
-    gs4_abort(c(
-      "Found multiple matching {adjective} Sheets:",
-      bulletize(gargle_map_cli(names(out), template = "{.s_sheet <<x>>}")),
-      i = "Make the {.arg matches} regular expression more specific."
-    ))
+    gs4_abort(
+      c(
+        "Found multiple matching {adjective} Sheets:",
+        bulletize(gargle_map_cli(names(out), template = "{.s_sheet <<x>>}")),
+        i = "Make the {.arg matches} regular expression more specific."
+      ),
+      call = call
+    )
   }
   as_sheets_id(out)
 }

R/make_column.R

@@ -49,7 +49,10 @@ gs4_parse <- function(x, ctype, ...) {
     COL_CELL      = as_cell,
     COL_LIST      = as_list,
     ## TODO: factor, duration
-    gs4_abort("Not a recognized column type: {.field {ctype}}")
+    gs4_abort(
+      "Not a recognized column type: {.field {ctype}}",
+      .internal = TRUE
+    )
   )
   if (inherits(x, "SHEETS_CELL")) {
     x <- list(x)

R/range_add_validation.R

@@ -135,8 +135,10 @@ new_BooleanCondition <- function(type = "NOT_BLANK", values = NULL) {
     "DATE_BEFORE", "DATE_AFTER", "DATE_ON_OR_BEFORE", "DATE_ON_OR_AFTER"
   )
   if (type %in% needs_relative_date) {
-    gs4_abort("
-      {.field relativeDate} not yet supported as a {.code conditionValue}.")
+    gs4_abort(
+      "{.field relativeDate} not yet supported as a {.code conditionValue}.",
+      .internal = TRUE
+    )
   }
   patch(out, values = map(values, ~ list(userEnteredValue = as.character(.x))))
 }

R/range_autofit.R

@@ -119,7 +119,7 @@ force_cell_limits <- function(x) {
   x
 }
 
-check_only_one_dimension <- function(x) {
+check_only_one_dimension <- function(x, call = caller_env()) {
   limits <- x$cell_limits
 
   if (is.na(limits$ul[1]) && is.na(limits$lr[1])) {
@@ -129,8 +129,10 @@ check_only_one_dimension <- function(x) {
     return(invisible(x))
   }
 
-  gs4_abort("
-    The {.arg range} must target only columns or only rows, but not both.")
+  gs4_abort(
+    "The {.arg range} must target only columns or only rows, but not both.",
+    call = call
+  )
 }
 
 determine_dimension <- function(x) {

R/range_delete.R

@@ -116,7 +116,7 @@ range_delete <- function(ss,
   invisible(ssid)
 }
 
-determine_shift <- function(gr) {
+determine_shift <- function(gr, call = caller_env()) {
   stopifnot(inherits(gr, "googlesheets4_schema_GridRange"))
   bounded_on_bottom <- !is.null(gr$endRowIndex) && notNA(gr$endRowIndex)
   bounded_on_right <- !is.null(gr$endColumnIndex) && notNA(gr$endColumnIndex)
@@ -133,9 +133,12 @@ determine_shift <- function(gr) {
     return("COLUMNS")
   }
 
-  gs4_abort(c(
-    "{.arg range} must be bounded on the bottom and/or on the right.",
-    i = "Use {.fun sheet_delete} or {.fun sheet_resize} to delete or \\
-         resize a (work)sheet."
-  ))
+  gs4_abort(
+    c(
+      "{.arg range} must be bounded on the bottom and/or on the right.",
+      i = "Use {.fun sheet_delete} or {.fun sheet_resize} to delete or \\
+           resize a (work)sheet."
+    ),
+    call = call
+  )
 }

R/range_read.R

@@ -94,7 +94,7 @@ range_read <- function(ss,
                        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)
+  col_spec <- standardise_col_spec(col_names, col_types, call = current_env())
   check_character(na)
   check_bool(trim_ws)
   check_non_negative_integer(guess_max)
@@ -150,7 +150,7 @@ spread_sheet <- function(df,
                          na = "", trim_ws = TRUE,
                          guess_max = min(1000, max(df$row)),
                          .name_repair = "unique") {
-  col_spec <- standardise_col_spec(col_names, col_types)
+  col_spec <- standardise_col_spec(col_names, col_types, call = current_env())
   check_character(na)
   check_bool(trim_ws)
   check_non_negative_integer(guess_max)
@@ -168,7 +168,8 @@ spread_sheet_impl_ <- function(df,
                                ),
                                na = "", trim_ws = TRUE,
                                guess_max = min(1000, max(df$row)),
-                               .name_repair = "unique") {
+                               .name_repair = "unique",
+                               call = caller_env()) {
   if (nrow(df) == 0) {
     return(tibble::tibble())
   }
@@ -186,7 +187,12 @@ spread_sheet_impl_ <- function(df,
   if (is.logical(col_names)) {
     # if col_names is logical, this is first chance to check/set length of
     # ctypes, using the cell data
-    ctypes <- rep_ctypes(max(df$col), ctypes, "column{?s} found in sheet")
+    ctypes <- rep_ctypes(
+      max(df$col),
+      ctypes,
+      "column{?s} found in sheet",
+      call = call
+    )
   }
 
   # drop cells in skipped cols, update df$col and ctypes
@@ -201,11 +207,14 @@ spread_sheet_impl_ <- function(df,
   # if column names were provided explicitly, we need to check that length
   # of col_names (and, therefore, ctypes) == nc
   if (is.character(col_names) && length(col_names) != nc) {
-    gs4_abort(c(
-      "Length of {.arg col_names} is not compatible with the data:",
-      "*" = "{.arg col_names} has length {length(col_names)}.",
-      x = "But data has {nc} un-skipped column{?s}."
-    ))
+    gs4_abort(
+      c(
+        "Length of {.arg col_names} is not compatible with the data:",
+        "*" = "{.arg col_names} has length {length(col_names)}.",
+        "x" = "But data has {nc} un-skipped column{?s}."
+      ),
+      call = call
+    )
   }
 
   df$cell <- apply_ctype(df$cell, na = na, trim_ws = trim_ws)
@@ -236,58 +245,71 @@ spread_sheet_impl_ <- function(df,
 
 ## helpers ---------------------------------------------------------------------
 
-standardise_col_spec <- function(col_names, col_types) {
-  check_col_names(col_names)
-  ctypes <- standardise_ctypes(col_types)
+standardise_col_spec <- function(col_names, col_types, call = caller_env()) {
+  check_col_names(col_names, call = call)
+  ctypes <- standardise_ctypes(col_types, call = call)
   if (is.character(col_names)) {
-    ctypes <- rep_ctypes(length(col_names), ctypes, "column name{?s}")
+    ctypes <- rep_ctypes(
+      length(col_names),
+      ctypes,
+      "column name{?s}",
+      call = call
+    )
     col_names <- filter_col_names(col_names, ctypes)
     # if column names were provided explicitly, this is now true
     # length(col_names) == length(ctypes[ctypes != "COL_SKIP"])
   }
   list(col_names = col_names, ctypes = ctypes)
 }
 
-check_col_names <- function(col_names) {
+check_col_names <- function(col_names, call = caller_env()) {
   if (is.logical(col_names)) {
-    return(check_bool(col_names))
+    return(check_bool(col_names, call = call))
   }
-  check_character(col_names)
-  check_has_length(col_names)
+  check_character(col_names, call = call)
+  check_has_length(col_names, call = call)
 }
 
 # input:  a string of readr-style shortcodes or NULL
 # output: a vector of col types of length >= 1
-standardise_ctypes <- function(col_types) {
+standardise_ctypes <- function(col_types, call = caller_env()) {
   col_types <- col_types %||% "?"
-  check_string(col_types)
+  check_string(col_types, call = call)
 
   if (identical(col_types, "")) {
     gs4_abort("
       {.arg col_types}, when provided, must be a string that contains at \\
-      least one readr-style shortcode.")
+      least one readr-style shortcode.",
+      call = call
+    )
   }
 
   accepted_codes <- keep(names(.ctypes), nzchar)
 
   col_types_split <- strsplit(col_types, split = "")[[1]]
   ok <- col_types_split %in% accepted_codes
   if (!all(ok)) {
-    gs4_abort(c(
-      "{.arg col_types} must be a string of readr-style shortcodes. \\
-       Unrecognized code{?s}{cli::qty(sum(!ok))}:",
-      bulletize(gargle_map_cli(col_types_split[!ok]), bullet = "x")
-    ))
+    gs4_abort(
+      c(
+        "{.arg col_types} must be a string of readr-style shortcodes. \\
+         Unrecognized code{?s}{cli::qty(sum(!ok))}:",
+        bulletize(gargle_map_cli(col_types_split[!ok]), bullet = "x")
+      ),
+      call = call
+    )
   }
   ctypes <- ctype(col_types_split)
   if (all(ctypes == "COL_SKIP")) {
-    gs4_abort("{.arg col_types} can't request that all columns be skipped.")
+    gs4_abort(
+      "{.arg col_types} can't request that all columns be skipped.",
+      call = call
+    )
   }
   ctypes
 }
 
 # makes sure there are n ctypes or n ctypes that are not COL_SKIP
-rep_ctypes <- function(n, ctypes, comparator = "n") {
+rep_ctypes <- function(n, ctypes, comparator = "n", call = caller_env()) {
   if (length(ctypes) == n) {
     return(ctypes)
   }
@@ -302,12 +324,15 @@ rep_ctypes <- function(n, ctypes, comparator = "n") {
   # column{?s} found in sheet
   # column name{?s}
   comparator <- cli::pluralize(sprintf("{cli::qty(n)}%s{?s}", comparator))
-  gs4_abort(c(
-    "Length of {.arg col_types} is not compatible with {comparator}:",
-    x = "{length(ctypes)} column type{?s} specified.",
-    x = "{n_col_types} un-skipped column type{?s} specified.",
-    x = "But there {cli::qty(n)}{?is/are} {n} {comparator}."
-  ))
+  gs4_abort(
+    c(
+      "Length of {.arg col_types} is not compatible with {comparator}:",
+      x = "{length(ctypes)} column type{?s} specified.",
+      x = "{n_col_types} un-skipped column type{?s} specified.",
+      x = "But there {cli::qty(n)}{?is/are} {n} {comparator}."
+    ),
+    call = call
+  )
 }
 
 # removes col_names for skipped columns

R/sheet_add.R

@@ -95,20 +95,23 @@ sheet_add_impl_ <- function(ssid,
   new_googlesheets4_spreadsheet(resp$updatedSpreadsheet)
 }
 
-resolve_index <- function(sheets_df, .before = NULL, .after = NULL) {
+resolve_index <- function(sheets_df,
+                          .before = NULL,
+                          .after = NULL,
+                          call = caller_env()) {
   if (is.null(.before) && is.null(.after)) {
     return(NULL)
   }
 
   if (is.null(.after)) {
-    s <- lookup_sheet(.before, sheets_df = sheets_df)
+    s <- lookup_sheet(.before, sheets_df = sheets_df, call = call)
     return(s$index)
   }
 
   if (is.numeric(.after)) {
     .after <- min(.after, nrow(sheets_df))
   }
-  s <- lookup_sheet(.after, sheets_df = sheets_df)
+  s <- lookup_sheet(.after, sheets_df = sheets_df, call = call)
   s$index + 1
 }