diff --git a/NAMESPACE b/NAMESPACE index 556dda0a3..e64eb56c7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -119,7 +119,6 @@ S3method(escape,Date) S3method(escape,POSIXt) S3method(escape,blob) S3method(escape,character) -S3method(escape,data.frame) S3method(escape,dbplyr_catalog) S3method(escape,dbplyr_schema) S3method(escape,dbplyr_table_ident) @@ -131,7 +130,6 @@ S3method(escape,integer) S3method(escape,integer64) S3method(escape,list) S3method(escape,logical) -S3method(escape,reactivevalues) S3method(escape,sql) S3method(explain,tbl_sql) S3method(flatten_query,base_query) diff --git a/NEWS.md b/NEWS.md index 54b4b0347..c2ad5e3d8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # dbplyr (development version) +* Clearer error if you attempt to embed non-atomic vectors inside of a generated + query (#1368). + +* `x$name` never attempts to evaluate `name` (#1368). + * `rows_patch(in_place = FALSE)` now works when more than one column should be patched (@gorcha, #1443). diff --git a/R/backend-.R b/R/backend-.R index 2fb679427..26414d941 100644 --- a/R/backend-.R +++ b/R/backend-.R @@ -61,7 +61,13 @@ base_scalar <- sql_translator( } }, - `$` = sql_infix(".", pad = FALSE), + `$` = function(x, name) { + if (!is.sql(x)) { + cli_abort("{.code $} can only subset database columns, not inlined values.") + } + glue_sql2(sql_current_con(), "{x}.{.col name}") + }, + `[[` = function(x, i) { # `x` can be a table, column or even an expression (e.g. for json) i <- enexpr(i) diff --git a/R/escape.R b/R/escape.R index 4ddacf944..3fd64e81b 100644 --- a/R/escape.R +++ b/R/escape.R @@ -137,16 +137,6 @@ escape.list <- function(x, parens = TRUE, collapse = ", ", con = NULL) { sql_vector(pieces, parens, collapse, con = con) } -#' @export -escape.data.frame <- function(x, parens = TRUE, collapse = ", ", con = NULL) { - error_embed("a data.frame", "df$x") -} - -#' @export -escape.reactivevalues <- function(x, parens = TRUE, collapse = ", ", con = NULL) { - error_embed("shiny inputs", "input$x") -} - # Also used in default_ops() for reactives error_embed <- function(type, expr) { cli_abort(c( diff --git a/R/tidyeval.R b/R/tidyeval.R index 68a1f1724..92fbd89ae 100644 --- a/R/tidyeval.R +++ b/R/tidyeval.R @@ -66,7 +66,7 @@ partial_eval <- function(call, data, env = caller_env(), vars = NULL, error_call data <- lazy_frame(!!!rep_named(data, list(logical()))) } - if (is_atomic(call) || is_null(call) || blob::is_blob(call)) { + if (is_sql_literal(call)) { call } else if (is_symbol(call)) { partial_eval_sym(call, data, env) @@ -89,6 +89,10 @@ partial_eval <- function(call, data, env = caller_env(), vars = NULL, error_call } } +is_sql_literal <- function(x) { + is_atomic(x) || is_null(x) || blob::is_blob(x) +} + capture_dot <- function(.data, x) { partial_eval(enquo(x), data = .data) } @@ -153,7 +157,20 @@ partial_eval_sym <- function(sym, data, env) { if (name %in% vars) { sym } else if (env_has(env, name, inherit = TRUE)) { - eval_bare(sym, env) + val <- eval_bare(sym, env) + + # Handle common failure modes + if (inherits(val, "data.frame")) { + error_embed("a data.frame", paste0(name, "$x")) + } else if (inherits(val, "reactivevalues")) { + error_embed("shiny inputs", paste0(name, "$x")) + } + + if (is_sql_literal(val)) { + unname(val) + } else { + error_embed(obj_type_friendly(val), name) + } } else { cli::cli_abort( "Object {.var {name}} not found.", @@ -213,6 +230,10 @@ partial_eval_call <- function(call, data, env) { eval_bare(call[[2]], env) } else if (is_call(call, "remote")) { call[[2]] + } else if (is_call(call, "$")) { + # Only the 1st argument is evaluated + call[[2]] <- partial_eval(call[[2]], data = data, env = env) + call } else { call[-1] <- lapply(call[-1], partial_eval, data = data, env = env) call diff --git a/tests/testthat/_snaps/backend-.md b/tests/testthat/_snaps/backend-.md index e01806f34..76d74cb61 100644 --- a/tests/testthat/_snaps/backend-.md +++ b/tests/testthat/_snaps/backend-.md @@ -11,6 +11,35 @@ Error in `a[[TRUE]]`: ! Can only index with strings and numbers +# $ doesn't evaluate second argument + + Code + lazy_frame(x = 1, y = 1) %>% filter(x == y$id) + Output + + SELECT `df`.* + FROM `df` + WHERE (`x` = `y`.`id`) + +--- + + Code + lazy_frame(x = 1) %>% filter(x == y$id) + Condition + Error in `filter()`: + i In argument: `x == y$id` + Caused by error: + ! Cannot translate a list to SQL. + i Do you want to force evaluation in R with (e.g.) `!!y` or `local(y)`? + +# useful error if $ used with inlined value + + Code + lazy_frame(x = 1) %>% filter(x == y$id) + Condition + Error in `1$id`: + ! `$` can only subset database columns, not inlined values. + # can translate case insensitive like Code diff --git a/tests/testthat/_snaps/escape.md b/tests/testthat/_snaps/escape.md index 127b5776b..7d5a04357 100644 --- a/tests/testthat/_snaps/escape.md +++ b/tests/testthat/_snaps/escape.md @@ -1,21 +1,3 @@ -# shiny objects give useful errors - - Code - lf %>% filter(a == input$x) %>% show_query() - Condition - Error: - ! Cannot translate shiny inputs to SQL. - i Do you want to force evaluation in R with (e.g.) `!!input$x` or `local(input$x)`? - ---- - - Code - lf %>% filter(a == x()) %>% show_query() - Condition - Error: - ! Cannot translate a shiny reactive to SQL. - i Do you want to force evaluation in R with (e.g.) `!!foo()` or `local(foo())`? - # con must not be NULL Code @@ -32,12 +14,3 @@ Error in `sql_vector()`: ! `con` must not be NULL. -# data frames give useful errors - - Code - escape(mtcars, con = simulate_dbi()) - Condition - Error: - ! Cannot translate a data.frame to SQL. - i Do you want to force evaluation in R with (e.g.) `!!df$x` or `local(df$x)`? - diff --git a/tests/testthat/_snaps/tidyeval.md b/tests/testthat/_snaps/tidyeval.md new file mode 100644 index 000000000..ce531d4ad --- /dev/null +++ b/tests/testthat/_snaps/tidyeval.md @@ -0,0 +1,31 @@ +# other objects get informative error + + Code + capture_dot(lf, input) + Condition + Error: + ! Cannot translate shiny inputs to SQL. + i Do you want to force evaluation in R with (e.g.) `!!input$x` or `local(input$x)`? + Code + capture_dot(lf, x()) + Output + x() + Code + capture_dot(lf, df) + Condition + Error: + ! Cannot translate a data.frame to SQL. + i Do you want to force evaluation in R with (e.g.) `!!df$x` or `local(df$x)`? + Code + capture_dot(lf, l) + Condition + Error: + ! Cannot translate an empty list to SQL. + i Do you want to force evaluation in R with (e.g.) `!!l` or `local(l)`? + Code + capture_dot(lf, mean) + Condition + Error: + ! Cannot translate a function to SQL. + i Do you want to force evaluation in R with (e.g.) `!!mean` or `local(mean)`? + diff --git a/tests/testthat/test-backend-.R b/tests/testthat/test-backend-.R index b96e39886..ef58f8d9e 100644 --- a/tests/testthat/test-backend-.R +++ b/tests/testthat/test-backend-.R @@ -78,6 +78,17 @@ test_that("can translate subsetting", { }) }) +test_that("$ doesn't evaluate second argument", { + y <- list(id = 1) + + expect_snapshot(lazy_frame(x = 1, y = 1) %>% filter(x == y$id)) + expect_snapshot(lazy_frame(x = 1) %>% filter(x == y$id), error = TRUE) +}) + +test_that("useful error if $ used with inlined value", { + y <- 1 + expect_snapshot(lazy_frame(x = 1) %>% filter(x == y$id), error = TRUE) +}) # window ------------------------------------------------------------------ diff --git a/tests/testthat/test-escape.R b/tests/testthat/test-escape.R index f4a1e8873..7d6458284 100644 --- a/tests/testthat/test-escape.R +++ b/tests/testthat/test-escape.R @@ -108,24 +108,11 @@ test_that("factors are translated", { # Helpful errors -------------------------------------------------------- -test_that("shiny objects give useful errors", { - lf <- lazy_frame(a = 1) - input <- structure(list(), class = "reactivevalues") - x <- structure(function() "y", class = "reactive") - - expect_snapshot(error = TRUE, lf %>% filter(a == input$x) %>% show_query()) - expect_snapshot(error = TRUE, lf %>% filter(a == x()) %>% show_query()) -}) - test_that("con must not be NULL", { expect_snapshot(error = TRUE, escape("a")) expect_snapshot(error = TRUE, sql_vector("a")) }) -test_that("data frames give useful errors", { - expect_snapshot(error = TRUE, escape(mtcars, con = simulate_dbi())) -}) - # names_to_as() ----------------------------------------------------------- test_that("names_to_as() doesn't alias when ident name and value are identical", { diff --git a/tests/testthat/test-tidyeval.R b/tests/testthat/test-tidyeval.R index ac1fefee3..f48091368 100644 --- a/tests/testthat/test-tidyeval.R +++ b/tests/testthat/test-tidyeval.R @@ -14,13 +14,37 @@ test_that("simple expressions left as is", { expect_equal(capture_dot(lf, FALSE), FALSE) }) -test_that("existing non-variables get inlined", { +test_that("existing atomic non-variables get inlined", { lf <- lazy_frame(x = 1:10, y = 1:10) n <- 10 expect_equal(capture_dot(lf, x + n), expr(x + 10)) }) +test_that("other objects get informative error", { + lf <- lazy_frame(a = 1) + + input <- structure(list(), class = "reactivevalues") + x <- structure(function() "y", class = "reactive") + l <- list() + df <- data.frame(x = 1) + + expect_snapshot({ + capture_dot(lf, input) + capture_dot(lf, x()) + capture_dot(lf, df) + capture_dot(lf, l) + capture_dot(lf, mean) + }, error = TRUE) +}) + +test_that("names are stripped", { + lf <- lazy_frame(x = "a") + y <- c(x = "a", "b") + + expect_equal(partial_eval(quote(x %in% y), lf), expr(x %in% !!c("a", "b"))) +}) + test_that("using environment of inlined quosures", { lf <- lazy_frame(x = 1:10, y = 1:10)