feat: New dbFetchArrowChunk() generic with different semantics

NAMESPACE

@@ -28,6 +28,7 @@ export(dbExecute)
 export(dbExistsTable)
 export(dbFetch)
 export(dbFetchArrow)
+export(dbFetchArrowChunk)
 export(dbGetConnectArgs)
 export(dbGetDBIVersion)
 export(dbGetException)
@@ -98,6 +99,7 @@ exportMethods(dbExecute)
 exportMethods(dbExistsTable)
 exportMethods(dbFetch)
 exportMethods(dbFetchArrow)
+exportMethods(dbFetchArrowChunk)
 exportMethods(dbGetConnectArgs)
 exportMethods(dbGetInfo)
 exportMethods(dbGetQuery)

R/dbFetchArrowChunk.R

@@ -0,0 +1,5 @@
+#' @rdname dbFetch
+#' @export
+setGeneric("dbFetchArrowChunk",
+  def = function(res, ...) standardGeneric("dbFetchArrowChunk")
+)

R/dbFetchArrowChunk_DBIResultArrow.R

@@ -0,0 +1,10 @@
+#' @rdname hidden_aliases
+#' @usage NULL
+dbFetchArrowChunk_DBIResultArrow <- function(res, ...) {
+  nanoarrow::as_nanoarrow_array(
+    dbFetch(res@result, n = 256, ...)
+  )
+}
+#' @rdname hidden_aliases
+#' @export
+setMethod("dbFetchArrowChunk", signature("DBIResultArrow"), dbFetchArrowChunk_DBIResultArrow)

R/dbFetchArrow_DBIResultArrow.R

@@ -1,10 +1,22 @@
 #' @rdname hidden_aliases
 #' @usage NULL
 dbFetchArrow_DBIResultArrow <- function(res, ...) {
-  nanoarrow::as_nanoarrow_array_stream(
-    dbFetch(res@result, n = -1, ...)
-  )
+  chunk <- dbFetchArrowChunk_DBIResultArrow(res)
+  out <- list(chunk)
+  # Corner case: add empty chunk only for zero rows, for schema
+  if (chunk$length == 0) {
+    return(nanoarrow::basic_array_stream(out, validate = FALSE))
+  }
+
+  repeat {
+    chunk <- dbFetchArrowChunk_DBIResultArrow(res)
+    if (chunk$length == 0) {
+      return(nanoarrow::basic_array_stream(out, validate = FALSE))
+    }
+    out <- c(out, list(chunk))
+  }
 }
+
 #' @rdname hidden_aliases
 #' @export
 setMethod("dbFetchArrow", signature("DBIResultArrow"), dbFetchArrow_DBIResultArrow)

R/dbSendQueryArrow_DBIConnection.R

@@ -5,10 +5,9 @@ dbSendQueryArrow_DBIConnection <- function(conn, statement, params = NULL, ...)
     params <- as.data.frame(params)
   }
 
-  new(
-    "DBIResultArrowDefault",
-    result = dbSendQuery(conn, statement, params = params, ...)
-  )
+  result <- dbSendQuery(conn, statement, params = params, ...)
+
+  new("DBIResultArrowDefault", result = result)
 }
 #' @rdname hidden_aliases
 #' @export

vignettes/DBI-arrow.Rmd

@@ -57,6 +57,7 @@ Apache Arrow is
     - `dbGetQueryArrow()`
     - `dbSendQueryArrow()`
     - `dbFetchArrow()`
+    - `dbFetchArrowChunk()`
     - `dbWriteTableArrow()`
 
 - New classes: