From 4ba454499eb63a425c2bdc9b77c77710a36e1927 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Fri, 22 Dec 2023 11:29:05 -0600
Subject: [PATCH 1/6] Improve $ handling

Fixes #1368
---
 NAMESPACE                         |  2 --
 NEWS.md                           |  5 +++++
 R/backend-.R                      |  5 ++++-
 R/escape.R                        | 10 ----------
 R/tidyeval.R                      | 15 +++++++++++++-
 tests/testthat/_snaps/backend-.md | 21 ++++++++++++++++++++
 tests/testthat/_snaps/escape.md   | 18 -----------------
 tests/testthat/_snaps/tidyeval.md | 33 +++++++++++++++++++++++++++++++
 tests/testthat/test-backend-.R    |  7 +++++++
 tests/testthat/test-escape.R      |  9 ---------
 tests/testthat/test-tidyeval.R    | 16 +++++++++++++++
 11 files changed, 100 insertions(+), 41 deletions(-)
 create mode 100644 tests/testthat/_snaps/tidyeval.md

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 9dfbc547f..a61c6eaaf 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,10 @@
 # dbplyr (development version)
 
+* Clearer error if you attempt to embed a list inside of a generated 
+  query (#1368).
+  
+* `x$name` never attempts to evaluate `name` (#1368).
+
 * SQL server: `filter()` does a better job of converting logical vectors 
   from bit to boolean (@ejneer, #1288). 
 
diff --git a/R/backend-.R b/R/backend-.R
index 2fb679427..9d04f2fe6 100644
--- a/R/backend-.R
+++ b/R/backend-.R
@@ -61,7 +61,10 @@ base_scalar <- sql_translator(
     }
   },
 
-  `$`   = sql_infix(".", pad = FALSE),
+  `$`   = function(x, name) {
+    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 293fffb0e..1f1b67dab 100644
--- a/R/tidyeval.R
+++ b/R/tidyeval.R
@@ -153,7 +153,16 @@ 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)
+    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"))
+    } else if (is_bare_list(val)) {
+      error_embed("a list", name)
+    } else {
+      val
+    }
   } else {
     cli::cli_abort(
       "Object {.var {name}} not found.",
@@ -221,6 +230,10 @@ partial_eval_call <- function(call, data, env) {
       eval_bare(call[[2]], env)
     } else if (name == "remote") {
       call[[2]]
+    } else if (name == "$") {
+      # 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..775843e01 100644
--- a/tests/testthat/_snaps/backend-.md
+++ b/tests/testthat/_snaps/backend-.md
@@ -11,6 +11,27 @@
       Error in `a[[TRUE]]`:
       ! Can only index with strings and numbers
 
+# $ doesn't evaluate second argument
+
+    Code
+      filter(lazy_frame(x = 1, y = 1), x == y$id)
+    Output
+      <SQL>
+      SELECT `df`.*
+      FROM `df`
+      WHERE (`x` = `y`.`id`)
+
+---
+
+    Code
+      filter(lazy_frame(x = 1), 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)`?
+
 # can translate case insensitive like
 
     Code
diff --git a/tests/testthat/_snaps/escape.md b/tests/testthat/_snaps/escape.md
index 127b5776b..81475114a 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
diff --git a/tests/testthat/_snaps/tidyeval.md b/tests/testthat/_snaps/tidyeval.md
new file mode 100644
index 000000000..c0479ce48
--- /dev/null
+++ b/tests/testthat/_snaps/tidyeval.md
@@ -0,0 +1,33 @@
+# unless they're reactive objects, data.frames, or lists
+
+    Code
+      lf %>% filter(a == input$x)
+    Condition
+      Error in `filter()`:
+      i In argument: `a == input$x`
+      Caused by 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())
+    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())`?
+    Code
+      lf %>% filter(a == df$foo)
+    Condition
+      Error in `filter()`:
+      i In argument: `a == df$foo`
+      Caused by 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
+      lf %>% filter(a == l$foo)
+    Condition
+      Error in `filter()`:
+      i In argument: `a == l$foo`
+      Caused by error:
+      ! Cannot translate a list to SQL.
+      i Do you want to force evaluation in R with (e.g.) `!!l` or `local(l)`?
+
diff --git a/tests/testthat/test-backend-.R b/tests/testthat/test-backend-.R
index db1808f28..8402f4ef3 100644
--- a/tests/testthat/test-backend-.R
+++ b/tests/testthat/test-backend-.R
@@ -77,6 +77,13 @@ 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)
+})
+
 
 # window ------------------------------------------------------------------
 
diff --git a/tests/testthat/test-escape.R b/tests/testthat/test-escape.R
index f4a1e8873..156541325 100644
--- a/tests/testthat/test-escape.R
+++ b/tests/testthat/test-escape.R
@@ -108,15 +108,6 @@ 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"))
diff --git a/tests/testthat/test-tidyeval.R b/tests/testthat/test-tidyeval.R
index 652e90207..57f3cb3c2 100644
--- a/tests/testthat/test-tidyeval.R
+++ b/tests/testthat/test-tidyeval.R
@@ -21,6 +21,22 @@ test_that("existing non-variables get inlined", {
   expect_equal(capture_dot(lf, x + n), expr(x + 10))
 })
 
+test_that("unless they're reactive objects, data.frames, or lists", {
+  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({
+    lf %>% filter(a == input$x)
+    lf %>% filter(a == x())
+    lf %>% filter(a == df$foo)
+    lf %>% filter(a == l$foo)
+  }, error = TRUE)
+})
+
 test_that("using environment of inlined quosures", {
   lf <- lazy_frame(x = 1:10, y = 1:10)
 

From 5c69482f758169b12cc3f3e69c79cc630b7a1699 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Fri, 22 Dec 2023 11:43:17 -0600
Subject: [PATCH 2/6] Update another former escape test

---
 tests/testthat/_snaps/escape.md | 9 ---------
 tests/testthat/test-escape.R    | 4 ----
 2 files changed, 13 deletions(-)

diff --git a/tests/testthat/_snaps/escape.md b/tests/testthat/_snaps/escape.md
index 81475114a..7d5a04357 100644
--- a/tests/testthat/_snaps/escape.md
+++ b/tests/testthat/_snaps/escape.md
@@ -14,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/test-escape.R b/tests/testthat/test-escape.R
index 156541325..7d6458284 100644
--- a/tests/testthat/test-escape.R
+++ b/tests/testthat/test-escape.R
@@ -113,10 +113,6 @@ test_that("con must not be NULL", {
   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", {

From d1a12f3377b43076cd8a56d36bfc1ef70692c5ea Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Fri, 22 Dec 2023 14:53:20 -0600
Subject: [PATCH 3/6] Use magrittr pipe

---
 tests/testthat/test-backend-.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-backend-.R b/tests/testthat/test-backend-.R
index 8402f4ef3..cdc08a0eb 100644
--- a/tests/testthat/test-backend-.R
+++ b/tests/testthat/test-backend-.R
@@ -80,8 +80,8 @@ 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)
+  expect_snapshot(lazy_frame(x = 1, y = 1) %>% filter(x == y$id))
+  expect_snapshot(lazy_frame(x = 1) %>% filter(x == y$id), error = TRUE)
 })
 
 

From 77efdc7a2483831e14c5d26ab320ff451b676c49 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Fri, 22 Dec 2023 16:30:43 -0600
Subject: [PATCH 4/6] Update snapshots

---
 tests/testthat/_snaps/backend-.md | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/_snaps/backend-.md b/tests/testthat/_snaps/backend-.md
index 775843e01..05480d912 100644
--- a/tests/testthat/_snaps/backend-.md
+++ b/tests/testthat/_snaps/backend-.md
@@ -14,7 +14,7 @@
 # $ doesn't evaluate second argument
 
     Code
-      filter(lazy_frame(x = 1, y = 1), x == y$id)
+      lazy_frame(x = 1, y = 1) %>% filter(x == y$id)
     Output
       <SQL>
       SELECT `df`.*
@@ -24,7 +24,7 @@
 ---
 
     Code
-      filter(lazy_frame(x = 1), x == y$id)
+      lazy_frame(x = 1) %>% filter(x == y$id)
     Condition
       Error in `filter()`:
       i In argument: `x == y$id`

From 0364249d9a84fa81a47b2bafe993826e36610f9a Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Wed, 10 Jan 2024 08:30:24 -0600
Subject: [PATCH 5/6] Make inlining stricter and strip names

---
 NEWS.md                           |  2 +-
 R/backend-.R                      |  3 +++
 R/tidyeval.R                      | 16 ++++++++++----
 tests/testthat/_snaps/backend-.md |  8 +++++++
 tests/testthat/_snaps/tidyeval.md | 36 +++++++++++++++----------------
 tests/testthat/test-backend-.R    |  4 ++++
 tests/testthat/test-tidyeval.R    | 20 +++++++++++------
 7 files changed, 59 insertions(+), 30 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index a61c6eaaf..b46ccfef0 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,6 +1,6 @@
 # dbplyr (development version)
 
-* Clearer error if you attempt to embed a list inside of a generated 
+* Clearer error if you attempt to embed non-atomic vectors inside of a generated 
   query (#1368).
   
 * `x$name` never attempts to evaluate `name` (#1368).
diff --git a/R/backend-.R b/R/backend-.R
index 9d04f2fe6..26414d941 100644
--- a/R/backend-.R
+++ b/R/backend-.R
@@ -62,6 +62,9 @@ base_scalar <- sql_translator(
   },
 
   `$`   = 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}")
   },
 
diff --git a/R/tidyeval.R b/R/tidyeval.R
index 1f1b67dab..6527900c9 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)
 }
@@ -154,14 +158,18 @@ partial_eval_sym <- function(sym, data, env) {
     sym
   } else if (env_has(env, name, inherit = TRUE)) {
     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"))
-    } else if (is_bare_list(val)) {
-      error_embed("a list", name)
+    }
+
+    if (is_sql_literal(val)) {
+      unname(val)
     } else {
-      val
+      error_embed(obj_type_friendly(val), name)
     }
   } else {
     cli::cli_abort(
diff --git a/tests/testthat/_snaps/backend-.md b/tests/testthat/_snaps/backend-.md
index 05480d912..76d74cb61 100644
--- a/tests/testthat/_snaps/backend-.md
+++ b/tests/testthat/_snaps/backend-.md
@@ -32,6 +32,14 @@
       ! 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/tidyeval.md b/tests/testthat/_snaps/tidyeval.md
index c0479ce48..ce531d4ad 100644
--- a/tests/testthat/_snaps/tidyeval.md
+++ b/tests/testthat/_snaps/tidyeval.md
@@ -1,33 +1,31 @@
-# unless they're reactive objects, data.frames, or lists
+# other objects get informative error
 
     Code
-      lf %>% filter(a == input$x)
+      capture_dot(lf, input)
     Condition
-      Error in `filter()`:
-      i In argument: `a == input$x`
-      Caused by error:
+      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())
-    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())`?
+      capture_dot(lf, x())
+    Output
+      x()
     Code
-      lf %>% filter(a == df$foo)
+      capture_dot(lf, df)
     Condition
-      Error in `filter()`:
-      i In argument: `a == df$foo`
-      Caused by error:
+      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
-      lf %>% filter(a == l$foo)
+      capture_dot(lf, l)
     Condition
-      Error in `filter()`:
-      i In argument: `a == l$foo`
-      Caused by error:
-      ! Cannot translate a list to SQL.
+      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 cdc08a0eb..ba6ca5ce6 100644
--- a/tests/testthat/test-backend-.R
+++ b/tests/testthat/test-backend-.R
@@ -84,6 +84,10 @@ test_that("$ doesn't evaluate second argument", {
   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-tidyeval.R b/tests/testthat/test-tidyeval.R
index 57f3cb3c2..f08f4c693 100644
--- a/tests/testthat/test-tidyeval.R
+++ b/tests/testthat/test-tidyeval.R
@@ -14,14 +14,14 @@ 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("unless they're reactive objects, data.frames, or lists", {
+test_that("other objects get informative error", {
   lf <- lazy_frame(a = 1)
 
   input <- structure(list(), class = "reactivevalues")
@@ -30,13 +30,21 @@ test_that("unless they're reactive objects, data.frames, or lists", {
   df <- data.frame(x = 1)
 
   expect_snapshot({
-    lf %>% filter(a == input$x)
-    lf %>% filter(a == x())
-    lf %>% filter(a == df$foo)
-    lf %>% filter(a == l$foo)
+    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)
 

From 3c8a64755fba8a6d95813595213481f5d77250fd Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Wed, 17 Jan 2024 12:33:56 -0600
Subject: [PATCH 6/6] Update post merge

---
 R/tidyeval.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/tidyeval.R b/R/tidyeval.R
index fe53646db..92fbd89ae 100644
--- a/R/tidyeval.R
+++ b/R/tidyeval.R
@@ -230,7 +230,7 @@ partial_eval_call <- function(call, data, env) {
       eval_bare(call[[2]], env)
     } else if (is_call(call, "remote")) {
       call[[2]]
-    } else if (name == "$") {
+    } else if (is_call(call, "$")) {
       # Only the 1st argument is evaluated
       call[[2]] <- partial_eval(call[[2]], data = data, env = env)
       call