Merge pull request #117 from gadenbuie/feat/collect-tbl-sql

.github/workflows/test-coverage.yaml

@@ -28,7 +28,7 @@ jobs:
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
           extra-packages: any::covr
-          needs: coverage
+          needs: coverage, rcmdcheck
 
       - name: Test coverage
         run: |

DESCRIPTION

@@ -33,7 +33,9 @@ Imports:
 Suggests:
     cleanrmd,
     commonmark,
+    dbplyr,
     debugme,
+    dplyr,
     pandoc,
     shiny,
     shinytest2,
@@ -42,7 +44,7 @@ VignetteBuilder:
     cleanrmd,
     knitr,
     rmarkdown
-Config/Needs/rcmdcheck: rstudio/chromote
+Config/Needs/rcmdcheck: RSQLite, rstudio/chromote
 Config/Needs/website: rstudio/rmarkdown, gadenbuie/grkgdown
 Config/testthat/edition: 3
 Encoding: UTF-8

NEWS.md

@@ -44,13 +44,18 @@
 * The `.titlecase` inline transformer now coerces inputs to character with
   `as.character()` before applying `tools::toTitleCase()`, since `toTitleCase()`
   will throw an error for non-character inputs. (#112)
-
+  
 * `epoxy()`, and by extension the LaTex and HTML counterparts, and all `epoxy_*`
   knitr engines gain a `.collapse` argument to determine how a vector of
   epoxy-transformed templates should be collapsed. The default is `NULL`, which
   means that the output is returned as a vector. This argument is also useful in
   `epoxy_use_chunk()` and for knitr chunks being used as a vectorized template.
   (#115)
+
+* `epoxy()`, `epoxy_html()`, `epoxy_latex()` and `epoxy_mustache()` (and their
+  related knitr engines) will all collect remote `tbl_sql` tables before
+  evaluation. This makes it much easier to pass data from a remote database
+  using `{dplyr}` and `{dbplyr}`. (#117)
 
 # epoxy 0.1.1
 

R/epoxy.R

@@ -89,6 +89,7 @@ epoxy <- function(
 
 	glue_env <- .envir
 	if (!is.null(.data)) {
+		.data <- maybe_collect(.data)
 		glue_env <- new.env(parent = .envir)
 		assign("$", epoxy_data_subset, envir = glue_env)
 		assign(".data", .data, envir = glue_env)
@@ -210,6 +211,12 @@ with_epoxy_engine <- function(engine, expr) {
 	)
 }
 
+maybe_collect <- function(x) {
+	if (!inherits(x, "tbl_sql")) return(x)
+	if (!requireNamespace("dplyr", quietly = TRUE)) return(x)
+	dplyr::collect(x)
+}
+
 epoxy_data_subset <- function(x, y) {
 	y <- substitute(y)
 	exact <- inherits(x, "tbl_df")

R/epoxy_mustache.R

@@ -61,6 +61,7 @@ epoxy_mustache <- function(
 	template <- paste(dots$unnamed, collapse = .sep)
 
 	is_data_asis <- inherits(.data, "AsIs")
+	.data <- maybe_collect(.data)
 
 	whisker_render <- purrr::partial(
 		whisker::whisker.render,

tests/testthat/test-epoxy.R

@@ -248,3 +248,32 @@ test_that("with_epoxy_engine()", {
 	expect_equal(with_epoxy_engine("latex", engine_current()), "latex")
 	expect_null(engine_current())
 })
+
+test_that("epoxy() and epoxy_mustache() collect remote `tbl_sql` tables", {
+	skip_if_not_installed("dplyr")
+	skip_if_not_installed("dbplyr")
+	skip_if_not_installed("RSQLite")
+
+	# https://dbplyr.tidyverse.org/articles/reprex.html
+	mtcars_db <- dbplyr::memdb_frame(!!!mtcars)
+	mtcars_row <- dplyr::filter(mtcars_db, cyl == 4, gear == 4, disp > 145)
+
+	expect_equal(
+		epoxy(
+			"The car with {gear} gears, weighing {wt} tons, ",
+			"and with {hp} horsepower gets {mpg} mpg.",
+			.data = mtcars_row
+		),
+		"The car with 4 gears, weighing 3.19 tons, and with 62 horsepower gets 24.4 mpg."
+	)
+
+	expect_equal(
+		epoxy_mustache(
+			"The car with {{gear}} gears, weighing {{wt}} tons, ",
+			"and with {{hp}} horsepower gets {{mpg}} mpg.",
+			.data = mtcars_row,
+			.sep = ""
+		),
+		"The car with 4 gears, weighing 3.19 tons, and with 62 horsepower gets 24.4 mpg."
+	)
+})