feat(.collapse): Add collapse argument to epoxy and all downstream functions

NEWS.md

@@ -45,6 +45,13 @@
   `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 0.1.1
 
 * `epoxy_transform_html()` now (again) returns a collapsed character string for

R/engines.R

@@ -128,6 +128,7 @@
 	defaults <- defaults[setdiff(names(defaults), exclude)]
 	defaults <- lapply(defaults, rlang::eval_bare, env = environment(fn))
 	defaults$.envir <- knitr::knit_global()
+	defaults$.collapse  <- "\n"
 
 	chunk_opt_names <- c("data", ".data", names(defaults))
 	chunk_opts <- options[intersect(chunk_opt_names, names(options))]
@@ -137,8 +138,7 @@
 	args <- purrr::list_assign(defaults, !!!chunk_opts)
 	args$.transformer <- epoxy_options_get_transformer(options)
 
-	out <- rlang::exec(fn, code, !!!args)
-	glue_collapse(out, sep = "\n")
+	rlang::exec(fn, code, !!!args)
 }
 
 knitr_engine_epoxy <- function(options) {
@@ -249,7 +249,7 @@
 	x_len <- vapply(x, length, integer(1))
 	x_null <- vapply(x, is.null, logical(1))
 	if (length(unique(x_len[!x_null])) != 1 && !all(x_len[!x_null] > 0)) {
 		stop("data must be the same length: ", paste(x_len[!x_null], collapse = ", "), call. = FALSE)
 	}
 
 	# turn list(a = 1:2, b = 3:4, c = 5)
@@ -266,7 +266,7 @@
 	chunk_opts[["echo"]] %||% options[[".echo"]] %||% FALSE
 }
 
 deprecate_glue_data_chunk_option <- function(options) {
 	if ("glue_data" %in% names(options)) {
 		lifecycle::deprecate_stop(
 			when = "0.0.2",
@@ -277,7 +277,7 @@
 	options
 }
 
 deprecate_epoxy_style_chunk_option <- function(options) {
 	if (is.null(options[["epoxy_style"]])) {
 		return()
 	}

R/epoxy.R

@@ -44,6 +44,8 @@
 #'   around the template variable or expression. Doubling the full delimiter
 #'   escapes it.
 ####
+#' @param .collapse A character string used to collapse a vector result into a
+#'   single value. If `NULL` (the default), the result is not collapsed.
 #' @inheritParams glue::glue
 #'
 #' @return Returns a transformed string, using `glue::glue()` but with the
@@ -72,6 +74,7 @@ epoxy <- function(
 	.literal = FALSE,
 	.trim = FALSE,
 	.transformer = NULL,
+	.collapse = NULL,
 	.style = lifecycle::deprecated()
 ) {
 	if (lifecycle::is_present(.style)) {
@@ -100,7 +103,7 @@ epoxy <- function(
 	old_opts <- options("epoxy:::private" = list(.open = .open, .close = .close))
 	on.exit(old_opts, add = TRUE)
 
-	glue_data(
+	res <- glue_data(
 		.x = .data,
 		...,
 		.sep     = .sep,
@@ -114,6 +117,12 @@ epoxy <- function(
 		.trim    = .trim,
 		.transformer = epoxy_options_get_transformer(opts_transformer)
 	)
+
+	if (is.null(.collapse) || length(res) <= 1) {
+		return(res)
+	}
+
+	glue_collapse(res, sep = .collapse)
 }
 
 
@@ -131,7 +140,8 @@ epoxy_html <- function(
 	.comment = "",
 	.literal = FALSE,
 	.trim = FALSE,
-	.transformer = NULL
+	.transformer = NULL,
+	.collapse = NULL
 ) {
 	res <-
 		with_epoxy_engine(
@@ -148,7 +158,8 @@ epoxy_html <- function(
 				.comment = .comment,
 				.literal = .literal,
 				.trim = .trim,
-				.transformer = .transformer
+				.transformer = .transformer,
+				.collapse = .collapse
 			)
 		)
 	html_chr(res)
@@ -169,7 +180,8 @@ epoxy_latex <- function(
 	.comment = "",
 	.literal = FALSE,
 	.trim = FALSE,
-	.transformer = NULL
+	.transformer = NULL,
+	.collapse = NULL
 ) {
 	with_epoxy_engine(
 		"latex",
@@ -185,7 +197,8 @@ epoxy_latex <- function(
 			.comment = .comment,
 			.literal = .literal,
 			.trim = .trim,
-			.transformer = .transformer
+			.transformer = .transformer,
+			.collapse = .collapse
 		)
 	)
 }

tests/testthat/helpers.R

@@ -23,7 +23,7 @@ render_rmd <- function(
 render_basic_rmd <- function(..., envir = parent.frame()) {
 	render_rmd(c(
 		"---",
-		"output: markdown_document",
+		"output: md_document",
 		"---",
 		"",
 		...

tests/testthat/rmds/use-chunk_collapse.Rmd

@@ -0,0 +1,24 @@
+---
+output: md_document
+---
+
+```{r setup, include=FALSE}
+library(epoxy)
+
+the_data <- list(
+	first = c("one", "three"),
+	second = c("two", "four")
+)
+```
+
+```{epoxy chunk-template, .data = the_data, .collapse = " == "}
+{first} followed by {second}
+```
+
+```{r echo=FALSE}
+epoxy_use_chunk(
+	.data = the_data,
+	label = "chunk-template",
+	.collapse = " || "
+)
+```

tests/testthat/test-engines.R

@@ -233,3 +233,19 @@ describe("chunk engine deprecations", {
 		)
 	})
 })
+
+test_that(".collapse chunk option", {
+	rmd <- test_path("rmds", "use-chunk_collapse.Rmd")
+
+	res <- render_rmd(rmd)
+
+	expect_equal(
+		res[[1]],
+		"one followed by two == three followed by four"
+	)
+
+	expect_equal(
+		res[[3]],
+		"one followed by two || three followed by four"
+	)
+})

tests/testthat/test-epoxy.R

@@ -18,6 +18,37 @@ test_that("epoxy .data pronoun", {
 	)
 })
 
+test_that("epoxy(.collapse =)", {
+	expect_equal(
+		epoxy("{letters[1:3]}", .collapse = ", "),
+		"a, b, c"
+	)
+
+	expect_equal(
+		epoxy_latex("<<letters[1:3]>>", .collapse = " \\middot "),
+		"a \\middot b \\middot c"
+	)
+
+	expect_equal(
+		epoxy_html(
+			"{{values}}",
+			values = letters[1:3],
+			.collapse = "<br>"
+		),
+		"a<br>b<br>c"
+	)
+
+	expect_equal(
+		epoxy_html(
+			"{{li values}}",
+			values = letters[1:3],
+			# inline html tranformers pre-collapse
+			.collapse = "<br>"
+		),
+		"<li>a</li><li>b</li><li>c</li>"
+	)
+})
+
 test_that("epoxy_data_subset()", {
 	nested <- list(
 		outer = list(