Sync with RSQLite

DESCRIPTION

@@ -43,15 +43,16 @@ Depends:
 Imports: 
     bit64,
     blob (>= 1.2.0),
-    DBI (>= 1.1.0),
+    DBI (>= 1.2.0),
     lifecycle,
     memoise,
     methods,
-    pkgconfig
+    pkgconfig,
+    rlang
 Suggests: 
     callr,
     covr,
-    DBItest (>= 1.7.2.9001),
+    DBItest (>= 1.8.0),
     gert,
     gh,
     hms,
@@ -67,6 +68,9 @@ LinkingTo:
     plogr (>= 0.2.0)
 VignetteBuilder: 
     knitr
+Remotes: 
+    r-dbi/DBI,
+    r-dbi/DBItest
 Config/autostyle/scope: line_breaks
 Config/autostyle/strict: false
 Config/testthat/edition: 3
@@ -99,6 +103,7 @@ Collate:
     'dbDataType_SQLiteConnection.R'
     'dbDataType_SQLiteDriver.R'
     'dbDisconnect_SQLiteConnection.R'
+    'dbExistsTable_SQLiteConnection_Id.R'
     'dbExistsTable_SQLiteConnection_character.R'
     'dbFetch_SQLiteResult.R'
     'dbGetException_SQLiteConnection.R'
@@ -131,11 +136,12 @@ Collate:
     'deprecated.R'
     'export.R'
     'fetch_SQLiteResult.R'
+    'import-standalone-check_suggested.R'
+    'import-standalone-purrr.R'
     'initExtension.R'
     'initRegExp.R'
     'isSQLKeyword_SQLiteConnection_character.R'
     'make.db.names_SQLiteConnection_character.R'
-    'names.R'
     'pkgconfig.R'
     'show_SQLiteConnection.R'
     'sqlData_SQLiteConnection.R'

NAMESPACE

@@ -28,24 +28,31 @@ exportClasses(SQLiteDriver)
 exportClasses(SQLiteResult)
 exportMethods(SQLKeywords)
 exportMethods(dbAppendTable)
+exportMethods(dbAppendTableArrow)
 exportMethods(dbBegin)
 exportMethods(dbBind)
+exportMethods(dbBindArrow)
 exportMethods(dbCanConnect)
 exportMethods(dbClearResult)
 exportMethods(dbColumnInfo)
 exportMethods(dbCommit)
 exportMethods(dbConnect)
 exportMethods(dbCreateTable)
+exportMethods(dbCreateTableArrow)
 exportMethods(dbDataType)
 exportMethods(dbDisconnect)
 exportMethods(dbDriver)
 exportMethods(dbExecute)
 exportMethods(dbExistsTable)
 exportMethods(dbFetch)
+exportMethods(dbFetchArrow)
+exportMethods(dbFetchArrowChunk)
+exportMethods(dbGetConnectArgs)
 exportMethods(dbGetException)
 exportMethods(dbGetInfo)
 exportMethods(dbGetPreparedQuery)
 exportMethods(dbGetQuery)
+exportMethods(dbGetQueryArrow)
 exportMethods(dbGetRowCount)
 exportMethods(dbGetRowsAffected)
 exportMethods(dbGetStatement)
@@ -60,22 +67,26 @@ exportMethods(dbQuoteIdentifier)
 exportMethods(dbQuoteLiteral)
 exportMethods(dbQuoteString)
 exportMethods(dbReadTable)
+exportMethods(dbReadTableArrow)
 exportMethods(dbRemoveTable)
 exportMethods(dbRollback)
 exportMethods(dbSendPreparedQuery)
 exportMethods(dbSendQuery)
+exportMethods(dbSendQueryArrow)
 exportMethods(dbSendStatement)
 exportMethods(dbUnloadDriver)
 exportMethods(dbUnquoteIdentifier)
 exportMethods(dbWithTransaction)
 exportMethods(dbWriteTable)
+exportMethods(dbWriteTableArrow)
 exportMethods(fetch)
 exportMethods(isSQLKeyword)
 exportMethods(make.db.names)
 exportMethods(show)
 exportMethods(sqlData)
 import(DBI)
 import(methods)
+import(rlang)
 importFrom(DBI,Id)
 importFrom(bit64,integer64)
 importFrom(bit64,is.integer64)

R/SQLite.R

@@ -74,3 +74,7 @@ check_vfs <- function(vfs) {
 #
 # This function checks for known protocols, or for a colon at the beginning.
 is_url_or_special_filename <- function(x) grepl("^(?:file|http|ftp|https|):", x)
+
+
+#' @import rlang
+NULL

R/dbColumnInfo_SQLiteResult.R

@@ -2,7 +2,6 @@
 #' @usage NULL
 dbColumnInfo_SQLiteResult <- function(res, ...) {
   df <- result_column_info(res@ptr)
-  df$name <- tidy_names(df$name)
   df
 }
 #' @rdname SQLiteResult-class

R/dbConnect_SQLiteDriver.R

@@ -109,9 +109,7 @@ dbConnect_SQLiteDriver <- function(drv, dbname = "", ..., loadable.extensions =
 
   extended_types <- isTRUE(extended_types)
   if (extended_types) {
-    if (!requireNamespace("hms", quietly = TRUE)) {
-      stopc("Install the hms package for `extended_types = TRUE`.")
-    }
+    check_suggested("hms", "dbConnect")
   }
   conn <- new("SQLiteConnection",
     ptr = connection_connect(dbname, loadable.extensions, flags, vfs, extended_types),

R/dbExistsTable_SQLiteConnection_Id.R

@@ -0,0 +1,27 @@
+#' @rdname SQLiteConnection-class
+#' @usage NULL
+dbExistsTable_SQLiteConnection_Id <- function(conn, name, ...) {
+  stopifnot(is(name, "Id"))
+
+  id <- as.list(dbUnquoteIdentifier(conn, dbQuoteIdentifier(conn, name))[[1]]@name)
+  schema <- id$schema
+  table <- id$table
+
+  if (!is.null(schema)) {
+    schemas <- dbGetQuery(conn, "SELECT name FROM pragma_database_list;")$name
+
+    if (!(schema %in% schemas)) {
+      return(FALSE)
+    }
+  }
+
+  sql <- sqliteListTablesQuery(conn, schema, SQL("$name"))
+  rs <- dbSendQuery(conn, sql)
+  dbBind(rs, list(name = tolower(table)))
+  on.exit(dbClearResult(rs), add = TRUE)
+
+  nrow(dbFetch(rs, 1L)) > 0
+}
+#' @rdname SQLiteConnection-class
+#' @export
+setMethod("dbExistsTable", c("SQLiteConnection", "Id"), dbExistsTable_SQLiteConnection_Id)

R/dbFetch_SQLiteResult.R

@@ -4,13 +4,17 @@ dbFetch_SQLiteResult <- function(res, n = -1, ...,
                                  row.names = pkgconfig::get_config("RSQLCipher::row.names.query", FALSE)) {
   row.names <- compatRowNames(row.names)
   if (length(n) != 1) stopc("`n` must be scalar")
-  if (n < -1) stopc("`n` must be nonnegative or -1")
+  if (is.na(n)) {
+    n <- 256L
+  } else if (n < -1) {
+    stopc("`n` must be nonnegative or -1")
+  }
   if (is.infinite(n)) n <- -1
   if (trunc(n) != n) stopc("`n` must be a whole number")
   ret <- result_fetch(res@ptr, n = n)
   ret <- convert_bigint(ret, res@bigint)
   ret <- sqlColumnToRownames(ret, row.names)
-  set_tidy_names(ret)
+  ret
 }
 #' @rdname SQLiteResult-class
 #' @export

R/db_bind.R

@@ -16,7 +16,7 @@ db_bind <- function(res, params, ..., allow_named_superset) {
   }
 
   if (any(empty) || any(numbers)) {
-    if (!is.null(names(params))) {
+    if (!is.null(names(params)) || any(names(params) != "")) {
       stopc("Cannot use named parameters for anonymous/numbered placeholders")
     }
   } else {

R/export.R

@@ -1,18 +1,20 @@
-# Created with:
-# methods::getGenerics(asNamespace("DBI")) %>%
-#   grep("^db[A-Z]", ., value = TRUE) %>%
-#   setdiff(c("dbCallProc", "dbListConnections", "dbSetDataMappings", "dbGetException")) %>%
-#   paste0("#' @exportMethod ", ., "\nNULL\n", collapse = "\n") %>%
-#   cat(file = "R/export.R")
+# Generated by helper-reexport.R, do not edit by hand
+
 #' @exportMethod dbAppendTable
 NULL
 
+#' @exportMethod dbAppendTableArrow
+NULL
+
 #' @exportMethod dbBegin
 NULL
 
 #' @exportMethod dbBind
 NULL
 
+#' @exportMethod dbBindArrow
+NULL
+
 #' @exportMethod dbCanConnect
 NULL
 
@@ -31,6 +33,9 @@ NULL
 #' @exportMethod dbCreateTable
 NULL
 
+#' @exportMethod dbCreateTableArrow
+NULL
+
 #' @exportMethod dbDataType
 NULL
 
@@ -49,12 +54,24 @@ NULL
 #' @exportMethod dbFetch
 NULL
 
+#' @exportMethod dbFetchArrow
+NULL
+
+#' @exportMethod dbFetchArrowChunk
+NULL
+
+#' @exportMethod dbGetConnectArgs
+NULL
+
 #' @exportMethod dbGetInfo
 NULL
 
 #' @exportMethod dbGetQuery
 NULL
 
+#' @exportMethod dbGetQueryArrow
+NULL
+
 #' @exportMethod dbGetRowCount
 NULL
 
@@ -91,15 +108,15 @@ NULL
 #' @exportMethod dbQuoteLiteral
 NULL
 
-#' @exportMethod dbQuoteLiteral
-NULL
-
 #' @exportMethod dbQuoteString
 NULL
 
 #' @exportMethod dbReadTable
 NULL
 
+#' @exportMethod dbReadTableArrow
+NULL
+
 #' @exportMethod dbRemoveTable
 NULL
 
@@ -109,6 +126,9 @@ NULL
 #' @exportMethod dbSendQuery
 NULL
 
+#' @exportMethod dbSendQueryArrow
+NULL
+
 #' @exportMethod dbSendStatement
 NULL
 
@@ -124,5 +144,8 @@ NULL
 #' @exportMethod dbWriteTable
 NULL
 
+#' @exportMethod dbWriteTableArrow
+NULL
+
 #' @export
 DBI::Id

R/import-standalone-check_suggested.R

@@ -0,0 +1,79 @@
+# Standalone file: do not edit by hand
+# Source: <https://https://github.com/cynkra/dm/blob/HEAD/R/standalone-check_suggested.R>
+# Generated by `usethis::use_standalone("cynkra/dm", "standalone-check_suggested.R", "HEAD", "https://github.com")`
+# ----------------------------------------------------------------------
+#
+# ---
+# repo: cynkra/dm
+# file: standalone-check_suggested.R
+# last-updated: 2023-02-23
+# license: https://unlicense.org
+# imports: rlang, cli, glue
+# ---
+#
+# This file provides a wrapper around `rlang::check_installed()` that skips tests
+# and supports optional usage.
+#
+# Needs functions from rlang, and purrr or standalone-purrr.R.
+#
+# ## Changelog
+#
+# 2023-10-19:
+# * Initial
+
+# nocov start
+
+#' Check if suggested package is installed
+#'
+#' @param packages Vector of package names to check. Can supply a version
+#'   between parenthesis. (See examples).
+#' @param top_level_fun the name of the top level function called.
+#' @param use whether to trigger the check, `NA` means `TRUE` if `is_interactive()`
+#'   and `FALSE` otherwise
+#' @return whether check was triggered and all packages are installed
+#' @noRd
+#' @examples
+#' check_suggested(c("testthat (>= 3.2.0)", "xxx"), "foo")
+check_suggested <- function(packages, top_level_fun, use = TRUE) {
+  # If NA, inform that package isn't installed, but only in interactive mode
+  only_msg <- is.na(use)
+  if (only_msg) {
+    use <- rlang::is_interactive()
+  }
+
+  if (!use) {
+    return(FALSE)
+  }
+
+  # Check installation status if `use` was not `FALSE`
+  installed <- map_lgl(packages, rlang::is_installed)
+
+  if (all(installed)) {
+    return(TRUE)
+  }
+
+  if (only_msg) {
+    stopc("NYI")
+  }
+
+  # Skip if some packages are not installed when testing
+  # And say which package was not installed.
+  if (identical(Sys.getenv("TESTTHAT"), "true")) {
+    pkgs_not_installed <- packages[!installed]
+    message <- "{.fn {top_level_fun}} needs the {.pkg {.val {pkgs_not_installed}}} package{?s}."
+    testthat::skip(message)
+  }
+
+  # If in interactive session, a prompt will ask user if they want
+  # to install the package.
+  # check_installed() uses pak for installation
+  # if it's installed on the user system.
+
+  # Which message to display in the prompt
+  rlang::check_installed(packages, reason = paste0("to use `", top_level_fun, "()`."))
+
+  # If check_installed() returns, all packages are installed
+  TRUE
+}
+
+# nocov end