Merged origin/main into list-access

tidyverse · Jan 10, 2024 · 85eb94f · 85eb94f
2 parents 0364249 + c50f26d
commit 85eb94f
Show file tree

Hide file tree

Showing 21 changed files with 365 additions and 12 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -5,6 +5,18 @@
 
 * `x$name` never attempts to evaluate `name` (#1368).
 
+* `db_sql_render()` correctly passes on `...` when re-calling with 
+  `sql_options` set (#1394).
+
+* `-1 + x` is now translated correctly (#1420).
+
+* SQL server: clear error if you attempt to use `n_distinct()` in `mutate()`
+  or `filter()` (#1366).
+
+* Add translations for clock functions `add_years()`, `add_days()`, 
+  `date_build()`, `get_year()`, `get_month()`, `get_day()`, 
+  and `base::difftime()` on SQL server, Redshift, Snowflake, and Postgres.
+
 * SQL server: `filter()` does a better job of converting logical vectors 
   from bit to boolean (@ejneer, #1288). 
 

diff --git a/R/backend-mssql.R b/R/backend-mssql.R
@@ -350,6 +350,41 @@ simulate_mssql <- function(version = "15.0") {
           sql_expr(DATEPART(QUARTER, !!x))
         }
       },
+
+      # clock ---------------------------------------------------------------
+      add_days = function(x, n, ...) {
+        check_dots_empty()
+        sql_expr(DATEADD(DAY, !!n, !!x))
+      },
+      add_years = function(x, n, ...) {
+        check_dots_empty()
+        sql_expr(DATEADD(YEAR, !!n, !!x))
+      },
+      date_build = function(year, month = 1L, day = 1L, ..., invalid = NULL) {
+        sql_expr(DATEFROMPARTS(!!year, !!month, !!day))
+      },
+      get_year = function(x) {
+        sql_expr(DATEPART('year', !!x))
+      },
+      get_month = function(x) {
+        sql_expr(DATEPART('month', !!x))
+      },
+      get_day = function(x) {
+        sql_expr(DATEPART('day', !!x))
+      },
+
+      difftime = function(time1, time2, tz, units = "days") {
+
+        if (!missing(tz)) {
+          cli::cli_abort("The {.arg tz} argument is not supported for SQL backends.")
+        }
+
+        if (units[1] != "days") {
+          cli::cli_abort('The only supported value for {.arg units} on SQL backends is "days"')
+        }
+
+        sql_expr(DATEDIFF(day, !!time1, !!time2))
+      }
     )
 
   if (mssql_version(con) >= "11.0") { # MSSQL 2012
@@ -434,7 +469,13 @@ simulate_mssql <- function(version = "15.0") {
       },
       all = mssql_bit_int_bit(win_aggregate("MIN")),
       any = mssql_bit_int_bit(win_aggregate("MAX")),
-      row_number = win_rank("ROW_NUMBER", empty_order = TRUE)
+      row_number = win_rank("ROW_NUMBER", empty_order = TRUE),
+
+      n_distinct = function(x) {
+        cli_abort(
+          "No translation available in `mutate()`/`filter()` for SQL server."
+        )
+      }
     )
 
   )}
@@ -607,7 +648,7 @@ mssql_update_where_clause <- function(qry) {
   }
 
   qry$where <- lapply(
-    qry$where, 
+    qry$where,
     function(x) set_expr(x, bit_to_boolean(get_expr(x)))
   )
   qry

diff --git a/R/backend-oracle.R b/R/backend-oracle.R
@@ -145,7 +145,31 @@ sql_translation.Oracle <- function(con) {
 
       # lubridate --------------------------------------------------------------
       today = function() sql_expr(TRUNC(CURRENT_TIMESTAMP)),
-      now = function() sql_expr(CURRENT_TIMESTAMP)
+      now = function() sql_expr(CURRENT_TIMESTAMP),
+
+      # clock ------------------------------------------------------------------
+      add_days = function(x, n, ...) {
+        check_dots_empty()
+        sql_expr((!!x + NUMTODSINTERVAL(!!n, 'day')))
+      },
+      add_years = function(x, n, ...) {
+        check_dots_empty()
+        sql_expr((!!x + NUMTODSINTERVAL(!!n * 365.25, 'day')))
+      },
+
+      difftime = function(time1, time2, tz, units = "days") {
+
+        if (!missing(tz)) {
+          cli::cli_abort("The {.arg tz} argument is not supported for SQL backends.")
+        }
+
+        if (units[1] != "days") {
+          cli::cli_abort('The only supported value for {.arg units} on SQL backends is "days"')
+        }
+
+        sql_expr(CEIL(CAST(!!time2 %AS% DATE) - CAST(!!time1 %AS% DATE)))
+      }
+
     ),
     base_odbc_agg,
     base_odbc_win

diff --git a/R/backend-postgres.R b/R/backend-postgres.R
@@ -235,6 +235,41 @@ sql_translation.PqConnection <- function(con) {
         )
         sql_expr(DATE_TRUNC(!!unit, !!x))
       },
+
+      # clock ---------------------------------------------------------------
+      add_days = function(x, n, ...) {
+        check_dots_empty()
+        glue_sql2(sql_current_con(), "({.col x} + {.val n}*INTERVAL'1 day')")
+      },
+      add_years = function(x, n, ...) {
+        check_dots_empty()
+        glue_sql2(sql_current_con(), "({.col x} + {.val n}*INTERVAL'1 year')")
+      },
+      date_build = function(year, month = 1L, day = 1L, ..., invalid = NULL) {
+        sql_expr(make_date(!!year, !!month, !!day))
+      },
+      get_year = function(x) {
+        sql_expr(date_part('year', !!x))
+      },
+      get_month = function(x) {
+        sql_expr(date_part('month', !!x))
+      },
+      get_day = function(x) {
+        sql_expr(date_part('day', !!x))
+      },
+
+      difftime = function(time1, time2, tz, units = "days") {
+
+        if (!missing(tz)) {
+          cli::cli_abort("The {.arg tz} argument is not supported for SQL backends.")
+        }
+
+        if (units[1] != "days") {
+          cli::cli_abort('The only supported value for {.arg units} on SQL backends is "days"')
+        }
+
+        sql_expr((CAST(!!time2 %AS% DATE) - CAST(!!time1 %AS% DATE)))
+      },
     ),
     sql_translator(.parent = base_agg,
       cor = sql_aggregate_2("CORR"),

diff --git a/R/backend-redshift.R b/R/backend-redshift.R
@@ -60,6 +60,41 @@ sql_translation.RedshiftConnection <- function(con) {
       str_replace = sql_not_supported("str_replace"),
       str_replace_all = function(string, pattern, replacement) {
         sql_expr(REGEXP_REPLACE(!!string, !!pattern, !!replacement))
+      },
+
+      # clock ---------------------------------------------------------------
+      add_days = function(x, n, ...) {
+        check_dots_empty()
+        sql_expr(DATEADD(DAY, !!n, !!x))
+      },
+      add_years = function(x, n, ...) {
+        check_dots_empty()
+        sql_expr(DATEADD(YEAR, !!n, !!x))
+      },
+      date_build = function(year, month = 1L, day = 1L, ..., invalid = NULL) {
+        glue_sql2(sql_current_con(), "TO_DATE(CAST({.val year} AS TEXT) || '-' CAST({.val month} AS TEXT) || '-' || CAST({.val day} AS TEXT)), 'YYYY-MM-DD')")
+      },
+      get_year = function(x) {
+        sql_expr(DATE_PART('year', !!x))
+      },
+      get_month = function(x) {
+        sql_expr(DATE_PART('month', !!x))
+      },
+      get_day = function(x) {
+        sql_expr(DATE_PART('day', !!x))
+      },
+
+      difftime = function(time1, time2, tz, units = "days") {
+
+        if (!missing(tz)) {
+          cli::cli_abort("The {.arg tz} argument is not supported for SQL backends.")
+        }
+
+        if (units[1] != "days") {
+          cli::cli_abort('The only supported value for {.arg units} on SQL backends is "days"')
+        }
+
+        sql_expr(DATEDIFF(day, !!time1, !!time2))
       }
     ),
     sql_translator(.parent = postgres$aggregate,

diff --git a/R/backend-snowflake.R b/R/backend-snowflake.R
@@ -210,6 +210,41 @@ sql_translation.Snowflake <- function(con) {
         )
         sql_expr(DATE_TRUNC(!!unit, !!x))
       },
+      # clock ---------------------------------------------------------------
+      add_days = function(x, n, ...) {
+        check_dots_empty()
+        sql_expr(DATEADD(DAY, !!n, !!x))
+      },
+      add_years = function(x, n, ...) {
+        check_dots_empty()
+        sql_expr(DATEADD(YEAR, !!n, !!x))
+      },
+      date_build = function(year, month = 1L, day = 1L, ..., invalid = NULL) {
+        # https://docs.snowflake.com/en/sql-reference/functions/date_from_parts
+        sql_expr(DATE_FROM_PARTS(!!year, !!month, !!day))
+      },
+      get_year = function(x) {
+        sql_expr(DATE_PART('year', !!x))
+      },
+      get_month = function(x) {
+        sql_expr(DATE_PART('month', !!x))
+      },
+      get_day = function(x) {
+        sql_expr(DATE_PART('day', !!x))
+      },
+
+      difftime = function(time1, time2, tz, units = "days") {
+
+        if (!missing(tz)) {
+          cli::cli_abort("The {.arg tz} argument is not supported for SQL backends.")
+        }
+
+        if (units[1] != "days") {
+          cli::cli_abort('The only supported value for {.arg units} on SQL backends is "days"')
+        }
+
+        sql_expr(DATEDIFF(day, !!time1, !!time2))
+      },
       # LEAST / GREATEST on Snowflake will not respect na.rm = TRUE by default (similar to Oracle/Access)
       # https://docs.snowflake.com/en/sql-reference/functions/least
       # https://docs.snowflake.com/en/sql-reference/functions/greatest

diff --git a/R/backend-spark-sql.R b/R/backend-spark-sql.R
@@ -36,7 +36,42 @@ simulate_spark_sql <- function() simulate_dbi("Spark SQL")
 #' @export
 `sql_translation.Spark SQL` <- function(con) {
   sql_variant(
-    base_odbc_scalar,
+    sql_translator(.parent = base_odbc_scalar,
+       # clock ---------------------------------------------------------------
+       add_days = function(x, n, ...) {
+         check_dots_empty()
+         sql_expr(date_add(!!x, !!n))
+       },
+       add_years = function(x, n, ...) {
+         check_dots_empty()
+         sql_expr(add_months(!!!x, !!n*12))
+       },
+       date_build = function(year, month = 1L, day = 1L, ..., invalid = NULL) {
+         sql_expr(make_date(!!year, !!month, !!day))
+       },
+       get_year = function(x) {
+         sql_expr(date_part('YEAR', !!x))
+       },
+       get_month = function(x) {
+         sql_expr(date_part('MONTH', !!x))
+       },
+       get_day = function(x) {
+         sql_expr(date_part('DAY', !!x))
+       },
+
+       difftime = function(time1, time2, tz, units = "days") {
+
+         if (!missing(tz)) {
+           cli::cli_abort("The {.arg tz} argument is not supported for SQL backends.")
+         }
+
+         if (units[1] != "days") {
+           cli::cli_abort('The only supported value for {.arg units} on SQL backends is "days"')
+         }
+
+         sql_expr(datediff(!!time2, !!time1))
+       }
+    ),
     sql_translator(.parent = base_odbc_agg,
       var = sql_aggregate("VARIANCE", "var"),
       quantile = sql_quantile("PERCENTILE"),

diff --git a/R/db.R b/R/db.R
@@ -60,20 +60,20 @@ sql_join_suffix.DBIConnection <- function(con, suffix, ...) {
 db_sql_render <- function(con, sql, ..., cte = FALSE, sql_options = NULL) {
   check_bool(cte)
   if (cte) {
-  lifecycle::deprecate_soft(
+    lifecycle::deprecate_soft(
       when = "2.4.0",
       what = "db_sql_render(cte)",
       with = I("db_sql_render(sql_options = sql_options(cte = TRUE))")
     )
     sql_options <- sql_options %||% sql_options(cte = TRUE)
-    out <- db_sql_render(con, sql, sql_options = sql_options)
+    out <- db_sql_render(con, sql, ..., sql_options = sql_options)
     return(out)
   }
 
   if (is.null(sql_options)) {
     sql_options <- sql_options()
 
-    out <- db_sql_render(con, sql, sql_options = sql_options)
+    out <- db_sql_render(con, sql, ..., sql_options = sql_options)
     return(out)
   }
 

diff --git a/R/tbl-sql.R b/R/tbl-sql.R
@@ -14,7 +14,7 @@
 #'   multiple `tbl` objects.
 #' @param check_from Check if `from` is likely misspecified SQL or a table in a schema.
 tbl_sql <- function(subclass, src, from, ..., vars = NULL, check_from = TRUE) {
-  check_dots_used()
+  # Can't use check_dots_used(), #1429
   check_character(vars, allow_null = TRUE)
 
   from <- as_from(from)

diff --git a/R/tidyeval.R b/R/tidyeval.R
@@ -180,7 +180,7 @@ partial_eval_sym <- function(sym, data, env) {
 }
 
 is_namespaced_dplyr_call <- function(call) {
-  packages <- c("base", "dplyr", "stringr", "lubridate")
+  packages <- c("base", "dplyr", "stringr", "lubridate", "clock")
   is_symbol(call[[1]], "::") && is_symbol(call[[2]], packages)
 }
 

diff --git a/R/translate-sql-helpers.R b/R/translate-sql-helpers.R
@@ -175,10 +175,11 @@ sql_infix <- function(f, pad = TRUE) {
 escape_infix_expr <- function(xq, x, escape_unary_minus = FALSE) {
   infix_calls <- c("+", "-", "*", "/", "%%", "^")
   is_infix <- is_call(xq, infix_calls, n = 2)
-  is_unary_minus <- escape_unary_minus && is_call(xq, "-", n = 1)
+  is_unary_minus <- escape_unary_minus && 
+    is_call(xq, "-", n = 1) && !is_atomic(x, n = 1)
 
   if (is_infix || is_unary_minus) {
-    enpared <- glue_sql2(sql_current_con(), "({x})")
+    enpared <- glue_sql2(sql_current_con(), "({.val x})")
     return(enpared)
   }
 

diff --git a/tests/testthat/_snaps/backend-mssql.md b/tests/testthat/_snaps/backend-mssql.md
@@ -15,6 +15,14 @@
       i Use a combination of `distinct()` and `mutate()` for the same result:
         `mutate(<col> = median(x, na.rm = TRUE)) %>% distinct(<col>)`
 
+# custom window functions translated correctly
+
+    Code
+      test_translate_sql(n_distinct(x), vars_group = "x")
+    Condition
+      Error in `n_distinct()`:
+      ! No translation available in `mutate()`/`filter()` for SQL server.
+
 # custom lubridate functions translated correctly
 
     Code

diff --git a/tests/testthat/test-backend-.R b/tests/testthat/test-backend-.R
@@ -39,6 +39,7 @@ test_that("unary plus works for non-numeric expressions", {
 test_that("unary minus flips sign of number", {
   local_con(simulate_dbi())
   expect_equal(test_translate_sql(-10L), sql("-10"))
+  expect_equal(test_translate_sql(-10L + x), sql("-10 + `x`"))
   expect_equal(test_translate_sql(x == -10), sql('`x` = -10.0'))
   expect_equal(test_translate_sql(x %in% c(-1L, 0L)), sql('`x` IN (-1, 0)'))
 })