Rewrite some of the sql transformer

I think this will be more robust Fixes #185
tidyverse · May 13, 2020 · 1867133 · 1867133
1 parent 70a1461
commit 1867133
Show file tree

Hide file tree

Showing 3 changed files with 25 additions and 15 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,6 @@
 # glue (development version)
 
+* `glue_sql()` now replaces missing values correctly when collapsing values (#185).
 * `glue_sql()` now always preserves the type of the column even in the presence of missing values (#130)
 
 # glue 1.4.0

diff --git a/R/sql.R b/R/sql.R
@@ -129,16 +129,20 @@
 #' DBI::dbDisconnect(con)
 #' @export
 glue_sql <- function(..., .con, .envir = parent.frame(), .na = DBI::SQL("NULL")) {
-  DBI::SQL(glue(..., .envir = .envir, .na = .na, .transformer = sql_quote_transformer(.con)))
+  DBI::SQL(glue(..., .envir = .envir, .na = .na, .transformer = sql_quote_transformer(.con, .na)))
 }
 
 #' @rdname glue_sql
 #' @export
 glue_data_sql <- function(.x, ..., .con, .envir = parent.frame(), .na = DBI::SQL("NULL")) {
-  DBI::SQL(glue_data(.x, ..., .envir = .envir, .na = .na, .transformer = sql_quote_transformer(.con)))
+  DBI::SQL(glue_data(.x, ..., .envir = .envir, .na = .na, .transformer = sql_quote_transformer(.con, .na)))
 }
 
-sql_quote_transformer <- function(connection) {
+sql_quote_transformer <- function(connection, .na) {
+  if (is.null(.na)) {
+    .na <- DBI::SQL(NA)
+  }
+
   function(text, envir) {
     should_collapse <- grepl("[*]$", text)
     if (should_collapse) {
@@ -159,26 +163,24 @@ sql_quote_transformer <- function(connection) {
       }
     } else {
       res <- eval(parse(text = text, keep.source = FALSE), envir)
+      if (inherits(res, "SQL")) {
+        return(res)
+      }
 
       # convert objects to characters
-      if (is.object(res) && !inherits(res, "SQL")) {
+      is_object <- is.object(res)
+      if (is_object) {
         res <- as.character(res)
       }
 
-      # Convert all NA's as needed
-      if (any(is.na(res))) {
-        res[is.na(res)] <- NA
+      is_na <- is.na(res)
+      if (any(is_na)) {
+        res[is_na] <- rep(list(.na), sum(is_na))
       }
 
       is_char <- vapply(res, function(x) !is.na(x) && is.character(x), logical(1))
-
-      if (any(is_char)) {
-        res[is_char] <- DBI::dbQuoteLiteral(conn = connection, unlist(res[is_char]))
-      }
-
-      if (any(!is_char)) {
-        res[!is_char] <- DBI::SQL(conn = connection, unlist(res[!is_char]))
-      }
+      res[is_char] <- lapply(res[is_char], function(x) DBI::dbQuoteLiteral(conn = connection, x))
+      res[!is_char] <- lapply(res[!is_char], function(x) DBI::SQL(conn = connection, x))
     }
     if (should_collapse) {
       res <- glue_collapse(res, ", ")

diff --git a/tests/testthat/test-sql.R b/tests/testthat/test-sql.R
@@ -82,6 +82,13 @@ describe("glue_sql", {
     var <- list(1, 2, "three")
     expect_identical(glue_sql("x = {var}", .con = con), DBI::SQL(c("x = 1", "x = 2", "x = 'three'")))
   })
+
+  it("should handle NA when collapsing (#185)", {
+    expect_identical(glue_sql("x IN ({c(NA, 'A')*})", .con = con), DBI::SQL(paste0("x IN (NULL, 'A')")))
+    expect_identical(glue_sql("x IN ({c(NA, 1)*})", .con = con), DBI::SQL(paste0("x IN (NULL, 1)")))
+    expect_identical(glue_sql("x IN ({c(NA, 1L)*})", .con = con), DBI::SQL(paste0("x IN (NULL, 1)")))
+    expect_identical(glue_sql("x IN ({c(NA, TRUE)*})", .con = con), DBI::SQL(paste0("x IN (NULL, TRUE)")))
+  })
 })
 
 describe("glue_data_sql", {