Wrap glue errors, if possible (#294)

Fixes #229

DESCRIPTION

@@ -27,6 +27,7 @@ Suggests:
     dplyr,
     knitr,
     magrittr,
+    rlang,
     rmarkdown,
     RSQLite,
     testthat (>= 3.2.0),

NEWS.md

@@ -1,5 +1,8 @@
 # glue (development version)
 
+* If rlang is installed, glue will generate more informative errors if an
+  interpolated expression either can't be parsed or fails to evaluate (#229).
+
 * `+` now works in more situations, and gives errors when one side isn't a 
   character vector. It no longer automatically applies glue interpolation to
   a non-glue input, if there is one. You'll need to do that yourself (#286).

R/sql.R

@@ -212,7 +212,7 @@ sql_quote_transformer <- function(connection, .na) {
     is_quoted <- any(m[[1]] != -1)
     if (is_quoted) {
       regmatches(text, m) <- ""
-      res <- eval(parse(text = text, keep.source = FALSE), envir)
+      res <- identity_transformer(text, envir)
 
       if (length(res) == 1) {
         res <- DBI::dbQuoteIdentifier(conn = connection, res)
@@ -222,7 +222,7 @@ sql_quote_transformer <- function(connection, .na) {
         res[] <- lapply(res, DBI::dbQuoteIdentifier, conn = connection)
       }
     } else {
-      res <- eval(parse(text = text, keep.source = FALSE), envir)
+      res <- identity_transformer(text, envir)
       if (length(res) == 0L) {
         if (should_collapse) {
           return("")

R/transformer.R

@@ -7,6 +7,30 @@
 #' @seealso `vignette("transformers", "glue")` for documentation on creating
 #'   custom glue transformers and some common use cases.
 #' @export
-identity_transformer <- function(text, envir) {
-  eval(parse(text = text, keep.source = FALSE), envir)
+identity_transformer <- function(text, envir = parent.frame()) {
+  with_glue_error(
+    expr <- parse(text = text, keep.source = FALSE),
+    "Failed to parse glue component"
+  )
+  with_glue_error(
+    eval(expr, envir),
+    paste0("Failed to evaluate glue component {", text, "}")
+  )
+}
+
+with_glue_error <- function(expr, message) {
+  if (!requireNamespace("rlang", quietly = TRUE)) {
+    return(expr)
+  }
+
+  withCallingHandlers(
+    expr,
+    error = function(cnd) {
+      rlang::abort(
+        message,
+        parent = cnd,
+        call = NULL
+      )
+    }
+  )
 }

tests/testthat/_snaps/sql.md

@@ -0,0 +1,19 @@
+# get nice errors if rlang installed
+
+    Code
+      glue_sql("{x + }")
+    Condition
+      Error:
+      ! Failed to parse glue component
+      Caused by error in `parse()`:
+      ! <text>:2:0: unexpected end of input
+      1: x + 
+         ^
+    Code
+      glue_sql("{NOTFOUND}")
+    Condition
+      Error:
+      ! Failed to evaluate glue component {NOTFOUND}
+      Caused by error:
+      ! object 'NOTFOUND' not found
+

tests/testthat/_snaps/transformer.md

@@ -0,0 +1,19 @@
+# get nice errors if rlang installed
+
+    Code
+      identity_transformer("x + ")
+    Condition
+      Error:
+      ! Failed to parse glue component
+      Caused by error in `parse()`:
+      ! <text>:2:0: unexpected end of input
+      1: x + 
+         ^
+    Code
+      identity_transformer("NOTFOUND")
+    Condition
+      Error:
+      ! Failed to evaluate glue component {NOTFOUND}
+      Caused by error:
+      ! object 'NOTFOUND' not found
+

tests/testthat/test-sql.R

@@ -130,3 +130,10 @@ describe("glue_sql_collapse", {
     )
   })
 })
+
+test_that("get nice errors if rlang installed", {
+  expect_snapshot(error = TRUE, {
+    glue_sql("{x + }")
+    glue_sql("{NOTFOUND}")
+  })
+})

tests/testthat/test-transformer.R

@@ -0,0 +1,6 @@
+test_that("get nice errors if rlang installed", {
+  expect_snapshot(error = TRUE, {
+    identity_transformer("x + ")
+    identity_transformer("NOTFOUND")
+  })
+})