Merged origin/main into dev-roxygen2

.github/workflows/R-CMD-check.yaml

@@ -25,8 +25,10 @@ jobs:
           - {os: macos-latest,   r: 'release'}
 
           - {os: windows-latest, r: 'release'}
+          # # some database packages (e.g. RMariaDB) might not work on old R
+          # versions on windows #1382
           # Use 3.6 to trigger usage of RTools35
-          - {os: windows-latest, r: '3.6'}
+          # - {os: windows-latest, r: '3.6'}
           # use 4.1 to check with rtools40's older compiler
           - {os: windows-latest, r: '4.1'}
 

NAMESPACE

@@ -55,9 +55,12 @@ S3method(db_copy_to,DBIConnection)
 S3method(db_create_index,DBIConnection)
 S3method(db_desc,DBIConnection)
 S3method(db_explain,DBIConnection)
+S3method(db_explain,OraConnection)
+S3method(db_explain,Oracle)
 S3method(db_query_fields,DBIConnection)
 S3method(db_query_fields,PostgreSQLConnection)
 S3method(db_save_query,DBIConnection)
+S3method(db_sql_render,"Microsoft SQL Server")
 S3method(db_sql_render,DBIConnection)
 S3method(db_supports_table_alias_with_as,DBIConnection)
 S3method(db_supports_table_alias_with_as,OraConnection)

NEWS.md

@@ -1,5 +1,29 @@
 # dbplyr (development version)
 
+* SQL server: `filter()` does a better job of converting logical vectors 
+  from bit to boolean (@ejneer, #1288). 
+
+* Oracle: Added support for `str_replace()` and `str_replace_all()` via
+  `REGEXP_REPLACE()` (@thomashulst, #1402).
+
+* Allow additional arguments to be passed from `compute()` all the way to 
+  `sql_query_save()`-method (@rsund).
+
+* The class of remote sources now includes all S4 class names, not just
+  the first (#918).
+
+* `db_explain()` now works for Oracle (@thomashulst, #1353).
+
+* Database errors now show the generated SQL, which hopefully will make it
+  faster to track down problems (#1401).
+
+* Snowflake (@nathanhaigh, #1406)
+  * Added support for `str_starts()` and `str_ends()` via `REGEXP_INSTR()`
+  * Refactored `str_detect()` to use `REGEXP_INSTR()` so now supports
+    regular expressions.
+  * Refactored `grepl()` to use `REGEXP_INSTR()` so now supports
+    case-insensitive matching through `grepl(..., ignore.case = TRUE)`
+
 * Functions qualified with the base namespace are now also translated, e.g.
   `base::paste0(x, "_1")` is now translated (@mgirlich, #1022).
 

R/backend-mssql.R

@@ -5,13 +5,13 @@
 #' details of overall translation technology. Key differences for this backend
 #' are:
 #'
-#' * `SELECT` uses `TOP` not `LIMIT`
-#' * Automatically prefixes `#` to create temporary tables. Add the prefix
+#' - `SELECT` uses `TOP` not `LIMIT`
+#' - Automatically prefixes `#` to create temporary tables. Add the prefix
 #'   yourself to avoid the message.
-#' * String basics: `paste()`, `substr()`, `nchar()`
-#' * Custom types for `as.*` functions
-#' * Lubridate extraction functions, `year()`, `month()`, `day()` etc
-#' * Semi-automated bit <-> boolean translation (see below)
+#' - String basics: `paste()`, `substr()`, `nchar()`
+#' - Custom types for `as.*` functions
+#' - Lubridate extraction functions, `year()`, `month()`, `day()` etc
+#' - Semi-automated bit <-> boolean translation (see below)
 #'
 #' Use `simulate_mssql()` with `lazy_frame()` to see simulated SQL without
 #' converting to live access database.
@@ -589,4 +589,40 @@ mssql_bit_int_bit <- function(f) {
   dplyr::if_else(x, "1", "0", "NULL")
 }
 
+#' @export
+`db_sql_render.Microsoft SQL Server` <- function(con, sql, ..., cte = FALSE, use_star = TRUE) {
+  # Post-process WHERE to cast logicals from BIT to BOOLEAN
+  sql$lazy_query <- purrr::modify_tree(
+    sql$lazy_query,
+    is_node = function(x) inherits(x, "lazy_query"),
+    post = mssql_update_where_clause
+  )
+
+  NextMethod()
+}
+
+mssql_update_where_clause <- function(qry) {
+  if (!has_name(qry, "where")) {
+    return(qry)
+  }
+
+  qry$where <- lapply(
+    qry$where, 
+    function(x) set_expr(x, bit_to_boolean(get_expr(x)))
+  )
+  qry
+}
+
+bit_to_boolean <- function(x_expr) {
+  if (is_atomic(x_expr) || is_symbol(x_expr)) {
+    expr(cast(!!x_expr %AS% BIT) == 1L)
+  } else if (is_call(x_expr, c("|", "&", "||", "&&", "!", "("))) {
+    idx <- seq2(2, length(x_expr))
+    x_expr[idx] <- lapply(x_expr[idx], bit_to_boolean)
+    x_expr
+  } else {
+    x_expr
+  }
+}
+
 utils::globalVariables(c("BIT", "CAST", "%AS%", "%is%", "convert", "DATE", "DATENAME", "DATEPART", "IIF", "NOT", "SUBSTRING", "LTRIM", "RTRIM", "CHARINDEX", "SYSDATETIME", "SECOND", "MINUTE", "HOUR", "DAY", "DAYOFWEEK", "DAYOFYEAR", "MONTH", "QUARTER", "YEAR", "BIGINT", "INT", "%AND%", "%BETWEEN%"))

R/backend-oracle.R

@@ -133,6 +133,16 @@ sql_translation.Oracle <- function(con) {
       paste0 = sql_paste_infix("", "||", function(x) sql_expr(cast(!!x %as% text))),
       str_c = sql_paste_infix("", "||", function(x) sql_expr(cast(!!x %as% text))),
 
+      # https://docs.oracle.com/en/database/oracle/oracle-database/19/sqlrf/REGEXP_REPLACE.html
+      # 4th argument is starting position (default: 1 => first char of string)
+      # 5th argument is occurrence (default: 0 => match all occurrences)
+      str_replace = function(string, pattern, replacement){
+        sql_expr(regexp_replace(!!string, !!pattern, !!replacement, 1L, 1L))
+      },
+      str_replace_all = function(string, pattern, replacement){
+        sql_expr(regexp_replace(!!string, !!pattern, !!replacement))
+      },
+
       # lubridate --------------------------------------------------------------
       today = function() sql_expr(TRUNC(CURRENT_TIMESTAMP)),
       now = function() sql_expr(CURRENT_TIMESTAMP)
@@ -144,10 +154,11 @@ sql_translation.Oracle <- function(con) {
 
 #' @export
 sql_query_explain.Oracle <- function(con, sql, ...) {
-  glue_sql2(
-    con,
-    "EXPLAIN PLAN FOR {sql};\n",
-    "SELECT PLAN_TABLE_OUTPUT FROM TABLE(DBMS_XPLAN.DISPLAY()));",
+
+  # https://docs.oracle.com/en/database/oracle/oracle-database/19/tgsql/generating-and-displaying-execution-plans.html
+  c(
+    glue_sql2(con, "EXPLAIN PLAN FOR {sql}"),
+    glue_sql2(con, "SELECT PLAN_TABLE_OUTPUT FROM TABLE(DBMS_XPLAN.DISPLAY())")
   )
 }
 
@@ -182,6 +193,18 @@ sql_expr_matches.Oracle <- function(con, x, y, ...) {
   glue_sql2(con, "decode({x}, {y}, 0, 1) = 0")
 }
 
+#' @export
+db_explain.Oracle <- function(con, sql, ...) {
+  sql <- sql_query_explain(con, sql, ...)
+
+  msg <- "Can't explain query."
+  db_execute(con, sql[[1]], msg) # EXPLAIN PLAN
+  expl <- db_get_query(con, sql[[2]], msg) # DBMS_XPLAN.DISPLAY
+
+  out <- utils::capture.output(print(expl))
+  paste(out, collapse = "\n")
+}
+
 #' @export
 db_supports_table_alias_with_as.Oracle <- function(con) {
   FALSE
@@ -219,6 +242,9 @@ setdiff.OraConnection <- setdiff.tbl_Oracle
 #' @export
 sql_expr_matches.OraConnection <- sql_expr_matches.Oracle
 
+#' @export
+db_explain.OraConnection <- db_explain.Oracle
+
 #' @export
 db_supports_table_alias_with_as.OraConnection <- db_supports_table_alias_with_as.Oracle
 

R/backend-snowflake.R

@@ -38,23 +38,38 @@ sql_translation.Snowflake <- function(con) {
       str_locate = function(string, pattern) {
         sql_expr(POSITION(!!pattern, !!string))
       },
-      # REGEXP on Snowflaake "implicitly anchors a pattern at both ends", which
-      # str_detect does not.  Left- and right-pad `pattern` with .* to get
-      # str_detect-like behavior
       str_detect = function(string, pattern, negate = FALSE) {
-        sql_str_pattern_switch(
-          string = string,
-          pattern = {{ pattern }},
-          negate = negate,
-          f_fixed = sql_str_detect_fixed_instr("detect"),
-          f_regex = function(string, pattern, negate = FALSE) {
-            if (isTRUE(negate)) {
-              sql_expr(!(((!!string)) %REGEXP% (".*" || (!!pattern) || ".*")))
-            } else {
-              sql_expr(((!!string)) %REGEXP% (".*" || (!!pattern) || ".*"))
-            }
-          }
-        )
+        con <- sql_current_con()
+
+        # Snowflake needs backslashes escaped, so we must increase the level of escaping
+        pattern <- gsub("\\", "\\\\", pattern, fixed = TRUE)
+        if (negate) {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern) == 0L, con = con)
+        } else {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern) != 0L, con = con)
+        }
+      },
+      str_starts = function(string, pattern, negate = FALSE) {
+        con <- sql_current_con()
+
+        # Snowflake needs backslashes escaped, so we must increase the level of escaping
+        pattern <- gsub("\\", "\\\\", pattern, fixed = TRUE)
+        if (negate) {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern) != 1L, con = con)
+        } else {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern) == 1L, con = con)
+        }
+      },
+      str_ends = function(string, pattern, negate = FALSE) {
+        con <- sql_current_con()
+
+        # Snowflake needs backslashes escaped, so we must increase the level of escaping
+        pattern <- gsub("\\", "\\\\", pattern, fixed = TRUE)
+        if (negate) {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern, 1L, 1L, 1L) != LENGTH(!!string) + 1L, con = con)
+        } else {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern, 1L, 1L, 1L) == LENGTH(!!string) + 1L, con = con)
+        }
       },
       # On Snowflake, REGEXP_REPLACE is used like this:
       # REGEXP_REPLACE( <subject> , <pattern> [ , <replacement> ,
@@ -261,15 +276,19 @@ snowflake_grepl <- function(pattern,
                             perl = FALSE,
                             fixed = FALSE,
                             useBytes = FALSE) {
-  # https://docs.snowflake.com/en/sql-reference/functions/regexp.html
-  check_unsupported_arg(ignore.case, FALSE, backend = "Snowflake")
+  con <- sql_current_con()
+
   check_unsupported_arg(perl, FALSE, backend = "Snowflake")
   check_unsupported_arg(fixed, FALSE, backend = "Snowflake")
   check_unsupported_arg(useBytes, FALSE, backend = "Snowflake")
-  # REGEXP on Snowflaake "implicitly anchors a pattern at both ends", which
-  # grepl does not.  Left- and right-pad `pattern` with .* to get grepl-like
-  # behavior
-  sql_expr(((!!x)) %REGEXP% (".*" || !!paste0("(", pattern, ")") || ".*"))
+
+  # https://docs.snowflake.com/en/sql-reference/functions/regexp_instr.html
+  # REGEXP_INSTR optional parameters: position, occurrance, option, regex_parameters
+  regexp_parameters <- "c"
+  if(ignore.case) { regexp_parameters <- "i" }
+  # Snowflake needs backslashes escaped, so we must increase the level of escaping
+  pattern <- gsub("\\", "\\\\", pattern, fixed = TRUE)
+  translate_sql(REGEXP_INSTR(!!x, !!pattern, 1L, 1L, 0L, !!regexp_parameters) != 0L, con = con)
 }
 
 snowflake_round <- function(x, digits = 0L) {
@@ -301,4 +320,4 @@ snowflake_pmin_pmax_builder <- function(dot_1, dot_2, comparison){
   glue_sql2(sql_current_con(), glue("COALESCE(IFF({dot_2} {comparison} {dot_1}, {dot_2}, {dot_1}), {dot_2}, {dot_1})"))
 }
 
-utils::globalVariables(c("%REGEXP%", "DAYNAME", "DECODE", "FLOAT", "MONTHNAME", "POSITION", "trim"))
+utils::globalVariables(c("%REGEXP%", "DAYNAME", "DECODE", "FLOAT", "MONTHNAME", "POSITION", "trim", "LENGTH"))

R/db-io.R

@@ -69,27 +69,24 @@ db_copy_to.DBIConnection <- function(con,
   new <- db_table_temporary(con, table, temporary)
   table <- new$table
   temporary <- new$temporary
-  call <- current_env()
-
-  with_transaction(con, in_transaction, {
-    tryCatch(
-      {
-        table <- dplyr::db_write_table(con, table,
-          types = types,
-          values = values,
-          temporary = temporary,
-          overwrite = overwrite,
-          ...
-        )
-        create_indexes(con, table, unique_indexes, unique = TRUE)
-        create_indexes(con, table, indexes)
-        if (analyze) dbplyr_analyze(con, table)
-      },
-      error = function(cnd) {
-        cli_abort("Can't copy to table {.field {format(table, con = con)}}.", parent = cnd, call = call)
-      }
-    )
-  })
+
+  with_transaction(
+    con,
+    in_transaction,
+    "Can't copy data to table {.field {format(table, con = con)}}.",
+    {
+      table <- dplyr::db_write_table(con, table,
+        types = types,
+        values = values,
+        temporary = temporary,
+        overwrite = overwrite,
+        ...
+      )
+      create_indexes(con, table, unique_indexes, unique = TRUE)
+      create_indexes(con, table, indexes)
+      if (analyze) dbplyr_analyze(con, table)
+    }
+  )
 
   table
 }
@@ -131,18 +128,24 @@ db_compute.DBIConnection <- function(con,
   table <- new$table
   temporary <- new$temporary
 
-  with_transaction(con, in_transaction, {
-    table <- dbplyr_save_query(
-      con,
-      sql,
-      table,
-      temporary = temporary,
-      overwrite = overwrite
-    )
-    create_indexes(con, table, unique_indexes, unique = TRUE)
-    create_indexes(con, table, indexes)
-    if (analyze) dbplyr_analyze(con, table)
-  })
+  with_transaction(
+    con,
+    in_transaction,
+    "Can't copy query to table {.field {format(table, con = con)}}.",
+    {
+      table <- dbplyr_save_query(
+        con,
+        sql,
+        table,
+        ...,
+        temporary = temporary,
+        overwrite = overwrite
+      )
+      create_indexes(con, table, unique_indexes, unique = TRUE)
+      create_indexes(con, table, indexes)
+      if (analyze) dbplyr_analyze(con, table)
+    }
+  )
 
   table
 }
@@ -156,14 +159,12 @@ db_collect <- function(con, sql, n = -1, warn_incomplete = TRUE, ...) {
 #' @export
 db_collect.DBIConnection <- function(con, sql, n = -1, warn_incomplete = TRUE, ...) {
   res <- dbSendQuery(con, sql)
-  tryCatch({
-    out <- dbFetch(res, n = n)
-    if (warn_incomplete) {
-      res_warn_incomplete(res, "n = Inf")
-    }
-  }, finally = {
-    dbClearResult(res)
-  })
+  on.exit(dbClearResult(res), add = TRUE)
+
+  out <- dbFetch(res, n = n)
+  if (warn_incomplete) {
+    res_warn_incomplete(res, "n = Inf")
+  }
 
   out
 }
@@ -217,14 +218,23 @@ create_indexes <- function(con, table, indexes = NULL, unique = FALSE, ...) {
   }
 }
 
-# Don't use `tryCatch()` because it messes with the callstack
-with_transaction <- function(con, in_transaction, code) {
+with_transaction <- function(con,
+                             in_transaction,
+                             msg,
+                             code,
+                             call = caller_env(),
+                             env = caller_env()) {
   if (in_transaction) {
     dbBegin(con)
     on.exit(dbRollback(con))
   }
 
-  code
+  withCallingHandlers(
+    code,
+    error = function(cnd) {
+      cli_abort(msg, parent = cnd, call = call, .envir = env)
+    }
+  )
 
   if (in_transaction) {
     on.exit()