Merged origin/main into gargle-secrets-update

DESCRIPTION

@@ -19,22 +19,20 @@ BugReports: https://github.com/r-dbi/bigrquery/issues
 Depends: 
     R (>= 3.6)
 Imports: 
-    assertthat,
     bit64,
     brio,
     cli,
     curl,
     DBI,
     gargle (>= 1.4.0),
-    glue (>= 1.3.0),
     httr,
     jsonlite,
     lifecycle,
     methods,
     prettyunits,
     progress,
     Rcpp,
-    rlang (>= 0.4.9),
+    rlang (>= 1.1.0),
     tibble
 Suggests: 
     blob,
@@ -77,11 +75,14 @@ Collate:
     'bq-table.R'
     'bq-test.R'
     'camelCase.R'
+    'connections-page.R'
     'dbi-driver.R'
     'dbi-connection.R'
     'dbi-result.R'
     'dplyr.R'
     'gs-object.R'
+    'import-standalone-obj-type.R'
     'import-standalone-s3-register.R'
+    'import-standalone-types-check.R'
     'utils.R'
     'zzz.R'

NAMESPACE

@@ -8,6 +8,7 @@ S3method(as_bq_dataset,character)
 S3method(as_bq_dataset,list)
 S3method(as_bq_field,bq_field)
 S3method(as_bq_field,list)
+S3method(as_bq_fields,"NULL")
 S3method(as_bq_fields,bq_fields)
 S3method(as_bq_fields,data.frame)
 S3method(as_bq_fields,list)
@@ -146,14 +147,10 @@ exportMethods(dbSendQuery)
 exportMethods(dbWriteTable)
 exportMethods(show)
 import(DBI)
-import(assertthat, except = has_name)
 import(methods)
 import(rlang, except = unbox)
 importFrom(Rcpp,sourceCpp)
 importFrom(bit64,integer64)
-importFrom(glue,glue)
-importFrom(glue,glue_collapse)
-importFrom(glue,glue_data)
 importFrom(httr,DELETE)
 importFrom(httr,GET)
 importFrom(httr,PATCH)

NEWS.md

@@ -1,4 +1,19 @@
 # bigrquery (development version)
+
+* Add support for RStudio/Workbench Connections pane when using `dbConnect` 
+  method (@meztez, #431).
+
+* If `bq_job_wait()` receives a 503 response, it now waits for 2 seconds and
+  tries again (#535).
+
+* `grepl(pattern, x)` is now correctly translated to 
+  `REGEXP_CONTAINS(x, pattern)` (#416).
+
+* `median()` gets a translation that works in `summarise()` and a clear
+  error if you use it in `mutate()` (#419).
+
+* `dbGetQuery()`/`dbSendQuery()` gains support for parameterised queries via 
+  the `params` argument (@byapparov, #444).
 
 * `dbGetRowCount()` and `dbHasComplete()` now return correct values when you
   try to fetch more rows than actually exist (#501).

R/bigrquery-package.R

@@ -13,7 +13,6 @@
 #' @aliases bigrquery-package
 #' @useDynLib bigrquery, .registration = TRUE
 #' @rawNamespace import(rlang, except = unbox)
-#' @rawNamespace import(assertthat, except = has_name)
 "_PACKAGE"
 
 the <- new_environment()
@@ -22,9 +21,6 @@ the <- new_environment()
 
 ## usethis namespace: start
 #' @importFrom bit64 integer64
-#' @importFrom glue glue
-#' @importFrom glue glue_collapse
-#' @importFrom glue glue_data
 #' @importFrom jsonlite unbox
 #' @importFrom lifecycle deprecated
 #' @importFrom Rcpp sourceCpp

R/bq-auth.R

@@ -192,20 +192,20 @@ bq_auth_configure <- function(client, path, app = deprecated()) {
       "bq_auth_configure(app)",
       "bq_auth_configure(client)"
     )
-    bq_auth_configure(client = app, path = path)
+    return(bq_auth_configure(client = app, path = path))
   }
 
-  if (!xor(missing(client), missing(path))) {
-    stop("Must supply exactly one of `client` and `path`", call. = FALSE)
-  }
+  check_exclusive(client, path)
   if (!missing(path)) {
-    stopifnot(is_string(path))
+    check_string(path)
     client <- gargle::gargle_oauth_client_from_json(path)
+  } else {
+    if (!is.null(client) && !inherits(client, "gargle_oauth_client")) {
+      stop_input_type(client, "a gargle OAuth client", allow_null = TRUE)
+    }
   }
-  stopifnot(is.null(client) || inherits(client, "gargle_oauth_client"))
 
   .auth$set_client(client)
-
   invisible(.auth)
 }
 

R/bq-dataset.R

@@ -101,12 +101,12 @@ bq_dataset_tables <- function(x, page_size = 50, max_pages = Inf, warn = TRUE, .
 
   data <- bq_get_paginated(
     url,
-    query = list(fields = "tables(tableReference)"),
+    query = list(fields = "tables(tableReference,type)"),
     page_size = page_size,
     max_pages = max_pages,
     warn = warn
   )
 
   tables <- unlist(lapply(data, function(x) x$tables), recursive = FALSE)
-  lapply(tables, function(x) as_bq_table(x$tableReference))
+  lapply(tables, function(x) as_bq_table(x$tableReference, type = x$type))
 }

R/bq-download.R

@@ -83,7 +83,7 @@ bq_table_download <-
     start_index <- params$start_index
 
     schema_path <- bq_download_schema(x, tempfile())
-    defer(file.remove(schema_path))
+    defer(unlink(schema_path))
 
     if (n_max == 0) {
       table_data <- bq_parse_files(
@@ -102,16 +102,8 @@ bq_table_download <-
       message("Downloading first chunk of data.")
     }
 
-    if (is.null(page_size)) {
-      chunk_size_from_user <- FALSE
-    } else {
-      assert_that(
-        is.numeric(page_size),
-        length(page_size) == 1,
-        page_size > 0
-      )
-      chunk_size_from_user <- TRUE
-    }
+    check_number_whole(page_size, min = 0, allow_null = TRUE)
+    chunk_size_from_user <- !is.null(page_size)
     chunk_size <- page_size
 
     chunk_plan <- bq_download_plan(
@@ -132,7 +124,7 @@ bq_table_download <-
     )
     curl::multi_run(pool = pool)
     path_first_chunk <- chunk_plan$dat$path[1]
-    defer(file.remove(path_first_chunk))
+    defer(unlink(path_first_chunk))
 
     chunk_data <- bq_parse_file(schema_path, path_first_chunk)
     n_got <- nrow(chunk_data)
@@ -145,18 +137,17 @@ bq_table_download <-
     }
 
     if (chunk_size_from_user && n_got < chunk_size) {
-      abort(c(
+      cli::cli_abort(c(
         "First chunk is incomplete:",
-        x = glue("{big_mark(chunk_size)} rows were requested, but only \\
-                  {big_mark(n_got)} rows were received."),
+        x = "{big_mark(chunk_size)} rows were requested, but only {big_mark(n_got)} rows were received.",
         i = "Leave `page_size` unspecified or use an even smaller value."
       ))
     }
 
     # break rest of work into natural chunks ----
     if (!chunk_size_from_user) {
       if (!bq_quiet(quiet)) {
-        message(glue("Received {big_mark(n_got)} rows in the first chunk."))
+        cli::cli_inform("Received {big_mark(n_got)} rows in the first chunk.")
       }
       chunk_size <- trunc(0.75 * n_got)
     }
@@ -176,11 +167,10 @@ bq_table_download <-
     )
 
     if (!bq_quiet(quiet)) {
-      message(glue_data(
-        chunk_plan,
-        "Downloading the remaining {big_mark(n_max)} rows in {n_chunks} \\
-         chunks of (up to) {big_mark(chunk_size)} rows."
-      ))
+      cli::cli_inform(
+        "Downloading the remaining {big_mark(chunk_plan$n_max)} rows in {chunk_plan$n_chunks} \\
+         chunks of (up to) {big_mark(chunk_plan$chunk_size)} rows."
+      )
     }
 
     for (i in seq_len(chunk_plan$n_chunks)) {
@@ -196,7 +186,7 @@ bq_table_download <-
       )
     }
     curl::multi_run(pool = pool)
-    defer(file.remove(chunk_plan$dat$path))
+    defer(unlink(chunk_plan$dat$path))
 
     table_data <- bq_parse_files(
       schema_path,
@@ -235,8 +225,8 @@ rapply_int64 <- function(x, f) {
 }
 
 set_row_params <- function(nrow, n_max = Inf, start_index = 0L) {
-  assert_that(is.numeric(n_max), length(n_max) == 1, n_max >= 0)
-  assert_that(is.numeric(start_index), length(start_index) == 1, start_index >= 0)
+  check_number_whole(n_max, min = 0, allow_infinite = TRUE)
+  check_number_whole(start_index, min = 0)
 
   n_max <- max(min(n_max, nrow - start_index), 0)
 
@@ -286,8 +276,8 @@ set_chunk_plan <- function(n_max, chunk_size, n_chunks, start_index = 0) {
 
 bq_download_chunk_handle <- function(x, begin = 0L, max_results = 1e4) {
   x <- as_bq_table(x)
-  assert_that(is.numeric(begin), length(begin) == 1)
-  assert_that(is.numeric(max_results), length(max_results) == 1)
+  check_number_whole(begin, min = 0)
+  check_number_whole(max_results, min = 1, allow_infinite = TRUE)
 
   # Pre-format query params with forced non-scientific notation, since the BQ
   # API doesn't accept numbers like 1e5. See issue #395 for details.

R/bq-field.R

@@ -21,7 +21,10 @@
 #' # as_bq_fields() can also take a data frame
 #' as_bq_fields(mtcars)
 bq_field <- function(name, type, mode = "NULLABLE", fields = list(), description = NULL) {
-  assert_that(is.string(name), is.string(type), is.string(mode))
+  check_string(name)
+  check_string(type)
+  check_string(mode)
+  check_string(description, allow_null = TRUE)
 
   structure(
     list(
@@ -79,6 +82,9 @@ as_bq_field.list <- function(x) {
 #' @rdname bq_field
 as_bq_fields <- function(x) UseMethod("as_bq_fields")
 
+#' @export
+as_bq_fields.NULL <- function(x) x
+
 #' @export
 as_bq_fields.bq_fields <- function(x) x
 

R/bq-job.R

@@ -80,12 +80,18 @@ bq_job_wait <- function(x, quiet = getOption("bigrquery.quiet"), pause = 0.5) {
     clear = FALSE
   )
 
-  status <- bq_job_status(x)
-  while (status$state != "DONE") {
-    Sys.sleep(pause)
+  repeat {
     progress$tick()
-    status <- bq_job_status(x)
+    # https://cloud.google.com/bigquery/docs/error-messages
+    # Switch to req_retry() when we move to httr2
+    status <- tryCatch(
+      bq_job_status(x),
+      bigrquery_http_503 = function(err) NULL
+    )
     progress$tick()
+
+    if (!is.null(status) && status$state == "DONE") break
+    Sys.sleep(pause)
   }
   progress$update(1)
 

R/bq-param.R

@@ -27,7 +27,9 @@ bq_param <- function(value, type = NULL, name = NULL) {
 #' @rdname bq_param
 #' @export
 bq_param_scalar <- function(value, type = NULL, name = NULL) {
-  assert_that(length(value) == 1)
+  if (length(value) != 1) {
+    cli::cli_abort("{.arg value} must be length 1, not {length(value)}.")
+  }
 
   if (is.null(type)) {
     type <- data_type(value)
@@ -41,7 +43,9 @@ bq_param_scalar <- function(value, type = NULL, name = NULL) {
 #' @rdname bq_param
 #' @export
 bq_param_array <- function(value, type = NULL, name = NULL) {
-  assert_that(length(value) > 0)
+  if (length(value) == 0) {
+    cli::cli_abort("{.arg value} can't be zero-length.")
+  }
 
   if (is.null(type)) {
     type <- data_type(value)