diff --git a/DESCRIPTION b/DESCRIPTION index bcb39ca5..c8cb2672 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,14 +19,12 @@ 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, @@ -34,7 +32,7 @@ Imports: 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' diff --git a/NAMESPACE b/NAMESPACE index 278d9c5a..c473bb04 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index a34419af..0d1b82bc 100644 --- a/NEWS.md +++ b/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). diff --git a/R/bigrquery-package.R b/R/bigrquery-package.R index 87ea8a38..c2434f68 100644 --- a/R/bigrquery-package.R +++ b/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 diff --git a/R/bq-auth.R b/R/bq-auth.R index 6b025fb4..3c781868 100644 --- a/R/bq-auth.R +++ b/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) } diff --git a/R/bq-dataset.R b/R/bq-dataset.R index 080e0861..e91fb611 100644 --- a/R/bq-dataset.R +++ b/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)) } diff --git a/R/bq-download.R b/R/bq-download.R index 5ea3a5c7..408acd7d 100644 --- a/R/bq-download.R +++ b/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,10 +137,9 @@ 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." )) } @@ -156,7 +147,7 @@ bq_table_download <- # 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. diff --git a/R/bq-field.R b/R/bq-field.R index b1e285bc..506774c8 100644 --- a/R/bq-field.R +++ b/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 diff --git a/R/bq-job.R b/R/bq-job.R index 2dd09074..3dd755cd 100644 --- a/R/bq-job.R +++ b/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) diff --git a/R/bq-param.R b/R/bq-param.R index d1e9f758..3a9f6396 100644 --- a/R/bq-param.R +++ b/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) diff --git a/R/bq-perform.R b/R/bq-perform.R index 2b277f95..1086ea22 100644 --- a/R/bq-perform.R +++ b/R/bq-perform.R @@ -59,9 +59,13 @@ bq_perform_extract <- function(x, ..., print_header = TRUE, billing = x$project) { + x <- as_bq_table(x) - destination_uris <- as.character(destination_uris) - assert_that(is.string(billing)) + destination_uris <- as.character(destination_uris) # for gs_object + check_string(destination_format) + check_string(compression) + check_bool(print_header) + check_string(billing) url <- bq_path(billing, jobs = "") body <- list( @@ -113,10 +117,13 @@ bq_perform_upload <- function(x, values, ) { x <- as_bq_table(x) - assert_that( - is.data.frame(values), - is.string(billing) - ) + if (!is.data.frame(values)) { + cli::cli_abort("{.arg values} must be a data frame.") + } + fields <- as_bq_fields(fields) + check_string(create_disposition) + check_string(write_disposition) + check_string(billing) load <- list( sourceFormat = unbox("NEWLINE_DELIMITED_JSON"), @@ -126,9 +133,9 @@ bq_perform_upload <- function(x, values, ) if (!is.null(fields)) { - fields <- as_bq_fields(fields) load$schema <- list(fields = as_json(fields)) - } else if (!bq_table_exists(x)) { + } + if (!bq_table_exists(x)) { load$autodetect <- unbox(TRUE) } @@ -215,7 +222,11 @@ bq_perform_load <- function(x, ) { x <- as_bq_table(x) source_uris <- as.character(source_uris) - assert_that(is.string(billing)) + check_string(billing) + check_string(source_format) + check_number_decimal(nskip, min = 0) + check_string(create_disposition) + check_string(write_disposition) load <- list( sourceUris = as.list(source_uris), @@ -278,7 +289,14 @@ bq_perform_query <- function(query, billing, use_legacy_sql = FALSE, priority = "INTERACTIVE" ) { - assert_that(is.string(query), is.string(billing)) + + check_string(query) + check_string(billing) + + check_string(create_disposition) + check_string(write_disposition) + check_bool(use_legacy_sql) + check_string(priority) query <- list( query = unbox(query), @@ -286,7 +304,7 @@ bq_perform_query <- function(query, billing, priority = unbox(priority) ) - if (!is.null(parameters)) { + if (length(parameters) > 0) { parameters <- as_bq_params(parameters) query$queryParameters <- as_json(parameters) } @@ -322,7 +340,9 @@ bq_perform_query_dry_run <- function(query, billing, parameters = NULL, use_legacy_sql = FALSE) { - assert_that(is.string(query), is.string(billing)) + check_string(query) + check_string(billing) + check_bool(use_legacy_sql) query <- list( query = unbox(query), diff --git a/R/bq-project.R b/R/bq-project.R index 97905ce0..cb6420e6 100644 --- a/R/bq-project.R +++ b/R/bq-project.R @@ -27,7 +27,10 @@ NULL #' @param x A string giving a project name. #' @inheritParams bq_projects bq_project_datasets <- function(x, page_size = 100, max_pages = 1, warn = TRUE) { - assert_that(is.string(x)) + check_string(x) + check_number_whole(page_size, min = 1) + check_number_whole(max_pages, min = 1, allow_infinite = TRUE) + check_bool(warn) pages <- bq_get_paginated( bq_path(x, ""), @@ -47,7 +50,10 @@ bq_project_datasets <- function(x, page_size = 100, max_pages = 1, warn = TRUE) #' @export #' @rdname api-project bq_project_jobs <- function(x, page_size = 100, max_pages = 1, warn = TRUE) { - assert_that(is.string(x)) + check_string(x) + check_number_whole(page_size, min = 1) + check_number_whole(max_pages, min = 1, allow_infinite = TRUE) + check_bool(warn) pages <- bq_get_paginated( bq_path(x, jobs = ""), diff --git a/R/bq-refs.R b/R/bq-refs.R index ebb981c4..a09a853d 100644 --- a/R/bq-refs.R +++ b/R/bq-refs.R @@ -12,8 +12,8 @@ #' coercion functions on their first argument, allowing you to flexible specify #' their inputs. #' -#' @param project,dataset,table,job Individual project, dataset, table, -#' and job identifiers (strings). +#' @param project,dataset,table,job,type Individual project, dataset, table, +#' job identifiers and table type (strings). #' #' For `bq_table()`, you if supply a `bq_dataset` as the first argument, #' the 2nd argument will be interpreted as the `table` @@ -58,7 +58,8 @@ NULL #' @rdname bq_refs #' @export bq_dataset <- function(project, dataset) { - assert_that(is.string(project), is.string(dataset)) + check_string(project) + check_string(dataset) structure( list( @@ -100,18 +101,24 @@ as_bq_dataset.list <- function(x) { #' @rdname bq_refs #' @export -bq_table <- function(project, dataset, table = NULL) { +bq_table <- function(project, dataset, table = NULL, type = "TABLE") { if (inherits(project, "bq_dataset") && is.null(table)) { - return(bq_table(project$project, project$dataset, dataset)) + check_string(dataset) + table <- dataset + dataset <- project$dataset + project <- project$project + } else { + check_string(project) + check_string(dataset) + check_string(table) } - assert_that(is.string(project), is.string(dataset), is.string(table)) - structure( list( project = project, dataset = dataset, - table = table + table = table, + type = type ), class = "bq_table" ) @@ -137,13 +144,13 @@ as_bq_table.bq_table <- function(x, ...) { #' @export as_bq_table.character <- function(x, ...) { x <- bq_from_string(x, 3, "bq_table") - bq_table(x[[1]], x[[2]], x[[3]]) + bq_table(x[[1]], x[[2]], x[[3]], ...) } #' @export as_bq_table.list <- function(x, ...) { x <- bq_from_list(x, c("projectId", "datasetId", "tableId"), "bq_table") - bq_table(x$projectId, x$datasetId, x$tableId) + bq_table(x$projectId, x$datasetId, x$tableId, ...) } # job --------------------------------------------------------------------- @@ -213,26 +220,27 @@ tableReference <- function(x) { # Helpers ----------------------------------------------------------------- -bq_from_list <- function(x, names, type) { +bq_from_list <- function(x, names, type, error_call = caller_env()) { names(x) <- camelCase(names(x)) if (length(setdiff(names, names(x))) == 0) return(x) - names_str <- glue_collapse(names, sep = ", ", last = " and ") - stop(glue("List <{type}> must have components {names_str}"), call. = FALSE) + cli::cli_abort( + "List <{type}> must have components {.and {.str {names}}}.", + call = error_call + ) } -bq_from_string <- function(x, n, type) { - assert_that(is.string(x)) +bq_from_string <- function(x, n, type, error_call = caller_env()) { + check_string(x, call = error_call) pieces <- strsplit(x, ".", fixed = TRUE)[[1]] if (length(pieces) != n) { - stop( - glue("Character <{type}> must contain {n} components when split by `.`"), - call. = FALSE + cli::cli_abort( + "Character <{type}> must contain {n} components when split by `.`", + call = error_call ) } pieces } - diff --git a/R/bq-request.R b/R/bq-request.R index 93a9eb37..3ade9668 100644 --- a/R/bq-request.R +++ b/R/bq-request.R @@ -12,9 +12,9 @@ prepare_bq_query <- function(query) { } bq_path <- function(project, dataset = NULL, table = NULL, ...) { - assert_that(is.null(project) || is.string(project)) - assert_that(is.null(table) || is.string(table)) - assert_that(is.null(dataset) || is.string(dataset)) + check_string(project, allow_null = TRUE) + check_string(dataset, allow_null = TRUE) + check_string(table, allow_null = TRUE) components <- c( projects = project, @@ -69,8 +69,8 @@ bq_exists <- function(url, ..., query = NULL, token = bq_token()) { bq_get_paginated <- function(url, ..., query = NULL, token = bq_token(), page_size = 50, max_pages = Inf, warn = TRUE) { - assert_that(is.numeric(max_pages), length(max_pages) == 1) - assert_that(is.numeric(page_size), length(page_size) == 1) + check_number_whole(max_pages, min = 1, allow_infinite = TRUE) + check_number_whole(page_size, min = 1) if (!is.null(query$fields)) query$fields <- paste0(query$fields, ",nextPageToken") @@ -188,14 +188,14 @@ bq_check_response <- function(status, type, content) { type <- httr::parse_media(type) if (type$complete == "application/json") { json <- jsonlite::fromJSON(rawToChar(content), simplifyVector = FALSE) - signal_reason(json$error$errors[[1L]]$reason, json$error$message) + signal_reason(json$error$errors[[1L]]$reason, json$error$message, status) } else { text <- rawToChar(content) stop("HTTP error [", status, "] ", text, call. = FALSE) } } -signal_reason <- function(reason, message) { +signal_reason <- function(reason, message, status) { if (is.null(reason)) { abort(message) } else { @@ -220,7 +220,7 @@ signal_reason <- function(reason, message) { i = advice ) - abort(message, class = paste0("bigrquery_", reason)) + abort(message, class = c(paste0("bigrquery_", reason), paste0("bigrquery_http_", status))) } } diff --git a/R/bq-table.R b/R/bq-table.R index 7f90a00a..fb744287 100644 --- a/R/bq-table.R +++ b/R/bq-table.R @@ -1,9 +1,9 @@ #' BigQuery tables #' #' Basic create-read-update-delete verbs for tables, as well as functions -#' for uploading and downloading data in to/from memory (`bq_table_upload()`, -#' `bq_table_download()`), and saving to/loading from Google Cloud Storage -#' (`bq_table_load()`, `bq_table_save()`). +#' uploading data (`bq_table_upload()`), saving to/loading from Google +#' Cloud Storage (`bq_table_load()`, `bq_table_save()`), and getting +#' various values from the metadata. #' #' @param x A [bq_table], or an object coercible to a `bq_table`. #' @inheritParams api-job @@ -17,7 +17,6 @@ #' * `bq_table_copy()`, `bq_table_create()`, `bq_table_delete()`, `bq_table_upload()`: #' an invisible [bq_table] #' * `bq_table_exists()`: either `TRUE` or `FALSE`. -#' * `bq_table_download()`: a data frame #' * `bq_table_size()`: the size of the table in bytes #' * `bq_table_fields()`: a [bq_fields]. #' diff --git a/R/connections-page.R b/R/connections-page.R new file mode 100644 index 00000000..12281b73 --- /dev/null +++ b/R/connections-page.R @@ -0,0 +1,141 @@ +# nocov start + +# Capture connection expression for pane +connection_capture <- function() { + if (is.null(getOption("connectionObserver"))) { + return() + } + + addTaskCallback(function(expr, ...) { + tryCatch({ + # notify if this is an assignment we can replay + if (is_call(expr, c("<-", "=")) && is_call(expr[[3]], "dbConnect")) { + on_connection_opened( + eval(expr[[2]]), + paste(c("library(bigrquery)", deparse(expr)), collapse = "\n") + ) + } + }, error = function(e) { + warning("Could not notify connection observer. ", e$message, call. = FALSE) + }) + + # always return false so the task callback is run at most once + FALSE + }) +} + +# https://rstudio.github.io/rstudio-extensions/connections-contract.html#connection-closed +on_connection_closed <- function(con) { + observer <- getOption("connectionObserver") + if (is.null(observer)) + return(invisible(NULL)) + + observer$connectionClosed(bq_type, con@project) +} + +# https://rstudio.github.io/rstudio-extensions/connections-contract.html#connection-updated +on_connection_updated <- function(con) { + observer <- getOption("connectionObserver") + if (is.null(observer)) + return(invisible(NULL)) + + observer$connectionUpdated(bq_type, con@project) +} + +# https://rstudio.github.io/rstudio-extensions/connections-contract.html#connection-opened +on_connection_opened <- function(con, code) { + observer <- getOption("connectionObserver") + if (is.null(observer)) + return(invisible(NULL)) + + observer$connectionOpened( + type = bq_type, + displayName = paste0(c(bq_type, con@project), collapse = "-"), + host = con@project, + icon = system.file("icons/bigquery-512-color.png", package = "bigrquery"), + + # connection code + connectCode = code, + + # only action is to close connections pane + disconnect = function() dbDisconnect(con), + + listObjectTypes = function() { + list( + project = list( + contains = list( + dataset = list( + icon = system.file("icons/dataset.png", package = "bigrquery"), + contains = list( + table = list( + icon = system.file("icons/table.png", package = "bigrquery"), + contains = "data" + ), + view = list( + icon = system.file("icons/view.png", package = "bigrquery"), + contains = "data" + ) + ) + ) + ) + ) + ) + }, + + # table enumeration code + listObjects = function(...) { + list_bigquery_objects(con, ...) + }, + + # column enumeration code + listColumns = function(project = NULL, dataset = NULL, table = NULL, view = NULL, ...) { + x <- bq_table(project, dataset, paste0(table, view)) + fields <- bq_table_fields(x) + + tibble::tibble( + name = vapply(fields, `[[`, character(1), "name"), + type = vapply(fields, `[[`, character(1), "type") + ) + }, + + # table preview code + previewObject = function(rowLimit, project = NULL, dataset = NULL, table = NULL, view = NULL, ...) { + x <- bq_table(project, dataset, paste0(table, view)) + bq_table_download(x, max_results = rowLimit) + }, + + # no actions + + # raw connection object + connectionObject = con + + ) +} + +list_bigquery_objects <- function(con, project = NULL, dataset = NULL, ...) { + if (is.null(project)) { + tibble::tibble(type = "project", name = con@project) + } else if (is.null(dataset)) { + # Catching VPC/Permission errors to crash gracefully + bq_datasets <- tryCatch( + bq_project_datasets(project, warn = FALSE), + error = function(e) list() + ) + datasets <- map_chr(bq_datasets, `[[`, "dataset") + + tibble::tibble(type = "dataset", name = datasets) + } else { + # Catching VPC/Permission errors to crash gracefully + ds <- bq_dataset(project, dataset) + bq_tables <- tryCatch(bq_dataset_tables(ds), error = function(e) list()) + tables <- map_chr(bq_tables, `[[`, "table") + types <- map_chr(bq_tables, `[[`, "type") + types <- grepl("VIEW$", types) + 1L + types <- c("table", "view")[types] + tibble::tibble(type = types, name = tables) + } +} + +bq_type <- "BigQuery" + +# nocov end diff --git a/R/dbi-connection.R b/R/dbi-connection.R index 1dc5dcf6..e89b13f2 100644 --- a/R/dbi-connection.R +++ b/R/dbi-connection.R @@ -2,12 +2,15 @@ NULL BigQueryConnection <- function(project, - dataset, - billing, - page_size = 1e4, - quiet = NA, - use_legacy_sql = FALSE, - bigint = c("integer", "integer64", "numeric", "character")) { + dataset, + billing, + page_size = 1e4, + quiet = NA, + use_legacy_sql = FALSE, + bigint = c("integer", "integer64", "numeric", "character")) { + + connection_capture() + new("BigQueryConnection", project = project, dataset = dataset, @@ -65,6 +68,7 @@ setMethod( setMethod( "dbDisconnect", "BigQueryConnection", function(conn, ...) { + on_connection_closed(conn) invisible(TRUE) }) @@ -72,11 +76,12 @@ setMethod( #' @inheritParams DBI::dbSendQuery #' @export setMethod( - "dbSendQuery", c("BigQueryConnection", "character"), - function(conn, statement, ...) { - BigQueryResult(conn, statement, ...) - }) - + "dbSendQuery", + c("BigQueryConnection", "character"), + function(conn, statement, ..., params = NULL) { + BigQueryResult(conn, statement, params = params, ...) + } +) #' @rdname DBI #' @inheritParams DBI::dbSendQuery @@ -182,7 +187,9 @@ dbWriteTable_bq <- function(conn, field.types = NULL, temporary = FALSE, row.names = NA) { - assert_that(is.flag(overwrite), is.flag(append)) + + check_bool(overwrite) + check_bool(append) if (!is.null(field.types)) { stop("`field.types` not supported by bigrquery", call. = FALSE) @@ -247,6 +254,8 @@ dbAppendTable_bq <- function(conn, name, value, ..., row.names = NULL) { write_disposition = "WRITE_APPEND", ... ) + on_connection_updated(conn) + invisible(TRUE) } @@ -271,6 +280,7 @@ dbCreateTable_bq <- function(conn, tb <- as_bq_table(conn, name) bq_table_create(tb, fields) + on_connection_updated(conn) invisible(TRUE) } @@ -344,6 +354,7 @@ setMethod("dbListFields", c("BigQueryConnection", "Id"), dbListFields_bq) dbRemoveTable_bq <- function(conn, name, ...) { tb <- as_bq_table(conn, name) bq_table_delete(tb) + on_connection_updated(conn) invisible(TRUE) } diff --git a/R/dbi-driver.R b/R/dbi-driver.R index 36d1a5fb..c3c6cd13 100644 --- a/R/dbi-driver.R +++ b/R/dbi-driver.R @@ -73,12 +73,24 @@ setClass("BigQueryDriver", contains = "DBIDriver") #' @export setMethod( "dbConnect", "BigQueryDriver", - function(drv, project, dataset = NULL, billing = project, + function(drv, + project, + dataset = NULL, + billing = project, page_size = 1e4, quiet = NA, use_legacy_sql = FALSE, bigint = c("integer", "integer64", "numeric", "character"), ...) { + + check_string(project) + check_string(dataset, allow_null = TRUE) + check_string(billing) + check_number_whole(page_size, min = 1) + check_bool(quiet, allow_na = TRUE) + check_bool(use_legacy_sql) + bigint <- arg_match(bigint) + BigQueryConnection( project = project, dataset = dataset, @@ -86,7 +98,7 @@ setMethod( page_size = page_size, quiet = quiet, use_legacy_sql = use_legacy_sql, - bigint = match.arg(bigint) + bigint = bigint ) } ) diff --git a/R/dbi-result.R b/R/dbi-result.R index 6c4dc03b..e5248933 100644 --- a/R/dbi-result.R +++ b/R/dbi-result.R @@ -1,12 +1,14 @@ #' @include dbi-connection.R NULL -BigQueryResult <- function(conn, sql, ...) { +BigQueryResult <- function(conn, sql, params = NULL, ...) { + ds <- if (!is.null(conn@dataset)) as_bq_dataset(conn) job <- bq_perform_query(sql, billing = conn@billing, default_dataset = ds, quiet = conn@quiet, + parameters = params, ... ) @@ -97,8 +99,7 @@ setMethod( setMethod( "dbFetch", "BigQueryResult", function(res, n = -1, ...) { - stopifnot(length(n) == 1, is.numeric(n)) - stopifnot(n == round(n), !is.na(n), n >= -1) + check_number_whole(n, min = -1, allow_infinite = TRUE) if (n == -1 || n == Inf) { n <- res@cursor$left() diff --git a/R/dplyr.R b/R/dplyr.R index 1ed9be8b..9e5477ba 100644 --- a/R/dplyr.R +++ b/R/dplyr.R @@ -107,7 +107,10 @@ collect.tbl_BigQueryConnection <- function(x, ..., n = Inf, warn_incomplete = TRUE) { - assert_that(length(n) == 1, n > 0L) + check_number_whole(n, min = 0, allow_infinite = TRUE) + check_number_whole(max_connections, min = 1) + check_bool(warn_incomplete) + con <- dbplyr::remote_con(x) if (op_can_download(x)) { @@ -232,9 +235,13 @@ sql_translation.BigQueryConnection <- function(x) { Sys.time = sql_prefix("current_time"), # Regular expressions - grepl = sql_prefix("REGEXP_CONTAINS", 2), - gsub = function(match, replace, x) { - dbplyr::build_sql("REGEXP_REPLACE", list(x, match, replace)) + grepl = function(pattern, x) { + # https://cloud.google.com/bigquery/docs/reference/standard-sql/string_functions#regexp_contains + dbplyr::build_sql("REGEXP_CONTAINS", list(x, pattern)) + }, + gsub = function(pattern, replace, x) { + # https://cloud.google.com/bigquery/docs/reference/standard-sql/string_functions#regexp_replace + dbplyr::build_sql("REGEXP_REPLACE", list(x, pattern, replace)) }, # Other scalar functions @@ -252,9 +259,6 @@ sql_translation.BigQueryConnection <- function(x) { pmax = sql_prefix("GREATEST"), pmin = sql_prefix("LEAST"), - # Median - median = function(x) dbplyr::build_sql("APPROX_QUANTILES(", x, ", 2)[SAFE_ORDINAL(2)]"), - runif = function(n = n(), min = 0, max = 1) { RAND <- NULL # quiet R CMD check dbplyr::sql_runif(RAND(), n = {{ n }}, min = min, max = max) @@ -269,7 +273,12 @@ sql_translation.BigQueryConnection <- function(x) { sd = sql_prefix("STDDEV_SAMP"), var = sql_prefix("VAR_SAMP"), cor = dbplyr::sql_aggregate_2("CORR"), - cov = dbplyr::sql_aggregate_2("COVAR_SAMP") + cov = dbplyr::sql_aggregate_2("COVAR_SAMP"), + + # Median + median = function(x, na.rm = TRUE) { + dbplyr::build_sql("APPROX_QUANTILES(", x, ", 2)[SAFE_ORDINAL(2)]") + } ), dbplyr::sql_translator(.parent = dbplyr::base_win, all = dbplyr::win_absent("LOGICAL_AND"), @@ -280,7 +289,9 @@ sql_translation.BigQueryConnection <- function(x) { cor = dbplyr::win_absent("CORR"), cov = dbplyr::win_absent("COVAR_SAMP"), - n_distinct = dbplyr::win_absent("n_distinct") + n_distinct = dbplyr::win_absent("n_distinct"), + + median = dbplyr::win_absent("median") ) ) } diff --git a/R/gs-object.R b/R/gs-object.R index ec60f4c2..89f0af48 100644 --- a/R/gs-object.R +++ b/R/gs-object.R @@ -12,7 +12,7 @@ as.character.gs_object <- function(x, ...) { #' @export format.gs_object <- function(x, ...) { - as.character(glue_data(x, "gs://{bucket}/{object}")) + sprintf("gs://%s/%s", x$bucket, x$object) } #' @export @@ -22,13 +22,21 @@ print.gs_object <- function(x, ...) { } gs_object_delete <- function(x, token = bq_token()) { - url <- glue_data(x, "https://storage.googleapis.com/storage/v1/b/{bucket}/o/{object}") + url <- sprintf( + "https://storage.googleapis.com/storage/v1/b/%s/o/%s", + x$bucket, + x$object + ) req <- httr::DELETE(url, token, httr::user_agent(bq_ua())) process_request(req) } gs_object_exists <- function(x, token = bq_token()) { - url <- glue_data(x, "https://storage.googleapis.com/storage/v1/b/{bucket}/o/{object}") + url <- sprintf( + "https://storage.googleapis.com/storage/v1/b/%s/o/%s", + x$bucket, + x$object + ) req <- httr::GET(url, token, httr::user_agent(bq_ua())) req$status_code != 404 } diff --git a/R/import-standalone-obj-type.R b/R/import-standalone-obj-type.R new file mode 100644 index 00000000..8e3c07df --- /dev/null +++ b/R/import-standalone-obj-type.R @@ -0,0 +1,360 @@ +# Standalone file: do not edit by hand +# Source: <https://github.com/r-lib/rlang/blob/main/R/standalone-obj-type.R> +# ---------------------------------------------------------------------- +# +# --- +# repo: r-lib/rlang +# file: standalone-obj-type.R +# last-updated: 2023-05-01 +# license: https://unlicense.org +# imports: rlang (>= 1.1.0) +# --- +# +# ## Changelog +# +# 2023-05-01: +# - `obj_type_friendly()` now only displays the first class of S3 objects. +# +# 2023-03-30: +# - `stop_input_type()` now handles `I()` input literally in `arg`. +# +# 2022-10-04: +# - `obj_type_friendly(value = TRUE)` now shows numeric scalars +# literally. +# - `stop_friendly_type()` now takes `show_value`, passed to +# `obj_type_friendly()` as the `value` argument. +# +# 2022-10-03: +# - Added `allow_na` and `allow_null` arguments. +# - `NULL` is now backticked. +# - Better friendly type for infinities and `NaN`. +# +# 2022-09-16: +# - Unprefixed usage of rlang functions with `rlang::` to +# avoid onLoad issues when called from rlang (#1482). +# +# 2022-08-11: +# - Prefixed usage of rlang functions with `rlang::`. +# +# 2022-06-22: +# - `friendly_type_of()` is now `obj_type_friendly()`. +# - Added `obj_type_oo()`. +# +# 2021-12-20: +# - Added support for scalar values and empty vectors. +# - Added `stop_input_type()` +# +# 2021-06-30: +# - Added support for missing arguments. +# +# 2021-04-19: +# - Added support for matrices and arrays (#141). +# - Added documentation. +# - Added changelog. +# +# nocov start + +#' Return English-friendly type +#' @param x Any R object. +#' @param value Whether to describe the value of `x`. Special values +#' like `NA` or `""` are always described. +#' @param length Whether to mention the length of vectors and lists. +#' @return A string describing the type. Starts with an indefinite +#' article, e.g. "an integer vector". +#' @noRd +obj_type_friendly <- function(x, value = TRUE) { + if (is_missing(x)) { + return("absent") + } + + if (is.object(x)) { + if (inherits(x, "quosure")) { + type <- "quosure" + } else { + type <- class(x)[[1L]] + } + return(sprintf("a <%s> object", type)) + } + + if (!is_vector(x)) { + return(.rlang_as_friendly_type(typeof(x))) + } + + n_dim <- length(dim(x)) + + if (!n_dim) { + if (!is_list(x) && length(x) == 1) { + if (is_na(x)) { + return(switch( + typeof(x), + logical = "`NA`", + integer = "an integer `NA`", + double = + if (is.nan(x)) { + "`NaN`" + } else { + "a numeric `NA`" + }, + complex = "a complex `NA`", + character = "a character `NA`", + .rlang_stop_unexpected_typeof(x) + )) + } + + show_infinites <- function(x) { + if (x > 0) { + "`Inf`" + } else { + "`-Inf`" + } + } + str_encode <- function(x, width = 30, ...) { + if (nchar(x) > width) { + x <- substr(x, 1, width - 3) + x <- paste0(x, "...") + } + encodeString(x, ...) + } + + if (value) { + if (is.numeric(x) && is.infinite(x)) { + return(show_infinites(x)) + } + + if (is.numeric(x) || is.complex(x)) { + number <- as.character(round(x, 2)) + what <- if (is.complex(x)) "the complex number" else "the number" + return(paste(what, number)) + } + + return(switch( + typeof(x), + logical = if (x) "`TRUE`" else "`FALSE`", + character = { + what <- if (nzchar(x)) "the string" else "the empty string" + paste(what, str_encode(x, quote = "\"")) + }, + raw = paste("the raw value", as.character(x)), + .rlang_stop_unexpected_typeof(x) + )) + } + + return(switch( + typeof(x), + logical = "a logical value", + integer = "an integer", + double = if (is.infinite(x)) show_infinites(x) else "a number", + complex = "a complex number", + character = if (nzchar(x)) "a string" else "\"\"", + raw = "a raw value", + .rlang_stop_unexpected_typeof(x) + )) + } + + if (length(x) == 0) { + return(switch( + typeof(x), + logical = "an empty logical vector", + integer = "an empty integer vector", + double = "an empty numeric vector", + complex = "an empty complex vector", + character = "an empty character vector", + raw = "an empty raw vector", + list = "an empty list", + .rlang_stop_unexpected_typeof(x) + )) + } + } + + vec_type_friendly(x) +} + +vec_type_friendly <- function(x, length = FALSE) { + if (!is_vector(x)) { + abort("`x` must be a vector.") + } + type <- typeof(x) + n_dim <- length(dim(x)) + + add_length <- function(type) { + if (length && !n_dim) { + paste0(type, sprintf(" of length %s", length(x))) + } else { + type + } + } + + if (type == "list") { + if (n_dim < 2) { + return(add_length("a list")) + } else if (is.data.frame(x)) { + return("a data frame") + } else if (n_dim == 2) { + return("a list matrix") + } else { + return("a list array") + } + } + + type <- switch( + type, + logical = "a logical %s", + integer = "an integer %s", + numeric = , + double = "a double %s", + complex = "a complex %s", + character = "a character %s", + raw = "a raw %s", + type = paste0("a ", type, " %s") + ) + + if (n_dim < 2) { + kind <- "vector" + } else if (n_dim == 2) { + kind <- "matrix" + } else { + kind <- "array" + } + out <- sprintf(type, kind) + + if (n_dim >= 2) { + out + } else { + add_length(out) + } +} + +.rlang_as_friendly_type <- function(type) { + switch( + type, + + list = "a list", + + NULL = "`NULL`", + environment = "an environment", + externalptr = "a pointer", + weakref = "a weak reference", + S4 = "an S4 object", + + name = , + symbol = "a symbol", + language = "a call", + pairlist = "a pairlist node", + expression = "an expression vector", + + char = "an internal string", + promise = "an internal promise", + ... = "an internal dots object", + any = "an internal `any` object", + bytecode = "an internal bytecode object", + + primitive = , + builtin = , + special = "a primitive function", + closure = "a function", + + type + ) +} + +.rlang_stop_unexpected_typeof <- function(x, call = caller_env()) { + abort( + sprintf("Unexpected type <%s>.", typeof(x)), + call = call + ) +} + +#' Return OO type +#' @param x Any R object. +#' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`, +#' `"R6"`, or `"R7"`. +#' @noRd +obj_type_oo <- function(x) { + if (!is.object(x)) { + return("bare") + } + + class <- inherits(x, c("R6", "R7_object"), which = TRUE) + + if (class[[1]]) { + "R6" + } else if (class[[2]]) { + "R7" + } else if (isS4(x)) { + "S4" + } else { + "S3" + } +} + +#' @param x The object type which does not conform to `what`. Its +#' `obj_type_friendly()` is taken and mentioned in the error message. +#' @param what The friendly expected type as a string. Can be a +#' character vector of expected types, in which case the error +#' message mentions all of them in an "or" enumeration. +#' @param show_value Passed to `value` argument of `obj_type_friendly()`. +#' @param ... Arguments passed to [abort()]. +#' @inheritParams args_error_context +#' @noRd +stop_input_type <- function(x, + what, + ..., + allow_na = FALSE, + allow_null = FALSE, + show_value = TRUE, + arg = caller_arg(x), + call = caller_env()) { + # From standalone-cli.R + cli <- env_get_list( + nms = c("format_arg", "format_code"), + last = topenv(), + default = function(x) sprintf("`%s`", x), + inherit = TRUE + ) + + if (allow_na) { + what <- c(what, cli$format_code("NA")) + } + if (allow_null) { + what <- c(what, cli$format_code("NULL")) + } + if (length(what)) { + what <- oxford_comma(what) + } + if (inherits(arg, "AsIs")) { + format_arg <- identity + } else { + format_arg <- cli$format_arg + } + + message <- sprintf( + "%s must be %s, not %s.", + format_arg(arg), + what, + obj_type_friendly(x, value = show_value) + ) + + abort(message, ..., call = call, arg = arg) +} + +oxford_comma <- function(chr, sep = ", ", final = "or") { + n <- length(chr) + + if (n < 2) { + return(chr) + } + + head <- chr[seq_len(n - 1)] + last <- chr[n] + + head <- paste(head, collapse = sep) + + # Write a or b. But a, b, or c. + if (n > 2) { + paste0(head, sep, final, " ", last) + } else { + paste0(head, " ", final, " ", last) + } +} + +# nocov end diff --git a/R/import-standalone-types-check.R b/R/import-standalone-types-check.R new file mode 100644 index 00000000..6782d69b --- /dev/null +++ b/R/import-standalone-types-check.R @@ -0,0 +1,538 @@ +# Standalone file: do not edit by hand +# Source: <https://github.com/r-lib/rlang/blob/main/R/standalone-types-check.R> +# ---------------------------------------------------------------------- +# +# --- +# repo: r-lib/rlang +# file: standalone-types-check.R +# last-updated: 2023-03-13 +# license: https://unlicense.org +# dependencies: standalone-obj-type.R +# imports: rlang (>= 1.1.0) +# --- +# +# ## Changelog +# +# 2023-03-13: +# - Improved error messages of number checkers (@teunbrand) +# - Added `allow_infinite` argument to `check_number_whole()` (@mgirlich). +# - Added `check_data_frame()` (@mgirlich). +# +# 2023-03-07: +# - Added dependency on rlang (>= 1.1.0). +# +# 2023-02-15: +# - Added `check_logical()`. +# +# - `check_bool()`, `check_number_whole()`, and +# `check_number_decimal()` are now implemented in C. +# +# - For efficiency, `check_number_whole()` and +# `check_number_decimal()` now take a `NULL` default for `min` and +# `max`. This makes it possible to bypass unnecessary type-checking +# and comparisons in the default case of no bounds checks. +# +# 2022-10-07: +# - `check_number_whole()` and `_decimal()` no longer treat +# non-numeric types such as factors or dates as numbers. Numeric +# types are detected with `is.numeric()`. +# +# 2022-10-04: +# - Added `check_name()` that forbids the empty string. +# `check_string()` allows the empty string by default. +# +# 2022-09-28: +# - Removed `what` arguments. +# - Added `allow_na` and `allow_null` arguments. +# - Added `allow_decimal` and `allow_infinite` arguments. +# - Improved errors with absent arguments. +# +# +# 2022-09-16: +# - Unprefixed usage of rlang functions with `rlang::` to +# avoid onLoad issues when called from rlang (#1482). +# +# 2022-08-11: +# - Added changelog. +# +# nocov start + +# Scalars ----------------------------------------------------------------- + +.standalone_types_check_dot_call <- .Call + +check_bool <- function(x, + ..., + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x) && .standalone_types_check_dot_call(ffi_standalone_is_bool_1.0.7, x, allow_na, allow_null)) { + return(invisible(NULL)) + } + + stop_input_type( + x, + c("`TRUE`", "`FALSE`"), + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_string <- function(x, + ..., + allow_empty = TRUE, + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + is_string <- .rlang_check_is_string( + x, + allow_empty = allow_empty, + allow_na = allow_na, + allow_null = allow_null + ) + if (is_string) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a single string", + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +.rlang_check_is_string <- function(x, + allow_empty, + allow_na, + allow_null) { + if (is_string(x)) { + if (allow_empty || !is_string(x, "")) { + return(TRUE) + } + } + + if (allow_null && is_null(x)) { + return(TRUE) + } + + if (allow_na && (identical(x, NA) || identical(x, na_chr))) { + return(TRUE) + } + + FALSE +} + +check_name <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + is_string <- .rlang_check_is_string( + x, + allow_empty = FALSE, + allow_na = FALSE, + allow_null = allow_null + ) + if (is_string) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a valid name", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +IS_NUMBER_true <- 0 +IS_NUMBER_false <- 1 +IS_NUMBER_oob <- 2 + +check_number_decimal <- function(x, + ..., + min = NULL, + max = NULL, + allow_infinite = TRUE, + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (missing(x)) { + exit_code <- IS_NUMBER_false + } else if (0 == (exit_code <- .standalone_types_check_dot_call( + ffi_standalone_check_number_1.0.7, + x, + allow_decimal = TRUE, + min, + max, + allow_infinite, + allow_na, + allow_null + ))) { + return(invisible(NULL)) + } + + .stop_not_number( + x, + ..., + exit_code = exit_code, + allow_decimal = TRUE, + min = min, + max = max, + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_number_whole <- function(x, + ..., + min = NULL, + max = NULL, + allow_infinite = FALSE, + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (missing(x)) { + exit_code <- IS_NUMBER_false + } else if (0 == (exit_code <- .standalone_types_check_dot_call( + ffi_standalone_check_number_1.0.7, + x, + allow_decimal = FALSE, + min, + max, + allow_infinite, + allow_na, + allow_null + ))) { + return(invisible(NULL)) + } + + .stop_not_number( + x, + ..., + exit_code = exit_code, + allow_decimal = FALSE, + min = min, + max = max, + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +.stop_not_number <- function(x, + ..., + exit_code, + allow_decimal, + min, + max, + allow_na, + allow_null, + arg, + call) { + if (allow_decimal) { + what <- "a number" + } else { + what <- "a whole number" + } + + if (exit_code == IS_NUMBER_oob) { + min <- min %||% -Inf + max <- max %||% Inf + + if (min > -Inf && max < Inf) { + what <- sprintf("%s between %s and %s", what, min, max) + } else if (x < min) { + what <- sprintf("%s larger than or equal to %s", what, min) + } else if (x > max) { + what <- sprintf("%s smaller than or equal to %s", what, max) + } else { + abort("Unexpected state in OOB check", .internal = TRUE) + } + } + + stop_input_type( + x, + what, + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_symbol <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_symbol(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a symbol", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_arg <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_symbol(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an argument name", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_call <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_call(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a defused call", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_environment <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_environment(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an environment", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_function <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_function(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a function", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_closure <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_closure(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an R function", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_formula <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_formula(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a formula", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + + +# Vectors ----------------------------------------------------------------- + +check_character <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_character(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a character vector", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_logical <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_logical(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a logical vector", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_data_frame <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is.data.frame(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a data frame", + ..., + allow_null = allow_null, + arg = arg, + call = call + ) +} + +# nocov end diff --git a/R/utils.R b/R/utils.R index 08aa2e54..6a06416d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -31,19 +31,11 @@ bq_progress <- function(..., quiet = NA) { } bq_check_namespace <- function(pkg, bq_type) { - if (requireNamespace(pkg, quietly = TRUE)) { - return() - } - - abort(glue( - "Package '{pkg}' must be installed to load BigQuery field with type '{bq_type}'" - )) + check_installed(pkg, sprintf("to parse BigQuery '%s' fields.", bq_type)) } isFALSE <- function(x) identical(x, FALSE) -is_string <- function(x) length(x) == 1L && is.character(x) - cat_line <- function(...) { cat(paste0(..., "\n", collapse = "")) } diff --git a/README.Rmd b/README.Rmd index 78cac5d3..23324b36 100644 --- a/README.Rmd +++ b/README.Rmd @@ -107,6 +107,12 @@ natality %>% ## Important details +### BigQuery account + +To use bigrquery, you'll need a BigQuery project. Fortunately, if you just want to play around with the BigQuery API, it's easy to start with Google's free [public data](https://cloud.google.com/bigquery/public-data) and the [BigQuery sandbox](https://cloud.google.com/bigquery/docs/sandbox). This gives you some fun data to play with along with enough free compute (1 TB of queries & 10 GB of storage per month) to learn the ropes. + +To get started, open <https://console.cloud.google.com/bigquery> and create a project. Make a note of the "Project ID" as you'll use this as the `billing` project whenever you work with free sample data; and as the `project` when you work with your own data. + ### Authentication and authorization When using bigrquery interactively, you'll be prompted to [authorize bigrquery](https://cloud.google.com/bigquery/docs/authorization) in the browser. You'll be asked if you want to cache tokens for reuse in future sessions. For non-interactive usage, it is preferred to use a service account token, if possible. More places to learn about auth: @@ -123,22 +129,6 @@ When using bigrquery interactively, you'll be prompted to [authorize bigrquery]( Note that bigrquery requests permission to modify your data; but it will never do so unless you explicitly request it (e.g. by calling `bq_table_delete()` or `bq_table_upload()`). Our [Privacy policy](https://www.tidyverse.org/google_privacy_policy) provides more info. -### Billing project - -If you just want to play around with the BigQuery API, it's easiest to start with Google's free [sample data](https://cloud.google.com/bigquery/public-data). You'll still need to create a project, but if you're just playing around, it's unlikely that you'll go over the free limit (1 TB of queries / 10 GB of storage). - -To create a project: - -1. Open https://console.cloud.google.com/ and create a project. - Make a note of the "Project ID" in the "Project info" box. - -1. Click on "APIs & Services", then "Dashboard" in the left the left menu. - -1. Click on "Enable Apis and Services" at the top of the page, - then search for "BigQuery API" and "Cloud storage". - -Use your project ID as the `billing` project whenever you work with free sample data; and as the `project` when you work with your own data. - ## Useful links * [SQL reference](https://cloud.google.com/bigquery/docs/reference/standard-sql/functions-and-operators) diff --git a/README.md b/README.md index a6a1eb23..bfaeae55 100644 --- a/README.md +++ b/README.md @@ -63,16 +63,16 @@ bq_table_download(tb, n_max = 10) #> # A tibble: 10 × 4 #> year month day weight_pounds #> <int> <int> <int> <dbl> -#> 1 1969 10 7 7.56 -#> 2 1969 5 9 6.62 -#> 3 1969 2 6 2.00 -#> 4 1969 1 8 8.44 -#> 5 1969 6 23 9.81 -#> 6 1969 7 31 7.19 -#> 7 1969 11 6 7.50 -#> 8 1969 12 19 7.50 -#> 9 1969 2 17 7.05 -#> 10 1969 5 3 8.50 +#> 1 1969 11 29 8.00 +#> 2 1969 4 4 7.37 +#> 3 1969 9 6 10.9 +#> 4 1969 5 13 3.25 +#> 5 1969 8 4 7.63 +#> 6 1969 7 6 6.88 +#> 7 1969 4 21 7.25 +#> 8 1969 9 12 8.02 +#> 9 1969 2 13 8.00 +#> 10 1969 10 22 6.81 ``` ### DBI @@ -99,16 +99,16 @@ dbGetQuery(con, sql, n = 10) #> # A tibble: 10 × 4 #> year month day weight_pounds #> <int> <int> <int> <dbl> -#> 1 1969 10 7 7.56 -#> 2 1969 5 9 6.62 -#> 3 1969 2 6 2.00 -#> 4 1969 1 8 8.44 -#> 5 1969 6 23 9.81 -#> 6 1969 7 31 7.19 -#> 7 1969 11 6 7.50 -#> 8 1969 12 19 7.50 -#> 9 1969 2 17 7.05 -#> 10 1969 5 3 8.50 +#> 1 1969 11 29 8.00 +#> 2 1969 4 4 7.37 +#> 3 1969 9 6 10.9 +#> 4 1969 5 13 3.25 +#> 5 1969 8 4 7.63 +#> 6 1969 7 6 6.88 +#> 7 1969 4 21 7.25 +#> 8 1969 9 12 8.02 +#> 9 1969 2 13 8.00 +#> 10 1969 10 22 6.81 ``` ### dplyr @@ -117,9 +117,6 @@ dbGetQuery(con, sql, n = 10) library(dplyr) natality <- tbl(con, "natality") -#> Warning: <BigQueryConnection> uses an old dbplyr interface -#> ℹ Please install a newer version of the package or contact the maintainer -#> This warning is displayed once every 8 hours. natality %>% select(year, month, day, weight_pounds) %>% @@ -142,6 +139,21 @@ natality %>% ## Important details +### BigQuery account + +To use bigrquery, you’ll need a BigQuery project. Fortunately, if you +just want to play around with the BigQuery API, it’s easy to start with +Google’s free [public +data](https://cloud.google.com/bigquery/public-data) and the [BigQuery +sandbox](https://cloud.google.com/bigquery/docs/sandbox). This gives you +some fun data to play with along with enough free compute (1 TB of +queries & 10 GB of storage per month) to learn the ropes. + +To get started, open <https://console.cloud.google.com/bigquery> and +create a project. Make a note of the “Project ID” as you’ll use this as +the `billing` project whenever you work with free sample data; and as +the `project` when you work with your own data. + ### Authentication and authorization When using bigrquery interactively, you’ll be prompted to [authorize @@ -173,28 +185,6 @@ never do so unless you explicitly request it (e.g. by calling policy](https://www.tidyverse.org/google_privacy_policy) provides more info. -### Billing project - -If you just want to play around with the BigQuery API, it’s easiest to -start with Google’s free [sample -data](https://cloud.google.com/bigquery/public-data). You’ll still need -to create a project, but if you’re just playing around, it’s unlikely -that you’ll go over the free limit (1 TB of queries / 10 GB of storage). - -To create a project: - -1. Open <https://console.cloud.google.com/> and create a project. Make - a note of the “Project ID” in the “Project info” box. - -2. Click on “APIs & Services”, then “Dashboard” in the left the left - menu. - -3. Click on “Enable Apis and Services” at the top of the page, then - search for “BigQuery API” and “Cloud storage”. - -Use your project ID as the `billing` project whenever you work with free -sample data; and as the `project` when you work with your own data. - ## Useful links - [SQL diff --git a/inst/icons/bigquery-512-color.png b/inst/icons/bigquery-512-color.png new file mode 100644 index 00000000..a340e257 Binary files /dev/null and b/inst/icons/bigquery-512-color.png differ diff --git a/inst/icons/dataset.png b/inst/icons/dataset.png new file mode 100644 index 00000000..e49fbc07 Binary files /dev/null and b/inst/icons/dataset.png differ diff --git a/inst/icons/table.png b/inst/icons/table.png new file mode 100644 index 00000000..6d775e98 Binary files /dev/null and b/inst/icons/table.png differ diff --git a/inst/icons/view.png b/inst/icons/view.png new file mode 100644 index 00000000..8bcb62f8 Binary files /dev/null and b/inst/icons/view.png differ diff --git a/inst/rstudio/connections.dcf b/inst/rstudio/connections.dcf new file mode 100644 index 00000000..d0061ed1 --- /dev/null +++ b/inst/rstudio/connections.dcf @@ -0,0 +1,3 @@ +Name: BigQuery +HelpUrl: https://cloud.google.com/bigquery/ +Icon: icons/bigquery-512-color.png diff --git a/inst/rstudio/connections/BigQuery.R b/inst/rstudio/connections/BigQuery.R new file mode 100644 index 00000000..07b1c465 --- /dev/null +++ b/inst/rstudio/connections/BigQuery.R @@ -0,0 +1,5 @@ +library(bigrquery) +con <- dbConnect( + bigquery(), + project = "${1:Project}" +) diff --git a/man/DBI.Rd b/man/DBI.Rd index dbbbe79e..25e7cf23 100644 --- a/man/DBI.Rd +++ b/man/DBI.Rd @@ -69,7 +69,7 @@ \S4method{dbDisconnect}{BigQueryConnection}(conn, ...) -\S4method{dbSendQuery}{BigQueryConnection,character}(conn, statement, ...) +\S4method{dbSendQuery}{BigQueryConnection,character}(conn, statement, ..., params = NULL) \S4method{dbExecute}{BigQueryConnection,character}(conn, statement, ...) @@ -179,6 +179,8 @@ or a \linkS4class{DBIResult}} \item{statement}{a character string containing SQL.} +\item{params}{A list of bindings, named or unnamed.} + \item{x}{A character vector to quote as string.} \item{name}{The table name, passed on to \code{\link[DBI:dbQuoteIdentifier]{dbQuoteIdentifier()}}. Options are: @@ -223,8 +225,6 @@ A data frame: field types are generated using or \code{n = Inf} to retrieve all pending records. Some implementations may recognize other special values.} - -\item{params}{A list of bindings, named or unnamed.} } \description{ Implementations of pure virtual functions defined in the \code{DBI} package. diff --git a/man/api-table.Rd b/man/api-table.Rd index 72520f99..687e22da 100644 --- a/man/api-table.Rd +++ b/man/api-table.Rd @@ -79,16 +79,15 @@ can be specified. Also, the '*' wildcard character is not allowed.} \item \code{bq_table_copy()}, \code{bq_table_create()}, \code{bq_table_delete()}, \code{bq_table_upload()}: an invisible \link{bq_table} \item \code{bq_table_exists()}: either \code{TRUE} or \code{FALSE}. -\item \code{bq_table_download()}: a data frame \item \code{bq_table_size()}: the size of the table in bytes \item \code{bq_table_fields()}: a \link{bq_fields}. } } \description{ Basic create-read-update-delete verbs for tables, as well as functions -for uploading and downloading data in to/from memory (\code{bq_table_upload()}, -\code{bq_table_download()}), and saving to/loading from Google Cloud Storage -(\code{bq_table_load()}, \code{bq_table_save()}). +uploading data (\code{bq_table_upload()}), saving to/loading from Google +Cloud Storage (\code{bq_table_load()}, \code{bq_table_save()}), and getting +various values from the metadata. } \section{Google BigQuery API documentation}{ diff --git a/man/bq_refs.Rd b/man/bq_refs.Rd index 908a1da4..cea66393 100644 --- a/man/bq_refs.Rd +++ b/man/bq_refs.Rd @@ -13,7 +13,7 @@ bq_dataset(project, dataset) as_bq_dataset(x) -bq_table(project, dataset, table = NULL) +bq_table(project, dataset, table = NULL, type = "TABLE") as_bq_table(x, ...) @@ -22,8 +22,8 @@ bq_job(project, job, location = "US") as_bq_job(x) } \arguments{ -\item{project, dataset, table, job}{Individual project, dataset, table, -and job identifiers (strings). +\item{project, dataset, table, job, type}{Individual project, dataset, table, +job identifiers and table type (strings). For \code{bq_table()}, you if supply a \code{bq_dataset} as the first argument, the 2nd argument will be interpreted as the \code{table}} diff --git a/tests/testthat/_snaps/bq-auth.md b/tests/testthat/_snaps/bq-auth.md new file mode 100644 index 00000000..2d47cf26 --- /dev/null +++ b/tests/testthat/_snaps/bq-auth.md @@ -0,0 +1,18 @@ +# bq_auth_configure checks its inputs + + Code + bq_auth_configure(1, 1) + Condition + Error in `bq_auth_configure()`: + ! Exactly one of `client` or `path` must be supplied. + Code + bq_auth_configure(client = 1) + Condition + Error in `bq_auth_configure()`: + ! `client` must be a gargle OAuth client or `NULL`, not the number 1. + Code + bq_auth_configure(path = 1) + Condition + Error in `bq_auth_configure()`: + ! `path` must be a single string, not the number 1. + diff --git a/tests/testthat/_snaps/bq-field.md b/tests/testthat/_snaps/bq-field.md index a7c9a55a..173294d4 100644 --- a/tests/testthat/_snaps/bq-field.md +++ b/tests/testthat/_snaps/bq-field.md @@ -19,3 +19,26 @@ y <INTEGER> +# tests its inputs + + Code + bq_field(1) + Condition + Error in `bq_field()`: + ! `name` must be a single string, not the number 1. + Code + bq_field("x", 1) + Condition + Error in `bq_field()`: + ! `type` must be a single string, not the number 1. + Code + bq_field("x", "y", mode = 1) + Condition + Error in `bq_field()`: + ! `mode` must be a single string, not the number 1. + Code + bq_field("x", "y", description = 1) + Condition + Error in `bq_field()`: + ! `description` must be a single string or `NULL`, not the number 1. + diff --git a/tests/testthat/_snaps/bq-param.md b/tests/testthat/_snaps/bq-param.md index 6789a13b..7e06155d 100644 --- a/tests/testthat/_snaps/bq-param.md +++ b/tests/testthat/_snaps/bq-param.md @@ -37,3 +37,16 @@ } ] +# checks inputs + + Code + bq_param_scalar(1:3) + Condition + Error in `bq_param_scalar()`: + ! `value` must be length 1, not 3. + Code + bq_param_array(integer()) + Condition + Error in `bq_param_array()`: + ! `value` can't be zero-length. + diff --git a/tests/testthat/_snaps/bq-refs.md b/tests/testthat/_snaps/bq-refs.md index fe5683a1..cd1afadc 100644 --- a/tests/testthat/_snaps/bq-refs.md +++ b/tests/testthat/_snaps/bq-refs.md @@ -18,22 +18,22 @@ Code as_bq_table("x") Condition - Error: + Error in `as_bq_table()`: ! Character <bq_table> must contain 3 components when split by `.` Code as_bq_table("a.b.c.d") Condition - Error: + Error in `as_bq_table()`: ! Character <bq_table> must contain 3 components when split by `.` Code as_bq_job("x") Condition - Error: + Error in `as_bq_job()`: ! Character <bq_job> must contain 3 components when split by `.` Code as_bq_dataset("x") Condition - Error: + Error in `as_bq_dataset()`: ! Character <bq_dataset> must contain 2 components when split by `.` # list coercion errors with bad names @@ -41,16 +41,16 @@ Code as_bq_table(list()) Condition - Error: - ! List <bq_table> must have components projectId, datasetId and tableId + Error in `as_bq_table()`: + ! List <bq_table> must have components "projectId", "datasetId", and "tableId". Code as_bq_dataset(list()) Condition - Error: - ! List <bq_dataset> must have components projectId and datasetId + Error in `as_bq_dataset()`: + ! List <bq_dataset> must have components "projectId" and "datasetId". Code as_bq_job(list()) Condition - Error: - ! List <bq_job> must have components projectId, jobId and location + Error in `as_bq_job()`: + ! List <bq_job> must have components "projectId", "jobId", and "location". diff --git a/tests/testthat/_snaps/dbi-result.md b/tests/testthat/_snaps/dbi-result.md index 316b6e44..9e83953c 100644 --- a/tests/testthat/_snaps/dbi-result.md +++ b/tests/testthat/_snaps/dbi-result.md @@ -1,5 +1,13 @@ # can retrieve query in pieces and that quiet is respected + Code + DBI::dbFetch(res, NA) + Condition + Error in `DBI::dbFetch()`: + ! `n` must be a whole number, not `NA`. + +--- + Code df <- DBI::dbFetch(res, 10) Message diff --git a/tests/testthat/_snaps/dplyr.md b/tests/testthat/_snaps/dplyr.md index 936bcc1f..7e46b1ad 100644 --- a/tests/testthat/_snaps/dplyr.md +++ b/tests/testthat/_snaps/dplyr.md @@ -6,3 +6,14 @@ Error in `db_copy_to()`: ! BigQuery does not support temporary tables +# string functions correctly + + Code + dbplyr::translate_sql(grepl("a.c", x), con = con) + Output + <SQL> REGEXP_CONTAINS(`x`, 'a.c') + Code + dbplyr::translate_sql(gsub("a.c", "", x), con = con) + Output + <SQL> REGEXP_REPLACE(`x`, 'a.c', '') + diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md index 1193373d..799b7953 100644 --- a/tests/testthat/_snaps/utils.md +++ b/tests/testthat/_snaps/utils.md @@ -4,5 +4,5 @@ bq_check_namespace("invalid package name", "FIELD_TYPE") Condition Error in `bq_check_namespace()`: - ! Package 'invalid package name' must be installed to load BigQuery field with type 'FIELD_TYPE' + ! The package "invalid package name" is required to parse BigQuery 'FIELD_TYPE' fields. diff --git a/tests/testthat/test-bq-auth.R b/tests/testthat/test-bq-auth.R index a6e690e0..9ea57f81 100644 --- a/tests/testthat/test-bq-auth.R +++ b/tests/testthat/test-bq-auth.R @@ -2,3 +2,11 @@ test_that("bq_user() works", { skip_if_no_auth() expect_match(bq_user(), "@.*[.]iam[.]gserviceaccount[.]com") }) + +test_that("bq_auth_configure checks its inputs", { + expect_snapshot(error = TRUE, { + bq_auth_configure(1, 1) + bq_auth_configure(client = 1) + bq_auth_configure(path = 1) + }) +}) diff --git a/tests/testthat/test-bq-field.R b/tests/testthat/test-bq-field.R index e323ca37..76a4d6b4 100644 --- a/tests/testthat/test-bq-field.R +++ b/tests/testthat/test-bq-field.R @@ -30,3 +30,12 @@ test_that("recursive printing of subfields", { print(z3$fields) }) }) + +test_that("tests its inputs", { + expect_snapshot(error = TRUE, { + bq_field(1) + bq_field("x", 1) + bq_field("x", "y", mode = 1) + bq_field("x", "y", description = 1) + }) +}) diff --git a/tests/testthat/test-bq-param.R b/tests/testthat/test-bq-param.R index 6a564d3a..eab2f2de 100644 --- a/tests/testthat/test-bq-param.R +++ b/tests/testthat/test-bq-param.R @@ -16,3 +16,10 @@ test_that("parameter json doesn't change without notice", { )) }) }) + +test_that("checks inputs", { + expect_snapshot(error = TRUE, { + bq_param_scalar(1:3) + bq_param_array(integer()) + }) +}) diff --git a/tests/testthat/test-bq-parse.R b/tests/testthat/test-bq-parse.R index 1ff942d1..3ab392e7 100644 --- a/tests/testthat/test-bq-parse.R +++ b/tests/testthat/test-bq-parse.R @@ -123,8 +123,8 @@ test_that("can parse arrays of structs", { # Complete files ---------------------------------------------------------- replay_query <- function(name, sql) { - schema_path <- test_path(glue("parse-schema-{name}.json")) - values_path <- test_path(glue("parse-values-{name}.json")) + schema_path <- test_path(sprintf("parse-schema-%s.json", name)) + values_path <- test_path(sprintf("parse-values-%s.json", name)) if (!file.exists(schema_path)) { tbl <- bq_project_query(bq_test_project(), sql) diff --git a/tests/testthat/test-dbi-connection.R b/tests/testthat/test-dbi-connection.R index 296403aa..cfd9fa2f 100644 --- a/tests/testthat/test-dbi-connection.R +++ b/tests/testthat/test-dbi-connection.R @@ -75,13 +75,20 @@ test_that("can execute a query", { con <- DBI::dbConnect(bq_dataset(tb$project, tb$dataset)) DBI::dbWriteTable(con, tb$table, data.frame(x = 1:4)) - out <- dbExecute(con, glue("UPDATE {tb$table} SET x = x + 1 WHERE true")) + out <- dbExecute(con, sprintf("UPDATE %s SET x = x + 1 WHERE true", tb$table)) expect_equal(out, 4) - out <- dbExecute(con, glue("DELETE {tb$table} WHERE x <= 3")) + out <- dbExecute(con, sprintf("DELETE %s WHERE x <= 3", tb$table)) expect_equal(out, 2) }) +test_that("can use parameters", { + con <- DBI::dbConnect(bigquery(), project = bq_test_project()) + + df <- DBI::dbGetQuery(con, "SELECT @x AS value", params = list(x = 1)) + expect_equal(df, tibble(value = 1)) +}) + test_that("can use DBI::Id()", { ds <- bq_test_dataset() con <- DBI::dbConnect(ds) diff --git a/tests/testthat/test-dbi-result.R b/tests/testthat/test-dbi-result.R index 88428ce5..a534639a 100644 --- a/tests/testthat/test-dbi-result.R +++ b/tests/testthat/test-dbi-result.R @@ -30,6 +30,8 @@ test_that("can retrieve query in pieces and that quiet is respected", { res <- DBI::dbSendQuery(con, "SELECT cyl, mpg FROM mtcars") expect_equal(DBI::dbGetRowCount(res), 0L) + expect_snapshot(DBI::dbFetch(res, NA), error = TRUE) + res@quiet <- FALSE expect_snapshot(df <- DBI::dbFetch(res, 10)) diff --git a/tests/testthat/test-dplyr.R b/tests/testthat/test-dplyr.R index 0416957b..8cd2e1be 100644 --- a/tests/testthat/test-dplyr.R +++ b/tests/testthat/test-dplyr.R @@ -137,6 +137,22 @@ test_that("runif is correctly translated", { ) }) +test_that("string functions correctly", { + con <- simulate_bigrquery() + + expect_snapshot({ + dbplyr::translate_sql(grepl("a.c", x), con = con) + dbplyr::translate_sql(gsub("a.c", "", x), con = con) + }) +}) + +test_that("median is correctly translated", { + expect_equal( + dbplyr::translate_sql(median(x), con = simulate_bigrquery(), window = FALSE), + dbplyr::sql("APPROX_QUANTILES(`x`, 2)[SAFE_ORDINAL(2)]") + ) +}) + test_that("can correctly print a lazy query", { con <- DBI::dbConnect( bigquery(),