[med-svn] [r-cran-glue] 01/04: New upstream version 1.2.0
Andreas Tille
tille at debian.org
Sat Nov 11 14:53:37 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-glue.
commit 12e0cbd8f50e72e56b13694eb77042a713f53449
Author: Andreas Tille <tille at debian.org>
Date: Sat Nov 11 15:47:24 2017 +0100
New upstream version 1.2.0
---
.aspell/defaults.R | 4 +
.aspell/glue.rds | Bin 0 -> 56 bytes
DESCRIPTION | 14 +--
MD5 | 39 ++++++---
NAMESPACE | 4 +
NEWS.md | 34 ++++++--
R/glue.R | 82 +++++++++++++-----
R/sql.R | 113 ++++++++++++++++++++++++
R/transformer.R | 18 ++++
R/utils.R | 42 +++++----
README.md | 89 +++++++++++++++++--
build/vignette.rds | Bin 0 -> 224 bytes
inst/doc/speed.R | 50 +++++++++++
inst/doc/speed.Rmd | 117 +++++++++++++++++++++++++
inst/doc/speed.html | 149 ++++++++++++++++++++++++++++++++
inst/doc/transformers.R | 75 ++++++++++++++++
inst/doc/transformers.Rmd | 131 ++++++++++++++++++++++++++++
inst/doc/transformers.html | 185 +++++++++++++++++++++++++++++++++++++++
man/evaluate.Rd | 24 ++++++
man/glue.Rd | 10 ++-
man/glue_sql.Rd | 103 ++++++++++++++++++++++
man/trim.Rd | 2 -
src/glue.c | 192 +++++++++++++++++++++--------------------
src/trim.c | 62 +++++++------
tests/testthat/test-collapse.R | 8 ++
tests/testthat/test-glue.R | 142 +++++++++++++++++-------------
tests/testthat/test-sql.R | 47 ++++++++++
tests/testthat/test-trim.R | 117 +++++++++++++++++++++++++
vignettes/speed.Rmd | 117 +++++++++++++++++++++++++
vignettes/transformers.Rmd | 131 ++++++++++++++++++++++++++++
30 files changed, 1845 insertions(+), 256 deletions(-)
diff --git a/.aspell/defaults.R b/.aspell/defaults.R
new file mode 100644
index 0000000..a041ce0
--- /dev/null
+++ b/.aspell/defaults.R
@@ -0,0 +1,4 @@
+Rd_files <- vignettes <- R_files <- description <-
+ list(encoding = "UTF-8",
+ language = "en",
+ dictionaries = c("en_stats", "glue"))
diff --git a/.aspell/glue.rds b/.aspell/glue.rds
new file mode 100644
index 0000000..32d89ea
Binary files /dev/null and b/.aspell/glue.rds differ
diff --git a/DESCRIPTION b/DESCRIPTION
index 085f2cf..74a6773 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,13 +1,15 @@
Package: glue
Title: Interpreted String Literals
-Version: 1.1.1
+Version: 1.2.0
Authors at R: person("Jim", "Hester", email = "james.f.hester at gmail.com", role = c("aut", "cre"))
Description: An implementation of interpreted string literals, inspired by
Python's Literal String Interpolation <https://www.python.org/dev/peps/pep-0498/> and Docstrings
<https://www.python.org/dev/peps/pep-0257/> and Julia's Triple-Quoted String Literals
<https://docs.julialang.org/en/stable/manual/strings/#triple-quoted-string-literals>.
-Depends: R (>= 3.0.0)
-Suggests: testthat, covr, magrittr
+Depends: R (>= 3.1)
+Suggests: testthat, covr, magrittr, crayon, knitr, rmarkdown, DBI,
+ RSQLite, R.utils, forcats, microbenchmark, rprintf, stringr,
+ ggplot2
Imports: methods
License: MIT + file LICENSE
Encoding: UTF-8
@@ -15,9 +17,11 @@ LazyData: true
RoxygenNote: 6.0.1
URL: https://github.com/tidyverse/glue
BugReports: https://github.com/tidyverse/glue/issues
+VignetteBuilder: knitr
+ByteCompile: true
NeedsCompilation: yes
-Packaged: 2017-06-16 20:43:57 UTC; jhester
+Packaged: 2017-10-29 19:05:15 UTC; jhester
Author: Jim Hester [aut, cre]
Maintainer: Jim Hester <james.f.hester at gmail.com>
Repository: CRAN
-Date/Publication: 2017-06-21 16:58:04 UTC
+Date/Publication: 2017-10-29 20:03:53 UTC
diff --git a/MD5 b/MD5
index e465622..60e0d5f 100644
--- a/MD5
+++ b/MD5
@@ -1,20 +1,35 @@
-72f5ccfd0b45afdb6322b55706e43cd1 *DESCRIPTION
+3664b0802a3d612d6ae33c4f7893735b *DESCRIPTION
e2965db868cda3b9ce7b138d8ca0e6bc *LICENSE
-3023c02be14302be414a033b320150f0 *NAMESPACE
-30b708333d07888a2609cf8504300116 *NEWS.md
-858d262f41a65cbda70396fb0376f201 *R/glue.R
+ae349adef7e0739d3386fcc0c52480de *NAMESPACE
+c47e244b4a12c4c56dd9aaa21b2921b6 *NEWS.md
+e25da04b994548eac701fca4d2d9bb46 *R/glue.R
f25d8ed7f568473df44c353211f35c9d *R/quoting.R
-5b08b26995895d52d23cf420410af203 *R/utils.R
-01e9ce19a9e51dba11f6c745f77eeb47 *README.md
+08f6555d49f538896dcba9bfa9d75d34 *R/sql.R
+837a82bf925d919528800fe48169fd76 *R/transformer.R
+b116b2ac585d713ae9f6cea4f1c92df6 *R/utils.R
+1088ea3e0f4e6dc5be3e91975009a30e *README.md
+ee1b476d76c2d952dfef883028c3f8e2 *build/vignette.rds
+03205ffd66dabed4ec5ec82326f31ac8 *inst/doc/speed.R
+1724bf85e63752bdd1518561ffc7f2c4 *inst/doc/speed.Rmd
+b0a6a6f1ef083f9a6a2ca04b72f4e6f0 *inst/doc/speed.html
+af174f87ee7931c827f3502712ebef80 *inst/doc/transformers.R
+fdefd28914101b894abf49588087340e *inst/doc/transformers.Rmd
+2f01a5ef8a8464123afb47a363b20ad9 *inst/doc/transformers.html
428090ffb747ed472a50927771a36cce *man/as_glue.Rd
d10e30c9bc0e43bf0e6c26e0dc538912 *man/collapse.Rd
-fc6862968d9748444945e399a558592a *man/glue.Rd
+e39d219a644c1562a928d3ec7d3ec4f7 *man/evaluate.Rd
+ea676c946f7177fc2c9cff93099c9af1 *man/glue.Rd
+fcc55814a60c9f1c290e1c0a608c3305 *man/glue_sql.Rd
5665d168b1fb64b49e96dfd9302184d9 *man/quoting.Rd
-cb80548db4ef7abb94efcf3bdcd1747d *man/trim.Rd
-4263ac45e523eb8ffcac5f256fd501a5 *src/glue.c
+4d9003660e95938f16e32c0ccf290507 *man/trim.Rd
+3be79898495ab85253552b1a1796b73b *src/glue.c
57c4e91a5ecf31acbbc061d6650584bb *src/init.c
-b4073f521cc4cda21bebf9ee940ebda8 *src/trim.c
+b4b59da64bd5a1062aa1e7638ad28921 *src/trim.c
2b2d5c82e65ffac3ce2300a7ba32fa68 *tests/testthat.R
-01d71156a148c78d2332399e61f4df6b *tests/testthat/test-collapse.R
-ac32d193a2bfb810c359f1c107674c64 *tests/testthat/test-glue.R
+132fd8c7c5a3072cb5c593a2345c7fb8 *tests/testthat/test-collapse.R
+6d1edfea85969e6113a6a9bc4da581db *tests/testthat/test-glue.R
05436a79623c08d7daa419af36fe110e *tests/testthat/test-quoting.R
+8d9187b81b18e9cbe2cf3360f6ac4690 *tests/testthat/test-sql.R
+16474c3bf9ab22ef1fade80eae27a847 *tests/testthat/test-trim.R
+1724bf85e63752bdd1518561ffc7f2c4 *vignettes/speed.Rmd
+fdefd28914101b894abf49588087340e *vignettes/transformers.Rmd
diff --git a/NAMESPACE b/NAMESPACE
index a7bef96..c5f30dc 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -9,9 +9,13 @@ export(as_glue)
export(backtick)
export(collapse)
export(double_quote)
+export(evaluate)
export(glue)
export(glue_data)
+export(glue_data_sql)
+export(glue_sql)
export(single_quote)
+export(trim)
importFrom(methods,setOldClass)
useDynLib(glue,glue_)
useDynLib(glue,trim_)
diff --git a/NEWS.md b/NEWS.md
index 155b5ad..8611096 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,21 +1,43 @@
+# glue 1.2.0
+
+* The implementation has been tweaked to be slightly faster in most cases.
+
+* `glue()` now has a `.transformer` argument, which allows you to use custom
+ logic on how to evaluate the code within glue blocks. See
+ `vignettes("transformers")` for more details and example transformer
+ functions.
+
+* `glue()` now returns `NA` if any of the results are `NA` and `.na` is `NULL`.
+ Otherwise `NA` values are replaced by the value of `.na`.
+
+* `trim()` to use the trimming logic from glue is now exported.
+
+* `glue_sql()` and `glue_data_sql()` functions added to make constructing SQL
+ statements with glue safer and easier.
+
+* `glue()` is now easier to use when used within helper functions such as
+ `lapply`.
+
+* Fix when last expression in `glue()` is NULL.
+
# glue 1.1.1
-Another fix for PROTECT / REPROTECT found by the rchk static analyzer.
+* Another fix for PROTECT / REPROTECT found by the rchk static analyzer.
# glue 1.1.0
-Fix for PROTECT errors when resizing output strings.
+* Fix for PROTECT errors when resizing output strings.
-`glue()` always returns 'UTF-8' strings, converting inputs if in other
+* `glue()` always returns 'UTF-8' strings, converting inputs if in other
encodings if needed.
-`to()` and `to_data()` have been removed.
+* `to()` and `to_data()` have been removed.
-`glue()` and `glue_data()` can now take alternative delimiters to `{` and `}`.
+* `glue()` and `glue_data()` can now take alternative delimiters to `{` and `}`.
This is useful if you are writing to a format that uses a lot of braces, such
as LaTeX. (#23)
-`collapse()` now returns 0 length output if given 0 length input (#28).
+* `collapse()` now returns 0 length output if given 0 length input (#28).
# glue 0.0.0.9000
diff --git a/R/glue.R b/R/glue.R
index a23c7e2..7ab3610 100644
--- a/R/glue.R
+++ b/R/glue.R
@@ -6,14 +6,20 @@
#' @param ... \[`expressions`]\cr Expressions string(s) to format, multiple inputs are concatenated together before formatting.
#' @param .sep \[`character(1)`: \sQuote{""}]\cr Separator used to separate elements.
#' @param .envir \[`environment`: `parent.frame()`]\cr Environment to evaluate each expression in. Expressions are
-#' evaluated from left to right. If `.x` is an environment, the expressions are
-#' evaluated in that environment and `.envir` is ignored.
+#' evaluated from left to right. If `.x` is an environment, the expressions are
+#' evaluated in that environment and `.envir` is ignored.
#' @param .open \[`character(1)`: \sQuote{\\\{}]\cr The opening delimiter. Doubling the
-#' full delimiter escapes it.
+#' full delimiter escapes it.
#' @param .close \[`character(1)`: \sQuote{\\\}}]\cr The closing delimiter. Doubling the
-#' full delimiter escapes it.
+#' full delimiter escapes it.
+#' @param .transformer \[`function]`\cr A function taking three parameters `code`, `envir` and
+#' `data` used to transform the output of each block before during or after
+#' evaluation. For example transformers see `vignette("transformers")`.
+#' @param .na \[`character(1)`: \sQuote{NA}]\cr Value to replace NA values
+#' with. If `NULL` missing values are propegated, that is an `NA` result will
+#' cause `NA` output. Otherwise the value is replaced by the value of `.na`.
#' @seealso <https://www.python.org/dev/peps/pep-0498/> and
-#' <https://www.python.org/dev/peps/pep-0257> upon which this is based.
+#' <https://www.python.org/dev/peps/pep-0257> upon which this is based.
#' @examples
#' name <- "Fred"
#' age <- 50
@@ -43,14 +49,15 @@
#' @useDynLib glue glue_
#' @name glue
#' @export
-glue_data <- function(.x, ..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}") {
+glue_data <- function(.x, ..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = "NA", .transformer = identity_transformer) {
# Perform all evaluations in a temporary environment
- if (is.environment(.x)) {
+ if (is.null(.x)) {
+ env <- new.env(parent = .envir)
+ } else if (is.environment(.x)) {
env <- new.env(parent = .x)
- .envir <- NULL
} else {
- env <- new.env(parent = .envir)
+ env <- list2env(.x, parent = .envir)
}
# Capture unevaluated arguments
@@ -58,35 +65,57 @@ glue_data <- function(.x, ..., .sep = "", .envir = parent.frame(), .open = "{",
named <- has_names(dots)
# Evaluate named arguments, add results to environment
- assign_args(dots[named], envir = env, data = .x)
+ assign_args(dots[named], env)
# Concatenate unnamed arguments together
- unnamed_args <- eval_args(dots[!named], envir = env, data = .x)
+ unnamed_args <- lapply(which(!named), function(x) eval(call("force", as.symbol(paste0("..", x)))))
lengths <- lengths(unnamed_args)
- if (any(lengths == 0)) {
+ if (any(lengths == 0) || length(unnamed_args) < length(dots[!named])) {
return(as_glue(character(0)))
}
if (any(lengths != 1)) {
stop("All unnamed arguments must be length 1", call. = FALSE)
}
+ if (any(is.na(unnamed_args))) {
+ if (is.null(.na)) {
+ return(as_glue(NA_character_))
+ } else {
+ unnamed_args[is.na(unnamed_args)] <- .na
+ }
+ }
+
unnamed_args <- paste0(unnamed_args, collapse = .sep)
unnamed_args <- trim(unnamed_args)
+ f <- function(expr) as.character(.transformer(expr, env))
+
# Parse any glue strings
- res <- .Call(glue_, unnamed_args,
- function(expr)
- enc2utf8(
- as.character(
- eval2(parse(text = expr), envir = env, data = .x))),
- .open, .close)
+ res <- .Call(glue_, unnamed_args, f, .open, .close)
if (any(lengths(res) == 0)) {
return(as_glue(character(0)))
}
+ res <- recycle_columns(res)
+
+ # Replace NA values as needed
+ if (!is.null(.na)) {
+ res[] <- lapply(res, function(x) {
+ x[is.na(x)] <- .na
+ x
+ })
+ } else {
+ # Return NA for any rows that are NA
+ na_rows <- Reduce(`|`, lapply(res, is.na))
+ }
+
res <- do.call(paste0, recycle_columns(res))
+ if (is.null(.na)) {
+ res[na_rows] <- NA_character_
+ }
+
as_glue(res)
}
@@ -117,9 +146,13 @@ collapse <- function(x, sep = "", width = Inf, last = "") {
if (length(x) == 0) {
return(as_glue(character()))
}
+ if (any(is.na(x))) {
+ return(as_glue(NA_character_))
+ }
+
if (nzchar(last) && length(x) > 1) {
res <- collapse(x[seq(1, length(x) - 1)], sep = sep, width = Inf)
- return(collapse(glue(res, last, x[length(x)]), width = width))
+ return(collapse(paste0(res, last, x[length(x)]), width = width))
}
x <- paste0(x, collapse = sep)
if (width < Inf) {
@@ -137,12 +170,12 @@ collapse <- function(x, sep = "", width = Inf, last = "") {
#' This trims a character vector according to the trimming rules used by glue.
#' These follow similar rules to [Python Docstrings](https://www.python.org/dev/peps/pep-0257),
#' with the following features.
-#'
#' - Leading and trailing whitespace from the first and last lines is removed.
#' - A uniform amount of indentation is stripped from the second line on, equal
#' to the minimum indentation of all non-blank lines after the first.
#' - Lines can be continued across newlines by using `\\`.
#' @param x A character vector to trim.
+#' @export
#' @examples
#' glue("
#' A formatted string
@@ -162,11 +195,17 @@ collapse <- function(x, sep = "", width = Inf, last = "") {
#' @useDynLib glue trim_
trim <- function(x) {
+ has_newline <- function(x) grepl("\\n", x)
+ if (length(x) == 0 || !has_newline(x)) {
+ return(x)
+ }
.Call(trim_, x)
}
#' @export
print.glue <- function(x, ..., sep = "\n") {
+ x[is.na(x)] <- style_na(x[is.na(x)])
+
cat(x, ..., sep = sep)
invisible(x)
@@ -192,7 +231,8 @@ as_glue.glue <- function(x, ...) {
#' @export
as_glue.character <- function(x, ...) {
- structure(x, class = c("glue", "character"))
+ class(x) <- c("glue", "character")
+ x
}
#' @export
diff --git a/R/sql.R b/R/sql.R
new file mode 100644
index 0000000..167ecd9
--- /dev/null
+++ b/R/sql.R
@@ -0,0 +1,113 @@
+#' Interpolate strings with SQL escaping
+#'
+#' SQL databases often have custom quotation syntax for identifiers and strings
+#' which make writing SQL queries error prone and cumbersome to do. `glue_sql()` and
+#' `glue_sql_data()` are analogs to `glue()` and `glue_data()` which handle the
+#' SQL quoting.
+#'
+#' They automatically quote character results, quote identifiers if the glue
+#' expression is surrounded by backticks \sQuote{`} and do not quote
+#' non-characters such as numbers.
+#'
+#' Returning the result with `DBI::SQL()` will suppress quoting if desired for
+#' a given value.
+#'
+#' Note [parameterized queries](https://db.rstudio.com/best-practices/run-queries-safely#parameterized-queries)
+#' are generally the safest and most efficient way to pass user defined
+#' values in a query, however not every database driver supports them.
+#'
+#' If you place a `*` at the end of a glue expression the values will be
+#' collapsed with commas. This is useful for the [SQL IN Operator](https://www.w3schools.com/sql/sql_in.asp)
+#' for instance.
+#' @inheritParams glue
+#' @param .con \[`DBIConnection`]:A DBI connection object obtained from `DBI::dbConnect()`.
+#' @return A `DBI::SQL()` object with the given query.
+#' @examples
+#' con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
+#' colnames(iris) <- gsub("[.]", "_", tolower(colnames(iris)))
+#' DBI::dbWriteTable(con, "iris", iris)
+#' var <- "sepal_width"
+#' tbl <- "iris"
+#' num <- 2
+#' val <- "setosa"
+#' glue_sql("
+#' SELECT {`var`}
+#' FROM {`tbl`}
+#' WHERE {`tbl`}.sepal_length > {num}
+#' AND {`tbl`}.species = {val}
+#' ", .con = con)
+#'
+#' # `glue_sql()` can be used in conjuction with parameterized queries using
+#' # `DBI::dbBind()` to provide protection for SQL Injection attacks
+#' sql <- glue_sql("
+#' SELECT {`var`}
+#' FROM {`tbl`}
+#' WHERE {`tbl`}.sepal_length > ?
+#' ", .con = con)
+#' query <- DBI::dbSendQuery(con, sql)
+#' DBI::dbBind(query, list(num))
+#' DBI::dbFetch(query, n = 4)
+#' DBI::dbClearResult(query)
+#'
+#' # `glue_sql()` can be used to build up more complex queries with
+#' # interchangeable sub queries. It returns `DBI::SQL()` objects which are
+#' # properly protected from quoting.
+#' sub_query <- glue_sql("
+#' SELECT *
+#' FROM {`tbl`}
+#' ", .con = con)
+#'
+#' glue_sql("
+#' SELECT s.{`var`}
+#' FROM ({sub_query}) AS s
+#' ", .con = con)
+#'
+#' # If you want to input multiple values for use in SQL IN statements put `*`
+#' # at the end of the value and the values will be collapsed and quoted appropriately.
+#' glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})",
+#' vals = 1, .con = con)
+#'
+#' glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})",
+#' vals = 1:5, .con = con)
+#'
+#' glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})",
+#' vals = "setosa", .con = con)
+#'
+#' glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})",
+#' vals = c("setosa", "versicolor"), .con = con)
+#'
+#' DBI::dbDisconnect(con)
+#' @export
+glue_sql <- function(..., .con, .envir = parent.frame()) {
+ DBI::SQL(glue(..., .envir = .envir, .transformer = sql_quote_transformer(.con)))
+}
+
+#' @rdname glue_sql
+#' @export
+glue_data_sql <- function(.x, ..., .con, .envir = parent.frame()) {
+ DBI::SQL(glue_data(.x, ..., .envir = .envir, .transformer = sql_quote_transformer(.con)))
+}
+
+sql_quote_transformer <- function(connection) {
+ function(code, envir) {
+ should_collapse <- grepl("[*]$", code)
+ if (should_collapse) {
+ code <- sub("[*]$", "", code)
+ }
+ m <- gregexpr("^`|`$", code)
+ if (any(m[[1]] != -1)) {
+ regmatches(code, m) <- ""
+ res <- DBI::dbQuoteIdentifier(conn = connection, as.character(evaluate(code, envir)))
+ } else {
+ res <- evaluate(code, envir)
+ if (is.character(res)) {
+ res <- DBI::dbQuoteString(conn = connection, res)
+ }
+ res
+ }
+ if (should_collapse) {
+ res <- collapse(res, ", ")
+ }
+ res
+ }
+}
diff --git a/R/transformer.R b/R/transformer.R
new file mode 100644
index 0000000..4d5d37e
--- /dev/null
+++ b/R/transformer.R
@@ -0,0 +1,18 @@
+#' Evaluate R code
+#'
+#' This is a simple wrapper around `eval(parse())` which provides a more
+#' consistent interface than the default functions.
+#' If `data` is `NULL` then the code is evaluated in the environment. If `data`
+#' is not `NULL` than the code is evaluated in the `data` object first, with
+#' the enclosing environment of `envir`.
+#'
+#' This function is designed to be used within transformers to evaluate the
+#' code in the glue block.
+#' @param code R code to evaluate
+#' @param envir environment to evaluate the code in
+#' @export
+evaluate <- function(code, envir) {
+ eval(parse(text = code, keep.source = FALSE), envir)
+}
+
+identity_transformer <- evaluate
diff --git a/R/utils.R b/R/utils.R
index f5d617d..6e83911 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -7,35 +7,16 @@ has_names <- function(x) {
}
}
-# Use an explicit for loop rather than lapply to show evaluation order matters
-eval_args <- function(args, envir, data) {
- res <- vector("list", length(args))
- for (i in seq_along(args)) {
- res[[i]] <- eval2(args[[i]], envir = envir, data = data)
- }
- names(res) <- names(args)
- res
-}
-
-assign_args <- function(args, envir, data) {
+assign_args <- function(args, envir) {
res <- vector("list", length(args))
nms <- names(args)
for (i in seq_along(args)) {
- assign(nms[[i]], eval2(args[[i]], envir = envir, data = data), envir = envir)
- }
-}
-
-eval2 <- function(x, envir = parent.frame(), data = NULL) {
- if (is.null(data)) {
- eval(x, envir = envir)
- } else {
- eval(x, envir = data, enclos = envir)
+ assign(nms[[i]], eval(args[[i]], envir), envir = envir)
}
}
# From tibble::recycle_columns
-recycle_columns <- function (x)
-{
+recycle_columns <- function (x) {
if (length(x) == 0) {
return(x)
}
@@ -57,3 +38,20 @@ recycle_columns <- function (x)
}
x
}
+
+# From https://github.com/hadley/colformat/blob/0a35999e7d77b9b3a47b4a04662d1c2625f929d3/R/styles.R#L19-L25
+colour_na <- function() {
+ grDevices::rgb(5, 5, 2, maxColorValue = 5)
+}
+
+style_na <- function(x) {
+ if (requireNamespace("crayon", quietly = TRUE)) {
+ crayon::style(x, bg = colour_na())
+ } else {
+ x # nocov
+ }
+}
+
+lengths <- function(x) {
+ vapply(x, length, integer(1L))
+}
diff --git a/README.md b/README.md
index 3283421..8897115 100644
--- a/README.md
+++ b/README.md
@@ -3,7 +3,7 @@
glue
====
-[](http://cran.r-project.org/package=glue) [](http://travis-ci.org/tidyverse/glue) [](http://codecov.io/github/tidyverse/glue?branch=master) [](http:// [...]
+[](https://cran.r-project.org/package=glue) [](https://travis-ci.org/tidyverse/glue) [](https://codecov.io/github/tidyverse/glue?branch=master) []( [...]
Glue strings to data in R. Small, fast, dependency free interpreted string literals.
@@ -21,6 +21,8 @@ Usage
##### Long strings are broken by line and concatenated together.
``` r
+library(glue)
+
name <- "Fred"
age <- 50
anniversary <- as.Date("1991-10-12")
@@ -42,7 +44,7 @@ glue('My name is {name},',
#> My name is Joe, my age next year is 41, my anniversary is Friday, October 12, 2001.
```
-##### `glue_data()` is useful with [magrittr](http://cran.r-project.org/package=magrittr) pipes.
+##### `glue_data()` is useful with [magrittr](https://cran.r-project.org/package=magrittr) pipes.
``` r
`%>%` <- magrittr::`%>%`
@@ -125,12 +127,89 @@ glue("{
#> foo
```
+##### `glue_sql()` makes constructing SQL statements safe and easy
+
+Use backticks to quote identifiers, normal strings and numbers are quoted appropriately for your backend.
+
+``` r
+library(glue)
+
+con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
+colnames(iris) <- gsub("[.]", "_", tolower(colnames(iris)))
+DBI::dbWriteTable(con, "iris", iris)
+var <- "sepal_width"
+tbl <- "iris"
+num <- 2
+val <- "setosa"
+glue_sql("
+ SELECT {`var`}
+ FROM {`tbl`}
+ WHERE {`tbl`}.sepal_length > {num}
+ AND {`tbl`}.species = {val}
+ ", .con = con)
+#> <SQL> SELECT `sepal_width`
+#> FROM `iris`
+#> WHERE `iris`.sepal_length > 2
+#> AND `iris`.species = 'setosa'
+
+# `glue_sql()` can be used in conjuction with parameterized queries using
+# `DBI::dbBind()` to provide protection for SQL Injection attacks
+ sql <- glue_sql("
+ SELECT {`var`}
+ FROM {`tbl`}
+ WHERE {`tbl`}.sepal_length > ?
+ ", .con = con)
+query <- DBI::dbSendQuery(con, sql)
+DBI::dbBind(query, list(num))
+DBI::dbFetch(query, n = 4)
+#> sepal_width
+#> 1 3.5
+#> 2 3.0
+#> 3 3.2
+#> 4 3.1
+DBI::dbClearResult(query)
+
+# `glue_sql()` can be used to build up more complex queries with
+# interchangeable sub queries. It returns `DBI::SQL()` objects which are
+# properly protected from quoting.
+sub_query <- glue_sql("
+ SELECT *
+ FROM {`tbl`}
+ ", .con = con)
+
+glue_sql("
+ SELECT s.{`var`}
+ FROM ({sub_query}) AS s
+ ", .con = con)
+#> <SQL> SELECT s.`sepal_width`
+#> FROM (SELECT *
+#> FROM `iris`) AS s
+
+# If you want to input multiple values for use in SQL IN statements put `*`
+# at the end of the value and the values will be collapsed and quoted appropriately.
+glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})",
+ vals = 1, .con = con)
+#> <SQL> SELECT * FROM `iris` WHERE sepal_length IN (1)
+
+glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})",
+ vals = 1:5, .con = con)
+#> <SQL> SELECT * FROM `iris` WHERE sepal_length IN (1, 2, 3, 4, 5)
+
+glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})",
+ vals = "setosa", .con = con)
+#> <SQL> SELECT * FROM `iris` WHERE species IN ('setosa')
+
+glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})",
+ vals = c("setosa", "versicolor"), .con = con)
+#> <SQL> SELECT * FROM `iris` WHERE species IN ('setosa', 'versicolor')
+```
+
Other implementations
=====================
Some other implementations of string interpolation in R (although not using identical syntax).
- [stringr::str\_interp](http://stringr.tidyverse.org/reference/str_interp.html)
-- [pystr::pystr\_format](http://cran.r-project.org/package=pystr)
-- [R.utils::gstring](http://cran.r-project.org/package=R.utils)
-- [rprintf](http://cran.r-project.org/package=rprintf)
+- [pystr::pystr\_format](https://cran.r-project.org/package=pystr)
+- [R.utils::gstring](https://cran.r-project.org/package=R.utils)
+- [rprintf](https://cran.r-project.org/package=rprintf)
diff --git a/build/vignette.rds b/build/vignette.rds
new file mode 100644
index 0000000..b1e23f5
Binary files /dev/null and b/build/vignette.rds differ
diff --git a/inst/doc/speed.R b/inst/doc/speed.R
new file mode 100644
index 0000000..61d9e7c
--- /dev/null
+++ b/inst/doc/speed.R
@@ -0,0 +1,50 @@
+## ----setup, include = FALSE----------------------------------------------
+knitr::opts_chunk$set(
+ collapse = TRUE, comment = "#>",
+ eval = as.logical(Sys.getenv("VIGNETTE_EVAL", "FALSE")),
+ cache = TRUE)
+library(glue)
+
+## ----setup2, include = FALSE---------------------------------------------
+# plot_comparison <- function(x, ...) {
+# library(ggplot2)
+# x$expr <- forcats::fct_reorder(x$expr, x$time)
+# colors <- ifelse(levels(x$expr) == "glue", "orange", "grey")
+# autoplot(x, ...) +
+# theme(axis.text.y = element_text(color = colors)) +
+# aes(fill = expr) + scale_fill_manual(values = colors, guide = FALSE)
+# }
+
+## ------------------------------------------------------------------------
+# bar <- "baz"
+#
+# simple <-
+# microbenchmark::microbenchmark(
+# glue = glue::glue("foo{bar}"),
+# gstring = R.utils::gstring("foo${bar}"),
+# paste0 = paste0("foo", bar),
+# sprintf = sprintf("foo%s", bar),
+# str_interp = stringr::str_interp("foo${bar}"),
+# rprintf = rprintf::rprintf("foo$bar", bar = bar)
+# )
+#
+# print(unit = "eps", order = "median", signif = 4, simple)
+#
+# plot_comparison(simple)
+
+## ------------------------------------------------------------------------
+# bar <- rep("bar", 1e5)
+#
+# vectorized <-
+# microbenchmark::microbenchmark(
+# glue = glue::glue("foo{bar}"),
+# gstring = R.utils::gstring("foo${bar}"),
+# paste0 = paste0("foo", bar),
+# sprintf = sprintf("foo%s", bar),
+# rprintf = rprintf::rprintf("foo$bar", bar = bar)
+# )
+#
+# print(unit = "ms", order = "median", signif = 4, vectorized)
+#
+# plot_comparison(vectorized, log = FALSE)
+
diff --git a/inst/doc/speed.Rmd b/inst/doc/speed.Rmd
new file mode 100644
index 0000000..c47e67a
--- /dev/null
+++ b/inst/doc/speed.Rmd
@@ -0,0 +1,117 @@
+---
+title: "Speed of glue"
+author: "Jim Hester"
+date: "`r Sys.Date()`"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Vignette Title}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+ % \VignetteDepends{R.utils
+ R.utils,
+ forcats,
+ microbenchmark,
+ rprintf,
+ stringr,
+ ggplot2}
+---
+
+Glue is advertised as
+
+> Fast, dependency free string literals
+
+So what do we mean when we say that glue is fast. This does not mean glue is
+the fastest thing to use in all cases, however for the features it provides we
+can confidently say it is fast.
+
+A good way to determine this is to compare it's speed of execution to some alternatives.
+
+- `base::paste0()`, `base::sprintf()` - Functions in base R implemented in C
+ that provide variable insertion (but not interpolation).
+- `R.utils::gstring()`, `stringr::str_interp()` - Provides a similar interface
+ as glue, but using `${}` to delimit blocks to interpolate.
+- `pystr::pystr_format()`[^1], `rprintf::rprintf()` - Provide a interfaces similar
+ to python string formatters with variable replacement, but not arbitrary
+ interpolation.
+
+```{r setup, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE, comment = "#>",
+ eval = as.logical(Sys.getenv("VIGNETTE_EVAL", "FALSE")),
+ cache = TRUE)
+library(glue)
+```
+
+```{r setup2, include = FALSE}
+plot_comparison <- function(x, ...) {
+ library(ggplot2)
+ x$expr <- forcats::fct_reorder(x$expr, x$time)
+ colors <- ifelse(levels(x$expr) == "glue", "orange", "grey")
+ autoplot(x, ...) +
+ theme(axis.text.y = element_text(color = colors)) +
+ aes(fill = expr) + scale_fill_manual(values = colors, guide = FALSE)
+}
+```
+
+## Simple concatenation
+
+```{r}
+bar <- "baz"
+
+simple <-
+ microbenchmark::microbenchmark(
+ glue = glue::glue("foo{bar}"),
+ gstring = R.utils::gstring("foo${bar}"),
+ paste0 = paste0("foo", bar),
+ sprintf = sprintf("foo%s", bar),
+ str_interp = stringr::str_interp("foo${bar}"),
+ rprintf = rprintf::rprintf("foo$bar", bar = bar)
+)
+
+print(unit = "eps", order = "median", signif = 4, simple)
+
+plot_comparison(simple)
+```
+
+While `glue()` is slower than `paste0`,`sprintf()` it is
+twice as fast as `str_interp()` and `gstring()`, and on par with `rprintf()`.
+
+`paste0()`, `sprintf()` don't do string interpolation and will likely always be
+significantly faster than glue, glue was never meant to be a direct replacement
+for them.
+
+`rprintf()` does only variable interpolation, not arbitrary expressions, which
+was one of the explicit goals of writing glue.
+
+So glue is ~2x as fast as the two functions (`str_interp()`, `gstring()`) which do have
+roughly equivalent functionality.
+
+It also is still quite fast, with over 6000 evaluations per second on this machine.
+
+## Vectorized performance
+
+Taking advantage of glue's vectorization is the best way to avoid performance.
+For instance the vectorized form of the previous benchmark is able to generate
+100,000 strings in only 22ms with performance much closer to that of
+`paste0()` and `sprintf()`. NB. `str_interp()` does not support
+vectorization, so were removed.
+
+```{r}
+bar <- rep("bar", 1e5)
+
+vectorized <-
+ microbenchmark::microbenchmark(
+ glue = glue::glue("foo{bar}"),
+ gstring = R.utils::gstring("foo${bar}"),
+ paste0 = paste0("foo", bar),
+ sprintf = sprintf("foo%s", bar),
+ rprintf = rprintf::rprintf("foo$bar", bar = bar)
+)
+
+print(unit = "ms", order = "median", signif = 4, vectorized)
+
+plot_comparison(vectorized, log = FALSE)
+```
+
+[^1]: pystr is no longer available from CRAN due to failure to correct
+installation errors and was therefore removed from futher testing.
diff --git a/inst/doc/speed.html b/inst/doc/speed.html
new file mode 100644
index 0000000..c001947
--- /dev/null
+++ b/inst/doc/speed.html
@@ -0,0 +1,149 @@
+<!DOCTYPE html>
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+
+<head>
+
+<meta charset="utf-8" />
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<meta name="generator" content="pandoc" />
+
+<meta name="viewport" content="width=device-width, initial-scale=1">
+
+<meta name="author" content="Jim Hester" />
+
+<meta name="date" content="2017-10-29" />
+
+<title>Speed of glue</title>
+
+
+
+<style type="text/css">code{white-space: pre;}</style>
+<style type="text/css">
+div.sourceCode { overflow-x: auto; }
+table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode {
+ margin: 0; padding: 0; vertical-align: baseline; border: none; }
+table.sourceCode { width: 100%; line-height: 100%; }
+td.lineNumbers { text-align: right; padding-right: 4px; padding-left: 4px; color: #aaaaaa; border-right: 1px solid #aaaaaa; }
+td.sourceCode { padding-left: 5px; }
+code > span.kw { color: #007020; font-weight: bold; } /* Keyword */
+code > span.dt { color: #902000; } /* DataType */
+code > span.dv { color: #40a070; } /* DecVal */
+code > span.bn { color: #40a070; } /* BaseN */
+code > span.fl { color: #40a070; } /* Float */
+code > span.ch { color: #4070a0; } /* Char */
+code > span.st { color: #4070a0; } /* String */
+code > span.co { color: #60a0b0; font-style: italic; } /* Comment */
+code > span.ot { color: #007020; } /* Other */
+code > span.al { color: #ff0000; font-weight: bold; } /* Alert */
+code > span.fu { color: #06287e; } /* Function */
+code > span.er { color: #ff0000; font-weight: bold; } /* Error */
+code > span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
+code > span.cn { color: #880000; } /* Constant */
+code > span.sc { color: #4070a0; } /* SpecialChar */
+code > span.vs { color: #4070a0; } /* VerbatimString */
+code > span.ss { color: #bb6688; } /* SpecialString */
+code > span.im { } /* Import */
+code > span.va { color: #19177c; } /* Variable */
+code > span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
+code > span.op { color: #666666; } /* Operator */
+code > span.bu { } /* BuiltIn */
+code > span.ex { } /* Extension */
+code > span.pp { color: #bc7a00; } /* Preprocessor */
+code > span.at { color: #7d9029; } /* Attribute */
+code > span.do { color: #ba2121; font-style: italic; } /* Documentation */
+code > span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
+code > span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
+code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
+</style>
+
+
+
+<link href="data:text/css;charset=utf-8,body%20%7B%0Abackground%2Dcolor%3A%20%23fff%3B%0Amargin%3A%201em%20auto%3B%0Amax%2Dwidth%3A%20700px%3B%0Aoverflow%3A%20visible%3B%0Apadding%2Dleft%3A%202em%3B%0Apadding%2Dright%3A%202em%3B%0Afont%2Dfamily%3A%20%22Open%20Sans%22%2C%20%22Helvetica%20Neue%22%2C%20Helvetica%2C%20Arial%2C%20sans%2Dserif%3B%0Afont%2Dsize%3A%2014px%3B%0Aline%2Dheight%3A%201%2E35%3B%0A%7D%0A%23header%20%7B%0Atext%2Dalign%3A%20center%3B%0A%7D%0A%23TOC%20%7B%0Aclear%3A%20bot [...]
+
+</head>
+
+<body>
+
+
+
+
+<h1 class="title toc-ignore">Speed of glue</h1>
+<h4 class="author"><em>Jim Hester</em></h4>
+<h4 class="date"><em>2017-10-29</em></h4>
+
+
+
+<p>Glue is advertised as</p>
+<blockquote>
+<p>Fast, dependency free string literals</p>
+</blockquote>
+<p>So what do we mean when we say that glue is fast. This does not mean glue is the fastest thing to use in all cases, however for the features it provides we can confidently say it is fast.</p>
+<p>A good way to determine this is to compare it’s speed of execution to some alternatives.</p>
+<ul>
+<li><code>base::paste0()</code>, <code>base::sprintf()</code> - Functions in base R implemented in C that provide variable insertion (but not interpolation).</li>
+<li><code>R.utils::gstring()</code>, <code>stringr::str_interp()</code> - Provides a similar interface as glue, but using <code>${}</code> to delimit blocks to interpolate.</li>
+<li><code>pystr::pystr_format()</code><a href="#fn1" class="footnoteRef" id="fnref1"><sup>1</sup></a>, <code>rprintf::rprintf()</code> - Provide a interfaces similar to python string formatters with variable replacement, but not arbitrary interpolation.</li>
+</ul>
+<div id="simple-concatenation" class="section level2">
+<h2>Simple concatenation</h2>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">bar <-<span class="st"> "baz"</span>
+
+simple <-
+<span class="st"> </span>microbenchmark<span class="op">::</span><span class="kw">microbenchmark</span>(
+ <span class="dt">glue =</span> glue<span class="op">::</span><span class="kw">glue</span>(<span class="st">"foo{bar}"</span>),
+ <span class="dt">gstring =</span> R.utils<span class="op">::</span><span class="kw">gstring</span>(<span class="st">"foo${bar}"</span>),
+ <span class="dt">paste0 =</span> <span class="kw">paste0</span>(<span class="st">"foo"</span>, bar),
+ <span class="dt">sprintf =</span> <span class="kw">sprintf</span>(<span class="st">"foo%s"</span>, bar),
+ <span class="dt">str_interp =</span> stringr<span class="op">::</span><span class="kw">str_interp</span>(<span class="st">"foo${bar}"</span>),
+ <span class="dt">rprintf =</span> rprintf<span class="op">::</span><span class="kw">rprintf</span>(<span class="st">"foo$bar"</span>, <span class="dt">bar =</span> bar)
+)
+
+<span class="kw">print</span>(<span class="dt">unit =</span> <span class="st">"eps"</span>, <span class="dt">order =</span> <span class="st">"median"</span>, <span class="dt">signif =</span> <span class="dv">4</span>, simple)
+
+<span class="kw">plot_comparison</span>(simple)</code></pre></div>
+<p>While <code>glue()</code> is slower than <code>paste0</code>,<code>sprintf()</code> it is twice as fast as <code>str_interp()</code> and <code>gstring()</code>, and on par with <code>rprintf()</code>.</p>
+<p><code>paste0()</code>, <code>sprintf()</code> don’t do string interpolation and will likely always be significantly faster than glue, glue was never meant to be a direct replacement for them.</p>
+<p><code>rprintf()</code> does only variable interpolation, not arbitrary expressions, which was one of the explicit goals of writing glue.</p>
+<p>So glue is ~2x as fast as the two functions (<code>str_interp()</code>, <code>gstring()</code>) which do have roughly equivalent functionality.</p>
+<p>It also is still quite fast, with over 6000 evaluations per second on this machine.</p>
+</div>
+<div id="vectorized-performance" class="section level2">
+<h2>Vectorized performance</h2>
+<p>Taking advantage of glue’s vectorization is the best way to avoid performance. For instance the vectorized form of the previous benchmark is able to generate 100,000 strings in only 22ms with performance much closer to that of <code>paste0()</code> and <code>sprintf()</code>. NB. <code>str_interp()</code> does not support vectorization, so were removed.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">bar <-<span class="st"> </span><span class="kw">rep</span>(<span class="st">"bar"</span>, <span class="fl">1e5</span>)
+
+vectorized <-
+<span class="st"> </span>microbenchmark<span class="op">::</span><span class="kw">microbenchmark</span>(
+ <span class="dt">glue =</span> glue<span class="op">::</span><span class="kw">glue</span>(<span class="st">"foo{bar}"</span>),
+ <span class="dt">gstring =</span> R.utils<span class="op">::</span><span class="kw">gstring</span>(<span class="st">"foo${bar}"</span>),
+ <span class="dt">paste0 =</span> <span class="kw">paste0</span>(<span class="st">"foo"</span>, bar),
+ <span class="dt">sprintf =</span> <span class="kw">sprintf</span>(<span class="st">"foo%s"</span>, bar),
+ <span class="dt">rprintf =</span> rprintf<span class="op">::</span><span class="kw">rprintf</span>(<span class="st">"foo$bar"</span>, <span class="dt">bar =</span> bar)
+)
+
+<span class="kw">print</span>(<span class="dt">unit =</span> <span class="st">"ms"</span>, <span class="dt">order =</span> <span class="st">"median"</span>, <span class="dt">signif =</span> <span class="dv">4</span>, vectorized)
+
+<span class="kw">plot_comparison</span>(vectorized, <span class="dt">log =</span> <span class="ot">FALSE</span>)</code></pre></div>
+</div>
+<div class="footnotes">
+<hr />
+<ol>
+<li id="fn1"><p>pystr is no longer available from CRAN due to failure to correct installation errors and was therefore removed from futher testing.<a href="#fnref1">↩</a></p></li>
+</ol>
+</div>
+
+
+
+<!-- dynamically load mathjax for compatibility with self-contained -->
+<script>
+ (function () {
+ var script = document.createElement("script");
+ script.type = "text/javascript";
+ script.src = "https://mathjax.rstudio.com/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML";
+ document.getElementsByTagName("head")[0].appendChild(script);
+ })();
+</script>
+
+</body>
+</html>
diff --git a/inst/doc/transformers.R b/inst/doc/transformers.R
new file mode 100644
index 0000000..4859911
--- /dev/null
+++ b/inst/doc/transformers.R
@@ -0,0 +1,75 @@
+## ---- include = FALSE----------------------------------------------------
+library(glue)
+knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
+
+## ------------------------------------------------------------------------
+collapse_transformer <- function(regex = "[*]$", ...) {
+ function(code, envir) {
+ if (grepl(regex, code)) {
+ code <- sub(regex, "", code)
+ }
+ res <- evaluate(code, envir)
+ collapse(res, ...)
+ }
+}
+
+glue("{1:5*}\n{letters[1:5]*}", .transformer = collapse_transformer(sep = ", "))
+
+glue("{1:5*}\n{letters[1:5]*}", .transformer = collapse_transformer(sep = ", ", last = " and "))
+
+## ---- eval = require("emo")----------------------------------------------
+emoji_transformer <- function(code, envir) {
+ if (grepl("[*]$", code)) {
+ code <- sub("[*]$", "", code)
+ collapse(ji_find(code)$emoji)
+ } else {
+ ji(code)
+ }
+}
+
+glue_ji <- function(..., .envir = parent.frame()) {
+ glue(..., .open = ":", .close = ":", .envir = .envir, .transformer = emoji_transformer)
+}
+glue_ji("one :heart:")
+glue_ji("many :heart*:")
+
+## ------------------------------------------------------------------------
+sprintf_transformer <- function(code, envir) {
+ m <- regexpr(":.+$", code)
+ if (m != -1) {
+ format <- substring(regmatches(code, m), 2)
+ regmatches(code, m) <- ""
+ res <- evaluate(code, envir)
+ do.call(sprintf, list(glue("%{format}f"), res))
+ } else {
+ evaluate(code, envir)
+ }
+}
+
+glue_fmt <- function(..., .envir = parent.frame()) {
+ glue(..., .transformer = sprintf_transformer, .envir = .envir)
+}
+glue_fmt("π = {pi:.2}")
+
+## ------------------------------------------------------------------------
+safely_transformer <- function(otherwise = NA) {
+ function(code, envir) {
+ tryCatch(evaluate(code, envir),
+ error = function(e) if (is.language(otherwise)) eval(otherwise) else otherwise)
+ }
+}
+
+glue_safely <- function(..., .otherwise = NA, .envir = parent.frame()) {
+ glue(..., .transformer = safely_transformer(.otherwise), .envir = .envir)
+}
+
+# Default returns missing if there is an error
+glue_safely("foo: {xyz}")
+
+# Or an empty string
+glue_safely("foo: {xyz}", .otherwise = "Error")
+
+# Or output the error message in red
+library(crayon)
+glue_safely("foo: {xyz}", .otherwise = quote(glue("{red}Error: {conditionMessage(e)}{reset}")))
+
diff --git a/inst/doc/transformers.Rmd b/inst/doc/transformers.Rmd
new file mode 100644
index 0000000..aabb96e
--- /dev/null
+++ b/inst/doc/transformers.Rmd
@@ -0,0 +1,131 @@
+---
+title: "Transformers"
+author: "Jim Hester"
+date: "`r Sys.Date()`"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Transformers}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+Transformers allow you to apply functions to the glue input and output, before
+and after evaluation. This allows you to write things like `glue_sql()`, which
+automatically quotes variables for you or add a syntax for automatically
+collapsing outputs.
+
+The transformer functions simply take two arguments `code` and `envir`, where
+`code` is the unparsed string inside the glue block and `envir` is the environment to
+execute the code in. Most transformers will then call `glue::evaluate()`, which
+takes `code` and `envir` and parses and evaluates the code.
+
+You can then supply the transformer function to glue with the `.transformer`
+argument. In this way users can define manipulate the code before parsing and
+change the output after evaluation.
+
+It is often useful to write a `glue()` wrapper function which supplies a
+`.transformer` to `glue()` or `glue_data()` and potentially has additional
+arguments. One important consideration when doing this is to include
+`.envir = parent.frame()` in the wrapper to ensure the evaluation environment
+is correct.
+
+Some examples implementations of potentially useful transformers follow. The
+aim right now is not to include most of these custom functions within the
+`glue` package. Rather users are encouraged to create custom functions using
+transformers to fit their individual needs.
+
+```{r, include = FALSE}
+library(glue)
+knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
+```
+
+### collapse transformer
+
+A transformer which automatically collapses any glue block ending with `*`.
+
+```{r}
+collapse_transformer <- function(regex = "[*]$", ...) {
+ function(code, envir) {
+ if (grepl(regex, code)) {
+ code <- sub(regex, "", code)
+ }
+ res <- evaluate(code, envir)
+ collapse(res, ...)
+ }
+}
+
+glue("{1:5*}\n{letters[1:5]*}", .transformer = collapse_transformer(sep = ", "))
+
+glue("{1:5*}\n{letters[1:5]*}", .transformer = collapse_transformer(sep = ", ", last = " and "))
+```
+
+### emoji transformer
+
+A transformer which converts the text to the equivalent emoji.
+
+```{r, eval = require("emo")}
+emoji_transformer <- function(code, envir) {
+ if (grepl("[*]$", code)) {
+ code <- sub("[*]$", "", code)
+ collapse(ji_find(code)$emoji)
+ } else {
+ ji(code)
+ }
+}
+
+glue_ji <- function(..., .envir = parent.frame()) {
+ glue(..., .open = ":", .close = ":", .envir = .envir, .transformer = emoji_transformer)
+}
+glue_ji("one :heart:")
+glue_ji("many :heart*:")
+```
+
+### sprintf transformer
+
+A transformer which allows succinct sprintf format strings.
+
+```{r}
+sprintf_transformer <- function(code, envir) {
+ m <- regexpr(":.+$", code)
+ if (m != -1) {
+ format <- substring(regmatches(code, m), 2)
+ regmatches(code, m) <- ""
+ res <- evaluate(code, envir)
+ do.call(sprintf, list(glue("%{format}f"), res))
+ } else {
+ evaluate(code, envir)
+ }
+}
+
+glue_fmt <- function(..., .envir = parent.frame()) {
+ glue(..., .transformer = sprintf_transformer, .envir = .envir)
+}
+glue_fmt("π = {pi:.2}")
+```
+
+### safely transformer
+
+A transformer that acts like `purrr::safely()`, which returns a value instead of an error.
+
+```{r}
+safely_transformer <- function(otherwise = NA) {
+ function(code, envir) {
+ tryCatch(evaluate(code, envir),
+ error = function(e) if (is.language(otherwise)) eval(otherwise) else otherwise)
+ }
+}
+
+glue_safely <- function(..., .otherwise = NA, .envir = parent.frame()) {
+ glue(..., .transformer = safely_transformer(.otherwise), .envir = .envir)
+}
+
+# Default returns missing if there is an error
+glue_safely("foo: {xyz}")
+
+# Or an empty string
+glue_safely("foo: {xyz}", .otherwise = "Error")
+
+# Or output the error message in red
+library(crayon)
+glue_safely("foo: {xyz}", .otherwise = quote(glue("{red}Error: {conditionMessage(e)}{reset}")))
+```
diff --git a/inst/doc/transformers.html b/inst/doc/transformers.html
new file mode 100644
index 0000000..18898ac
--- /dev/null
+++ b/inst/doc/transformers.html
@@ -0,0 +1,185 @@
+<!DOCTYPE html>
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+
+<head>
+
+<meta charset="utf-8" />
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<meta name="generator" content="pandoc" />
+
+<meta name="viewport" content="width=device-width, initial-scale=1">
+
+<meta name="author" content="Jim Hester" />
+
+<meta name="date" content="2017-10-29" />
+
+<title>Transformers</title>
+
+
+
+<style type="text/css">code{white-space: pre;}</style>
+<style type="text/css">
+div.sourceCode { overflow-x: auto; }
+table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode {
+ margin: 0; padding: 0; vertical-align: baseline; border: none; }
+table.sourceCode { width: 100%; line-height: 100%; }
+td.lineNumbers { text-align: right; padding-right: 4px; padding-left: 4px; color: #aaaaaa; border-right: 1px solid #aaaaaa; }
+td.sourceCode { padding-left: 5px; }
+code > span.kw { color: #007020; font-weight: bold; } /* Keyword */
+code > span.dt { color: #902000; } /* DataType */
+code > span.dv { color: #40a070; } /* DecVal */
+code > span.bn { color: #40a070; } /* BaseN */
+code > span.fl { color: #40a070; } /* Float */
+code > span.ch { color: #4070a0; } /* Char */
+code > span.st { color: #4070a0; } /* String */
+code > span.co { color: #60a0b0; font-style: italic; } /* Comment */
+code > span.ot { color: #007020; } /* Other */
+code > span.al { color: #ff0000; font-weight: bold; } /* Alert */
+code > span.fu { color: #06287e; } /* Function */
+code > span.er { color: #ff0000; font-weight: bold; } /* Error */
+code > span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
+code > span.cn { color: #880000; } /* Constant */
+code > span.sc { color: #4070a0; } /* SpecialChar */
+code > span.vs { color: #4070a0; } /* VerbatimString */
+code > span.ss { color: #bb6688; } /* SpecialString */
+code > span.im { } /* Import */
+code > span.va { color: #19177c; } /* Variable */
+code > span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
+code > span.op { color: #666666; } /* Operator */
+code > span.bu { } /* BuiltIn */
+code > span.ex { } /* Extension */
+code > span.pp { color: #bc7a00; } /* Preprocessor */
+code > span.at { color: #7d9029; } /* Attribute */
+code > span.do { color: #ba2121; font-style: italic; } /* Documentation */
+code > span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
+code > span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
+code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
+</style>
+
+
+
+<link href="data:text/css;charset=utf-8,body%20%7B%0Abackground%2Dcolor%3A%20%23fff%3B%0Amargin%3A%201em%20auto%3B%0Amax%2Dwidth%3A%20700px%3B%0Aoverflow%3A%20visible%3B%0Apadding%2Dleft%3A%202em%3B%0Apadding%2Dright%3A%202em%3B%0Afont%2Dfamily%3A%20%22Open%20Sans%22%2C%20%22Helvetica%20Neue%22%2C%20Helvetica%2C%20Arial%2C%20sans%2Dserif%3B%0Afont%2Dsize%3A%2014px%3B%0Aline%2Dheight%3A%201%2E35%3B%0A%7D%0A%23header%20%7B%0Atext%2Dalign%3A%20center%3B%0A%7D%0A%23TOC%20%7B%0Aclear%3A%20bot [...]
+
+</head>
+
+<body>
+
+
+
+
+<h1 class="title toc-ignore">Transformers</h1>
+<h4 class="author"><em>Jim Hester</em></h4>
+<h4 class="date"><em>2017-10-29</em></h4>
+
+
+
+<p>Transformers allow you to apply functions to the glue input and output, before and after evaluation. This allows you to write things like <code>glue_sql()</code>, which automatically quotes variables for you or add a syntax for automatically collapsing outputs.</p>
+<p>The transformer functions simply take two arguments <code>code</code> and <code>envir</code>, where <code>code</code> is the unparsed string inside the glue block and <code>envir</code> is the environment to execute the code in. Most transformers will then call <code>glue::evaluate()</code>, which takes <code>code</code> and <code>envir</code> and parses and evaluates the code.</p>
+<p>You can then supply the transformer function to glue with the <code>.transformer</code> argument. In this way users can define manipulate the code before parsing and change the output after evaluation.</p>
+<p>It is often useful to write a <code>glue()</code> wrapper function which supplies a <code>.transformer</code> to <code>glue()</code> or <code>glue_data()</code> and potentially has additional arguments. One important consideration when doing this is to include <code>.envir = parent.frame()</code> in the wrapper to ensure the evaluation environment is correct.</p>
+<p>Some examples implementations of potentially useful transformers follow. The aim right now is not to include most of these custom functions within the <code>glue</code> package. Rather users are encouraged to create custom functions using transformers to fit their individual needs.</p>
+<div id="collapse-transformer" class="section level3">
+<h3>collapse transformer</h3>
+<p>A transformer which automatically collapses any glue block ending with <code>*</code>.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">collapse_transformer <-<span class="st"> </span><span class="cf">function</span>(<span class="dt">regex =</span> <span class="st">"[*]$"</span>, ...) {
+ <span class="cf">function</span>(code, envir) {
+ <span class="cf">if</span> (<span class="kw">grepl</span>(regex, code)) {
+ code <-<span class="st"> </span><span class="kw">sub</span>(regex, <span class="st">""</span>, code)
+ }
+ res <-<span class="st"> </span><span class="kw">evaluate</span>(code, envir)
+ <span class="kw">collapse</span>(res, ...)
+ }
+}
+
+<span class="kw">glue</span>(<span class="st">"{1:5*}</span><span class="ch">\n</span><span class="st">{letters[1:5]*}"</span>, <span class="dt">.transformer =</span> <span class="kw">collapse_transformer</span>(<span class="dt">sep =</span> <span class="st">", "</span>))
+<span class="co">#> 1, 2, 3, 4, 5</span>
+<span class="co">#> a, b, c, d, e</span>
+
+<span class="kw">glue</span>(<span class="st">"{1:5*}</span><span class="ch">\n</span><span class="st">{letters[1:5]*}"</span>, <span class="dt">.transformer =</span> <span class="kw">collapse_transformer</span>(<span class="dt">sep =</span> <span class="st">", "</span>, <span class="dt">last =</span> <span class="st">" and "</span>))
+<span class="co">#> 1, 2, 3, 4 and 5</span>
+<span class="co">#> a, b, c, d and e</span></code></pre></div>
+</div>
+<div id="emoji-transformer" class="section level3">
+<h3>emoji transformer</h3>
+<p>A transformer which converts the text to the equivalent emoji.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">emoji_transformer <-<span class="st"> </span><span class="cf">function</span>(code, envir) {
+ <span class="cf">if</span> (<span class="kw">grepl</span>(<span class="st">"[*]$"</span>, code)) {
+ code <-<span class="st"> </span><span class="kw">sub</span>(<span class="st">"[*]$"</span>, <span class="st">""</span>, code)
+ <span class="kw">collapse</span>(<span class="kw">ji_find</span>(code)<span class="op">$</span>emoji)
+ } <span class="cf">else</span> {
+ <span class="kw">ji</span>(code)
+ }
+}
+
+glue_ji <-<span class="st"> </span><span class="cf">function</span>(..., <span class="dt">.envir =</span> <span class="kw">parent.frame</span>()) {
+ <span class="kw">glue</span>(..., <span class="dt">.open =</span> <span class="st">":"</span>, <span class="dt">.close =</span> <span class="st">":"</span>, <span class="dt">.envir =</span> .envir, <span class="dt">.transformer =</span> emoji_transformer)
+}
+<span class="kw">glue_ji</span>(<span class="st">"one :heart:"</span>)
+<span class="co">#> one ❤️</span>
+<span class="kw">glue_ji</span>(<span class="st">"many :heart*:"</span>)
+<span class="co">#> many 😍😻💘❤💓💔💕💟💌♥️❣️❤️</span></code></pre></div>
+</div>
+<div id="sprintf-transformer" class="section level3">
+<h3>sprintf transformer</h3>
+<p>A transformer which allows succinct sprintf format strings.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">sprintf_transformer <-<span class="st"> </span><span class="cf">function</span>(code, envir) {
+ m <-<span class="st"> </span><span class="kw">regexpr</span>(<span class="st">":.+$"</span>, code)
+ <span class="cf">if</span> (m <span class="op">!=</span><span class="st"> </span><span class="op">-</span><span class="dv">1</span>) {
+ format <-<span class="st"> </span><span class="kw">substring</span>(<span class="kw">regmatches</span>(code, m), <span class="dv">2</span>)
+ <span class="kw">regmatches</span>(code, m) <-<span class="st"> ""</span>
+ res <-<span class="st"> </span><span class="kw">evaluate</span>(code, envir)
+ <span class="kw">do.call</span>(sprintf, <span class="kw">list</span>(<span class="kw">glue</span>(<span class="st">"%{format}f"</span>), res))
+ } <span class="cf">else</span> {
+ <span class="kw">evaluate</span>(code, envir)
+ }
+}
+
+glue_fmt <-<span class="st"> </span><span class="cf">function</span>(..., <span class="dt">.envir =</span> <span class="kw">parent.frame</span>()) {
+ <span class="kw">glue</span>(..., <span class="dt">.transformer =</span> sprintf_transformer, <span class="dt">.envir =</span> .envir)
+}
+<span class="kw">glue_fmt</span>(<span class="st">"π = {pi:.2}"</span>)
+<span class="co">#> π = 3.14</span></code></pre></div>
+</div>
+<div id="safely-transformer" class="section level3">
+<h3>safely transformer</h3>
+<p>A transformer that acts like <code>purrr::safely()</code>, which returns a value instead of an error.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">safely_transformer <-<span class="st"> </span><span class="cf">function</span>(<span class="dt">otherwise =</span> <span class="ot">NA</span>) {
+ <span class="cf">function</span>(code, envir) {
+ <span class="kw">tryCatch</span>(<span class="kw">evaluate</span>(code, envir),
+ <span class="dt">error =</span> <span class="cf">function</span>(e) <span class="cf">if</span> (<span class="kw">is.language</span>(otherwise)) <span class="kw">eval</span>(otherwise) <span class="cf">else</span> otherwise)
+ }
+}
+
+glue_safely <-<span class="st"> </span><span class="cf">function</span>(..., <span class="dt">.otherwise =</span> <span class="ot">NA</span>, <span class="dt">.envir =</span> <span class="kw">parent.frame</span>()) {
+ <span class="kw">glue</span>(..., <span class="dt">.transformer =</span> <span class="kw">safely_transformer</span>(.otherwise), <span class="dt">.envir =</span> .envir)
+}
+
+<span class="co"># Default returns missing if there is an error</span>
+<span class="kw">glue_safely</span>(<span class="st">"foo: {xyz}"</span>)
+<span class="co">#> foo: NA</span>
+
+<span class="co"># Or an empty string</span>
+<span class="kw">glue_safely</span>(<span class="st">"foo: {xyz}"</span>, <span class="dt">.otherwise =</span> <span class="st">"Error"</span>)
+<span class="co">#> foo: Error</span>
+
+<span class="co"># Or output the error message in red</span>
+<span class="kw">library</span>(crayon)
+<span class="kw">glue_safely</span>(<span class="st">"foo: {xyz}"</span>, <span class="dt">.otherwise =</span> <span class="kw">quote</span>(<span class="kw">glue</span>(<span class="st">"{red}Error: {conditionMessage(e)}{reset}"</span>)))
+<span class="co">#> foo: Error: object 'xyz' not found</span></code></pre></div>
+</div>
+
+
+
+<!-- dynamically load mathjax for compatibility with self-contained -->
+<script>
+ (function () {
+ var script = document.createElement("script");
+ script.type = "text/javascript";
+ script.src = "https://mathjax.rstudio.com/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML";
+ document.getElementsByTagName("head")[0].appendChild(script);
+ })();
+</script>
+
+</body>
+</html>
diff --git a/man/evaluate.Rd b/man/evaluate.Rd
new file mode 100644
index 0000000..2bd9e87
--- /dev/null
+++ b/man/evaluate.Rd
@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/transformer.R
+\name{evaluate}
+\alias{evaluate}
+\title{Evaluate R code}
+\usage{
+evaluate(code, envir)
+}
+\arguments{
+\item{code}{R code to evaluate}
+
+\item{envir}{environment to evaluate the code in}
+}
+\description{
+This is a simple wrapper around \code{eval(parse())} which provides a more
+consistent interface than the default functions.
+If \code{data} is \code{NULL} then the code is evaluated in the environment. If \code{data}
+is not \code{NULL} than the code is evaluated in the \code{data} object first, with
+the enclosing environment of \code{envir}.
+}
+\details{
+This function is designed to be used within transformers to evaluate the
+code in the glue block.
+}
diff --git a/man/glue.Rd b/man/glue.Rd
index aee6e90..67dc13f 100644
--- a/man/glue.Rd
+++ b/man/glue.Rd
@@ -7,7 +7,7 @@
\title{Format and interpolate a string}
\usage{
glue_data(.x, ..., .sep = "", .envir = parent.frame(), .open = "{",
- .close = "}")
+ .close = "}", .na = "NA", .transformer = identity_transformer)
glue(..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}")
}
@@ -27,6 +27,14 @@ full delimiter escapes it.}
\item{.close}{[\code{character(1)}: \sQuote{\}}]\cr The closing delimiter. Doubling the
full delimiter escapes it.}
+
+\item{.na}{[\code{character(1)}: \sQuote{NA}]\cr Value to replace NA values
+with. If \code{NULL} missing values are propegated, that is an \code{NA} result will
+cause \code{NA} output. Otherwise the value is replaced by the value of \code{.na}.}
+
+\item{.transformer}{[\code{function]}\cr A function taking three parameters \code{code}, \code{envir} and
+\code{data} used to transform the output of each block before during or after
+evaluation. For example transformers see \code{vignette("transformers")}.}
}
\description{
Expressions enclosed by braces will be evaluated as R code. Single braces
diff --git a/man/glue_sql.Rd b/man/glue_sql.Rd
new file mode 100644
index 0000000..04d55dd
--- /dev/null
+++ b/man/glue_sql.Rd
@@ -0,0 +1,103 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sql.R
+\name{glue_sql}
+\alias{glue_sql}
+\alias{glue_data_sql}
+\title{Interpolate strings with SQL escaping}
+\usage{
+glue_sql(..., .con, .envir = parent.frame())
+
+glue_data_sql(.x, ..., .con, .envir = parent.frame())
+}
+\arguments{
+\item{...}{[\code{expressions}]\cr Expressions string(s) to format, multiple inputs are concatenated together before formatting.}
+
+\item{.con}{[\code{DBIConnection}]:A DBI connection object obtained from \code{DBI::dbConnect()}.}
+
+\item{.envir}{[\code{environment}: \code{parent.frame()}]\cr Environment to evaluate each expression in. Expressions are
+evaluated from left to right. If \code{.x} is an environment, the expressions are
+evaluated in that environment and \code{.envir} is ignored.}
+
+\item{.x}{[\code{listish}]\cr An environment, list or data frame used to lookup values.}
+}
+\value{
+A \code{DBI::SQL()} object with the given query.
+}
+\description{
+SQL databases often have custom quotation syntax for identifiers and strings
+which make writing SQL queries error prone and cumbersome to do. \code{glue_sql()} and
+\code{glue_sql_data()} are analogs to \code{glue()} and \code{glue_data()} which handle the
+SQL quoting.
+}
+\details{
+They automatically quote character results, quote identifiers if the glue
+expression is surrounded by backticks \sQuote{`} and do not quote
+non-characters such as numbers.
+
+Returning the result with \code{DBI::SQL()} will suppress quoting if desired for
+a given value.
+
+Note \href{https://db.rstudio.com/best-practices/run-queries-safely#parameterized-queries}{parameterized queries}
+are generally the safest and most efficient way to pass user defined
+values in a query, however not every database driver supports them.
+
+If you place a \code{*} at the end of a glue expression the values will be
+collapsed with commas. This is useful for the \href{https://www.w3schools.com/sql/sql_in.asp}{SQL IN Operator}
+for instance.
+}
+\examples{
+con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
+colnames(iris) <- gsub("[.]", "_", tolower(colnames(iris)))
+DBI::dbWriteTable(con, "iris", iris)
+var <- "sepal_width"
+tbl <- "iris"
+num <- 2
+val <- "setosa"
+glue_sql("
+ SELECT {`var`}
+ FROM {`tbl`}
+ WHERE {`tbl`}.sepal_length > {num}
+ AND {`tbl`}.species = {val}
+ ", .con = con)
+
+# `glue_sql()` can be used in conjuction with parameterized queries using
+# `DBI::dbBind()` to provide protection for SQL Injection attacks
+ sql <- glue_sql("
+ SELECT {`var`}
+ FROM {`tbl`}
+ WHERE {`tbl`}.sepal_length > ?
+ ", .con = con)
+query <- DBI::dbSendQuery(con, sql)
+DBI::dbBind(query, list(num))
+DBI::dbFetch(query, n = 4)
+DBI::dbClearResult(query)
+
+# `glue_sql()` can be used to build up more complex queries with
+# interchangeable sub queries. It returns `DBI::SQL()` objects which are
+# properly protected from quoting.
+sub_query <- glue_sql("
+ SELECT *
+ FROM {`tbl`}
+ ", .con = con)
+
+glue_sql("
+ SELECT s.{`var`}
+ FROM ({sub_query}) AS s
+ ", .con = con)
+
+# If you want to input multiple values for use in SQL IN statements put `*`
+# at the end of the value and the values will be collapsed and quoted appropriately.
+glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})",
+ vals = 1, .con = con)
+
+glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})",
+ vals = 1:5, .con = con)
+
+glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})",
+ vals = "setosa", .con = con)
+
+glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})",
+ vals = c("setosa", "versicolor"), .con = con)
+
+DBI::dbDisconnect(con)
+}
diff --git a/man/trim.Rd b/man/trim.Rd
index 4e8ab9f..388dadc 100644
--- a/man/trim.Rd
+++ b/man/trim.Rd
@@ -13,8 +13,6 @@ trim(x)
This trims a character vector according to the trimming rules used by glue.
These follow similar rules to \href{https://www.python.org/dev/peps/pep-0257}{Python Docstrings},
with the following features.
-}
-\details{
\itemize{
\item Leading and trailing whitespace from the first and last lines is removed.
\item A uniform amount of indentation is stripped from the second line on, equal
diff --git a/src/glue.c b/src/glue.c
index 1bd5b95..a42db86 100644
--- a/src/glue.c
+++ b/src/glue.c
@@ -1,6 +1,6 @@
+#include "Rinternals.h"
#include <stdlib.h>
#include <string.h>
-#include "Rinternals.h"
SEXP set(SEXP x, int i, SEXP val) {
size_t len = Rf_length(x);
@@ -37,6 +37,8 @@ SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg) {
const char* close = CHAR(STRING_ELT(close_arg, 0));
size_t close_len = strlen(close);
+ int delim_equal = strncmp(open, close, open_len) == 0;
+
SEXP out = Rf_allocVector(VECSXP, 3);
PROTECT_INDEX out_idx;
PROTECT_WITH_INDEX(out, &out_idx);
@@ -49,108 +51,108 @@ SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg) {
states prev_state = text;
for (size_t i = 0; i < str_len; ++i) {
switch (state) {
- case text: {
- if (strncmp(&xx[i], open, open_len) == 0) {
- /* check for open delim doubled */
- if (strncmp(&xx[i + open_len], open, open_len) == 0) {
- i += open_len;
- } else {
- state = delim;
- delim_level = 1;
- start = i + open_len;
- break;
- }
- }
- if (strncmp(&xx[i], close, close_len) == 0 &&
- strncmp(&xx[i + close_len], close, close_len) == 0) {
- i += close_len;
+ case text: {
+ if (strncmp(&xx[i], open, open_len) == 0) {
+ /* check for open delim doubled */
+ if (strncmp(&xx[i + open_len], open, open_len) == 0) {
+ i += open_len;
+ } else {
+ state = delim;
+ delim_level = 1;
+ start = i + open_len;
+ break;
}
-
- str[j++] = xx[i];
- break;
}
- case escape: {
- state = prev_state;
- break;
+ if (strncmp(&xx[i], close, close_len) == 0 &&
+ strncmp(&xx[i + close_len], close, close_len) == 0) {
+ i += close_len;
}
- case single_quote: {
- if (xx[i] == '\\') {
- prev_state = single_quote;
- state = escape;
- } else if (xx[i] == '\'') {
- state = delim;
- }
- break;
+
+ str[j++] = xx[i];
+ break;
+ }
+ case escape: {
+ state = prev_state;
+ break;
+ }
+ case single_quote: {
+ if (xx[i] == '\\') {
+ prev_state = single_quote;
+ state = escape;
+ } else if (xx[i] == '\'') {
+ state = delim;
}
- case double_quote: {
- if (xx[i] == '\\') {
- prev_state = double_quote;
- state = escape;
- } else if (xx[i] == '\"') {
- state = delim;
- }
- break;
+ break;
+ }
+ case double_quote: {
+ if (xx[i] == '\\') {
+ prev_state = double_quote;
+ state = escape;
+ } else if (xx[i] == '\"') {
+ state = delim;
}
- case backtick: {
- if (xx[i] == '\\') {
- prev_state = backtick;
- state = escape;
- } else if (xx[i] == '`') {
- state = delim;
- }
- break;
+ break;
+ }
+ case backtick: {
+ if (xx[i] == '\\') {
+ prev_state = backtick;
+ state = escape;
+ } else if (xx[i] == '`') {
+ state = delim;
}
- case comment: {
- if (xx[i] == '\n') {
- state = delim;
- }
- break;
+ break;
+ }
+ case comment: {
+ if (xx[i] == '\n') {
+ state = delim;
}
- case delim: {
- if (strncmp(&xx[i], open, open_len) == 0) {
- ++delim_level;
- i += open_len - 1;
- } else if (strncmp(&xx[i], close, close_len) == 0) {
- --delim_level;
- i += close_len - 1;
- } else {
- switch (xx[i]) {
- case '\'':
- state = single_quote;
- break;
- case '"':
- state = double_quote;
- break;
- case '`':
- state = backtick;
- break;
- case '#':
- state = comment;
- break;
- };
- }
- if (delim_level == 0) {
- // Result of the current glue statement
- SEXP expr = PROTECT(Rf_ScalarString(
- Rf_mkCharLen(&xx[start], (i - close_len) + 1 - start)));
- SEXP call = PROTECT(Rf_lang2(f, expr));
- SEXP result = PROTECT(Rf_eval(call, R_GlobalEnv));
-
- // text in between last glue statement
- str[j] = '\0';
- SEXP str_ = PROTECT(Rf_ScalarString(Rf_mkCharLenCE(str, j, CE_UTF8)));
- REPROTECT(out = set(out, k++, str_), out_idx);
-
- REPROTECT(out = set(out, k++, result), out_idx);
-
- // Clear the string buffer
- memset(str, 0, j);
- j = 0;
- UNPROTECT(4);
- state = text;
- }
- break;
+ break;
+ }
+ case delim: {
+ if (!delim_equal && strncmp(&xx[i], open, open_len) == 0) {
+ ++delim_level;
+ i += open_len - 1;
+ } else if (strncmp(&xx[i], close, close_len) == 0) {
+ --delim_level;
+ i += close_len - 1;
+ } else {
+ switch (xx[i]) {
+ case '\'':
+ state = single_quote;
+ break;
+ case '"':
+ state = double_quote;
+ break;
+ case '`':
+ state = backtick;
+ break;
+ case '#':
+ state = comment;
+ break;
+ };
+ }
+ if (delim_level == 0) {
+ // Result of the current glue statement
+ SEXP expr = PROTECT(Rf_ScalarString(
+ Rf_mkCharLen(&xx[start], (i - close_len) + 1 - start)));
+ SEXP call = PROTECT(Rf_lang2(f, expr));
+ SEXP result = PROTECT(Rf_eval(call, R_GlobalEnv));
+
+ // text in between last glue statement
+ str[j] = '\0';
+ SEXP str_ = PROTECT(Rf_ScalarString(Rf_mkCharLenCE(str, j, CE_UTF8)));
+ REPROTECT(out = set(out, k++, str_), out_idx);
+
+ REPROTECT(out = set(out, k++, result), out_idx);
+
+ // Clear the string buffer
+ memset(str, 0, j);
+ j = 0;
+ UNPROTECT(4);
+ state = text;
}
+ break;
+ }
};
}
diff --git a/src/trim.c b/src/trim.c
index 8ab7f22..ad48ec6 100644
--- a/src/trim.c
+++ b/src/trim.c
@@ -1,47 +1,48 @@
-#include <stdlib.h>
-#include <stdbool.h>
#include "Rinternals.h"
-#include <string.h> // for strlen()
+#include <stdbool.h>
+#include <stdlib.h>
+#include <string.h> // for strlen()
SEXP trim_(SEXP x) {
-
size_t len = LENGTH(x);
SEXP out = PROTECT(Rf_allocVector(STRSXP, len));
- for (size_t num = 0; num < len;++num) {
+ for (size_t num = 0; num < len; ++num) {
const char* xx = Rf_translateCharUTF8(STRING_ELT(x, num));
size_t str_len = strlen(xx);
- if (str_len == 0) {
- SET_STRING_ELT(out, num, R_BlankString);
- continue;
- }
- char * str = (char *) malloc(str_len + 1);
- size_t start = 0;
- size_t i = 0;
+ char* str = (char*)malloc(str_len + 1);
+ size_t i = 0, start = 0;
bool new_line = false;
- /* remove first blank line */
- while(i < str_len) {
- if (xx[i] == '\n') {
- ++i;
- start = i;
- new_line = true;
- break;
- } else if (xx[i] == ' ' || xx[i] == '\t') {
+
+ /* skip leading blanks on first line */
+ while (start < str_len && (xx[start] == ' ' || xx[start] == '\t')) {
+ ++start;
+ }
+
+ /* Skip first newline */
+ if (start < str_len && xx[start] == '\n') {
+ new_line = true;
+ ++start;
+ }
+
+ i = start;
+
+ /* Ignore first line */
+ if (!new_line) {
+ while (i < str_len && xx[i] != '\n') {
++i;
- } else {
- break;
}
+ new_line = true;
}
- i = start;
size_t indent = 0;
/* Maximum size of size_t */
size_t min_indent = (size_t)-1;
/* find minimum indent */
- while(i < str_len) {
+ while (i < str_len) {
if (xx[i] == '\n') {
new_line = true;
} else if (new_line) {
@@ -51,12 +52,14 @@ SEXP trim_(SEXP x) {
if (indent < min_indent) {
min_indent = indent;
}
+ indent = 0;
new_line = false;
}
}
++i;
}
- if (indent < min_indent) {
+
+ if (new_line && indent < min_indent) {
min_indent = indent;
}
@@ -64,13 +67,16 @@ SEXP trim_(SEXP x) {
i = start;
size_t j = 0;
+ /*Rprintf("start: %i\nindent: %i\nmin_indent: %i", start, indent,
+ * min_indent);*/
+
/* copy the string removing the minimum indent from new lines */
- while(i < str_len) {
+ while (i < str_len) {
if (xx[i] == '\n') {
new_line = true;
} else if (xx[i] == '\\' && i + 1 < str_len && xx[i + 1] == '\n') {
new_line = true;
- i+=2;
+ i += 2;
continue;
} else if (new_line) {
if (i + min_indent < str_len && (xx[i] == ' ' || xx[i] == '\t')) {
@@ -84,7 +90,7 @@ SEXP trim_(SEXP x) {
/* Remove trailing whitespace up to the first newline */
size_t end = j;
- while(j > 0) {
+ while (j > 0) {
if (str[j] == '\n') {
end = j;
break;
diff --git a/tests/testthat/test-collapse.R b/tests/testthat/test-collapse.R
index 4b1812a..d6b179e 100644
--- a/tests/testthat/test-collapse.R
+++ b/tests/testthat/test-collapse.R
@@ -34,3 +34,11 @@ test_that("last argument to collapse", {
test_that("collapse returns 0 length output for 0 length input", {
expect_identical(collapse(character()), as_glue(character()))
})
+
+test_that("collapse returns NA_character_ if any inputs are NA", {
+ expect_identical(collapse(NA_character_), as_glue(NA_character_))
+
+ expect_identical(collapse(c(1, 2, 3, NA_character_)), as_glue(NA_character_))
+
+ expect_identical(collapse(c("foo", NA_character_, "bar")), as_glue(NA_character_))
+})
diff --git a/tests/testthat/test-glue.R b/tests/testthat/test-glue.R
index 67c0b2e..77284b6 100644
--- a/tests/testthat/test-glue.R
+++ b/tests/testthat/test-glue.R
@@ -169,65 +169,6 @@ test_that("glue_data evaluates in the object first, then enclosure, then parent"
expect_identical(as_glue("3 3 3"), glue_data(env2, "{x} {y} {z}"))
})
-test_that("trim works", {
- expect_identical("", trim(""))
- expect_identical(character(), trim(character()))
- expect_identical("test", trim("test"))
- expect_identical(c("foo", "bar"), trim(c("foo", "bar")))
- expect_identical(c("foo", "bar"), trim(c("\nfoo", "bar\n")))
- expect_identical("test",
- trim(
- "test"))
- expect_identical("test",
- x <- trim(
- "test
- "))
- expect_identical("test",
- trim("
- test
- "))
- expect_identical("test",
- trim(
- "test"))
- expect_identical("test\n test2",
- trim("
- test
- test2
- "))
- expect_identical("test\n test2\n test3",
- trim("
- test
- test2
- test3
- "))
-
- expect_identical("\ntest\n",
- trim("
-
- test
-
- "))
-})
-
-test_that("trim strips escaped newlines", {
- expect_identical(
- "foo bar baz",
- trim("foo bar \\\nbaz"))
-
- expect_identical(
- "foo bar baz",
- trim("foo bar \\
- baz"))
-
- expect_identical(
- "foo bar baz\n",
- trim("foo bar baz\n\n"))
-
- expect_identical(
- "\nfoo bar baz",
- trim("\n\nfoo bar baz"))
-})
-
test_that("converting glue to character", {
expect_identical("foo bar", as.character(glue("foo bar")))
})
@@ -242,6 +183,8 @@ test_that("printing glue identical to cat()", {
test_that("length 0 inputs produce length 0 outputs", {
expect_identical(as_glue(character(0)), glue("foo", character(0)))
+ expect_identical(as_glue(character(0)), glue("foo", NULL))
+ expect_identical(as_glue(character(0)), glue("foo", NULL, "bar"))
expect_identical(as_glue(character(0)), glue("foo", "{character(0)}"))
expect_identical(as_glue(character(0)), glue("foo {character(0)}"))
@@ -304,3 +247,84 @@ test_that("glue always returns UTF-8 encoded strings regardless of input encodin
expect_identical(xy_out, glue(x, y))
expect_identical(xy_out, glue("{x}{y}"))
})
+
+test_that("glue always returns NA_character_ if given any NA input and `.na` == NULL", {
+ expect_identical(
+ glue("{NA}", .na = NULL),
+ as_glue(NA_character_))
+
+ expect_identical(
+ glue(NA, .na = NULL),
+ as_glue(NA_character_))
+
+ expect_identical(
+ glue(NA, 1, .na = NULL),
+ as_glue(NA_character_))
+
+ expect_identical(
+ glue(1, NA, 2, .na = NULL),
+ as_glue(NA_character_))
+
+ x <- c("foo", NA_character_, "bar")
+ expect_identical(
+ glue("{x}", .na = NULL),
+ as_glue(c("foo", NA_character_, "bar")))
+
+ expect_identical(
+ glue("{1:3} - {x}", .na = NULL),
+ as_glue(c("1 - foo", NA_character_, "3 - bar")))
+})
+
+test_that("glue always returns .na if given any NA input and `.na` != NULL", {
+ expect_identical(
+ glue("{NA}", .na = "foo"),
+ as_glue("foo"))
+
+ expect_identical(
+ glue("{NA}", .na = "foo"),
+ as_glue("foo"))
+
+ expect_identical(
+ glue(NA, .na = "foo"),
+ as_glue("foo"))
+
+ expect_identical(
+ glue(NA, 1, .na = "foo"),
+ as_glue("foo1"))
+
+ expect_identical(
+ glue(1, NA, 2, .na = "foo"),
+ as_glue("1foo2"))
+
+ x <- c("foo", NA_character_, "bar")
+ expect_identical(
+ glue("{x}", .na = "baz"),
+ as_glue(c("foo", "baz", "bar")))
+
+ expect_identical(
+ glue("{1:3} - {x}", .na = "baz"),
+ as_glue(c("1 - foo", "2 - baz", "3 - bar")))
+})
+
+test_that("glue works within functions", {
+ x <- 1
+ f <- function(msg) glue(msg, .envir = parent.frame())
+
+ expect_identical(f("{x}"), as_glue("1"))
+})
+
+test_that("scoping works within lapply (#42)", {
+ f <- function(msg) {
+ glue(msg, .envir = parent.frame())
+ }
+ expect_identical(lapply(1:2, function(x) f("{x * 2}")),
+ list(as_glue("2"), as_glue("4")))
+})
+
+test_that("glue works with lots of arguments", {
+ expect_identical(
+ glue("a", "very", "long", "test", "of", "how", "many", "unnamed",
+ "arguments", "you", "can", "have"),
+
+ as_glue("averylongtestofhowmanyunnamedargumentsyoucanhave"))
+})
diff --git a/tests/testthat/test-sql.R b/tests/testthat/test-sql.R
new file mode 100644
index 0000000..b62c151
--- /dev/null
+++ b/tests/testthat/test-sql.R
@@ -0,0 +1,47 @@
+context("sql")
+
+describe("glue_sql", {
+ con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
+ on.exit(DBI::dbDisconnect(con))
+
+ it("errors if no connection given", {
+ var <- "foo"
+ expect_error(glue_sql("{var}"), "missing")
+ })
+ it("returns the string if no substations needed", {
+ expect_identical(glue_sql("foo", .con = con), DBI::SQL("foo"))
+ })
+ it("quotes string values", {
+ var <- "foo"
+ expect_identical(glue_sql("{var}", .con = con), DBI::SQL("'foo'"))
+ })
+ it("quotes identifiers", {
+ var <- "foo"
+ expect_identical(glue_sql("{`var`}", .con = con), DBI::SQL("`foo`"))
+ })
+ it("Does not quote numbers", {
+ var <- 1
+ expect_identical(glue_sql("{var}", .con = con), DBI::SQL("1"))
+ })
+ it("Does not quote DBI::SQL()", {
+ var <- DBI::SQL("foo")
+ expect_identical(glue_sql("{var}", .con = con), DBI::SQL("foo"))
+ })
+ it("collapses values if succeeded by a *", {
+ expect_identical(glue_sql("{var*}", .con = con, var = 1), DBI::SQL(1))
+ expect_identical(glue_sql("{var*}", .con = con, var = 1:5), DBI::SQL("1, 2, 3, 4, 5"))
+
+ expect_identical(glue_sql("{var*}", .con = con, var = "a"), DBI::SQL("'a'"))
+ expect_identical(glue_sql("{var*}", .con = con, var = letters[1:5]), DBI::SQL("'a', 'b', 'c', 'd', 'e'"))
+ })
+})
+
+describe("glue_data_sql", {
+ con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
+ on.exit(DBI::dbDisconnect(con))
+
+ it("collapses values if succeeded by a *", {
+ var <- "foo"
+ expect_identical(glue_data_sql(mtcars, "{head(gear)*}", .con = con), DBI::SQL("4, 4, 4, 3, 3, 3"))
+ })
+})
diff --git a/tests/testthat/test-trim.R b/tests/testthat/test-trim.R
new file mode 100644
index 0000000..f1c034b
--- /dev/null
+++ b/tests/testthat/test-trim.R
@@ -0,0 +1,117 @@
+context("trim")
+
+test_that("trim works", {
+ expect_identical("", trim(""))
+ expect_identical(character(), trim(character()))
+ expect_identical(" ", trim(" "))
+ expect_identical("test", trim("test"))
+ expect_identical(" test", trim(" test"))
+ expect_identical("test ", trim("test "))
+ expect_identical("test", trim("test"))
+ expect_identical(c("foo", "bar"), trim(c("foo", "bar")))
+ expect_identical(c("foo", "bar"), trim(c("\nfoo", "bar\n")))
+ expect_identical("test",
+ trim(
+ "test"))
+ expect_identical("test",
+ x <- trim(
+ "test
+ "))
+ expect_identical("test",
+ trim("
+ test
+ "))
+ expect_identical("test",
+ trim(
+ "test"))
+ expect_identical("test\n test2",
+ trim("
+ test
+ test2
+ "))
+ expect_identical("test\n test2\n test3",
+ trim("
+ test
+ test2
+ test3
+ "))
+
+ expect_identical("\ntest\n",
+ trim("
+
+ test
+
+ "))
+})
+
+test_that("trim strips escaped newlines", {
+ expect_identical(
+ "foo bar baz",
+ trim("foo bar \\\nbaz"))
+
+ expect_identical(
+ trim("
+ foo bar \\
+ baz"),
+ "foo bar baz")
+
+ expect_identical(
+ trim("
+ foo bar \\
+ baz
+ "),
+ "foo bar baz")
+
+ expect_identical(
+ "foo bar baz\n",
+ trim("foo bar baz\n\n"))
+
+ expect_identical(
+ "\nfoo bar baz",
+ trim("\n\nfoo bar baz"))
+})
+
+test_that("issue#44", {
+ expect_identical(
+ trim("12345678
+ foo
+ bar
+ baz
+ bar
+ baz"),
+ "12345678\n foo\n bar\nbaz\n bar\n baz")
+})
+
+test_that("issue#47", {
+ expect_identical(
+ trim("
+ Hello,
+ World.
+ "),
+ " Hello,\n World.")
+
+ expect_identical(
+ trim("
+ foo
+ bar
+ 123456789"),
+ "foo\n bar\n 123456789")
+
+ expected <- "The stuff before the bullet list\n * one bullet"
+
+ expect_identical(
+ trim("The stuff before the bullet list
+ * one bullet
+ "), expected)
+
+ expect_identical(
+ trim("
+ The stuff before the bullet list
+ * one bullet"), expected)
+
+ expect_identical(
+ trim("
+ The stuff before the bullet list
+ * one bullet
+ "), expected)
+})
diff --git a/vignettes/speed.Rmd b/vignettes/speed.Rmd
new file mode 100644
index 0000000..c47e67a
--- /dev/null
+++ b/vignettes/speed.Rmd
@@ -0,0 +1,117 @@
+---
+title: "Speed of glue"
+author: "Jim Hester"
+date: "`r Sys.Date()`"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Vignette Title}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+ % \VignetteDepends{R.utils
+ R.utils,
+ forcats,
+ microbenchmark,
+ rprintf,
+ stringr,
+ ggplot2}
+---
+
+Glue is advertised as
+
+> Fast, dependency free string literals
+
+So what do we mean when we say that glue is fast. This does not mean glue is
+the fastest thing to use in all cases, however for the features it provides we
+can confidently say it is fast.
+
+A good way to determine this is to compare it's speed of execution to some alternatives.
+
+- `base::paste0()`, `base::sprintf()` - Functions in base R implemented in C
+ that provide variable insertion (but not interpolation).
+- `R.utils::gstring()`, `stringr::str_interp()` - Provides a similar interface
+ as glue, but using `${}` to delimit blocks to interpolate.
+- `pystr::pystr_format()`[^1], `rprintf::rprintf()` - Provide a interfaces similar
+ to python string formatters with variable replacement, but not arbitrary
+ interpolation.
+
+```{r setup, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE, comment = "#>",
+ eval = as.logical(Sys.getenv("VIGNETTE_EVAL", "FALSE")),
+ cache = TRUE)
+library(glue)
+```
+
+```{r setup2, include = FALSE}
+plot_comparison <- function(x, ...) {
+ library(ggplot2)
+ x$expr <- forcats::fct_reorder(x$expr, x$time)
+ colors <- ifelse(levels(x$expr) == "glue", "orange", "grey")
+ autoplot(x, ...) +
+ theme(axis.text.y = element_text(color = colors)) +
+ aes(fill = expr) + scale_fill_manual(values = colors, guide = FALSE)
+}
+```
+
+## Simple concatenation
+
+```{r}
+bar <- "baz"
+
+simple <-
+ microbenchmark::microbenchmark(
+ glue = glue::glue("foo{bar}"),
+ gstring = R.utils::gstring("foo${bar}"),
+ paste0 = paste0("foo", bar),
+ sprintf = sprintf("foo%s", bar),
+ str_interp = stringr::str_interp("foo${bar}"),
+ rprintf = rprintf::rprintf("foo$bar", bar = bar)
+)
+
+print(unit = "eps", order = "median", signif = 4, simple)
+
+plot_comparison(simple)
+```
+
+While `glue()` is slower than `paste0`,`sprintf()` it is
+twice as fast as `str_interp()` and `gstring()`, and on par with `rprintf()`.
+
+`paste0()`, `sprintf()` don't do string interpolation and will likely always be
+significantly faster than glue, glue was never meant to be a direct replacement
+for them.
+
+`rprintf()` does only variable interpolation, not arbitrary expressions, which
+was one of the explicit goals of writing glue.
+
+So glue is ~2x as fast as the two functions (`str_interp()`, `gstring()`) which do have
+roughly equivalent functionality.
+
+It also is still quite fast, with over 6000 evaluations per second on this machine.
+
+## Vectorized performance
+
+Taking advantage of glue's vectorization is the best way to avoid performance.
+For instance the vectorized form of the previous benchmark is able to generate
+100,000 strings in only 22ms with performance much closer to that of
+`paste0()` and `sprintf()`. NB. `str_interp()` does not support
+vectorization, so were removed.
+
+```{r}
+bar <- rep("bar", 1e5)
+
+vectorized <-
+ microbenchmark::microbenchmark(
+ glue = glue::glue("foo{bar}"),
+ gstring = R.utils::gstring("foo${bar}"),
+ paste0 = paste0("foo", bar),
+ sprintf = sprintf("foo%s", bar),
+ rprintf = rprintf::rprintf("foo$bar", bar = bar)
+)
+
+print(unit = "ms", order = "median", signif = 4, vectorized)
+
+plot_comparison(vectorized, log = FALSE)
+```
+
+[^1]: pystr is no longer available from CRAN due to failure to correct
+installation errors and was therefore removed from futher testing.
diff --git a/vignettes/transformers.Rmd b/vignettes/transformers.Rmd
new file mode 100644
index 0000000..aabb96e
--- /dev/null
+++ b/vignettes/transformers.Rmd
@@ -0,0 +1,131 @@
+---
+title: "Transformers"
+author: "Jim Hester"
+date: "`r Sys.Date()`"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Transformers}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+Transformers allow you to apply functions to the glue input and output, before
+and after evaluation. This allows you to write things like `glue_sql()`, which
+automatically quotes variables for you or add a syntax for automatically
+collapsing outputs.
+
+The transformer functions simply take two arguments `code` and `envir`, where
+`code` is the unparsed string inside the glue block and `envir` is the environment to
+execute the code in. Most transformers will then call `glue::evaluate()`, which
+takes `code` and `envir` and parses and evaluates the code.
+
+You can then supply the transformer function to glue with the `.transformer`
+argument. In this way users can define manipulate the code before parsing and
+change the output after evaluation.
+
+It is often useful to write a `glue()` wrapper function which supplies a
+`.transformer` to `glue()` or `glue_data()` and potentially has additional
+arguments. One important consideration when doing this is to include
+`.envir = parent.frame()` in the wrapper to ensure the evaluation environment
+is correct.
+
+Some examples implementations of potentially useful transformers follow. The
+aim right now is not to include most of these custom functions within the
+`glue` package. Rather users are encouraged to create custom functions using
+transformers to fit their individual needs.
+
+```{r, include = FALSE}
+library(glue)
+knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
+```
+
+### collapse transformer
+
+A transformer which automatically collapses any glue block ending with `*`.
+
+```{r}
+collapse_transformer <- function(regex = "[*]$", ...) {
+ function(code, envir) {
+ if (grepl(regex, code)) {
+ code <- sub(regex, "", code)
+ }
+ res <- evaluate(code, envir)
+ collapse(res, ...)
+ }
+}
+
+glue("{1:5*}\n{letters[1:5]*}", .transformer = collapse_transformer(sep = ", "))
+
+glue("{1:5*}\n{letters[1:5]*}", .transformer = collapse_transformer(sep = ", ", last = " and "))
+```
+
+### emoji transformer
+
+A transformer which converts the text to the equivalent emoji.
+
+```{r, eval = require("emo")}
+emoji_transformer <- function(code, envir) {
+ if (grepl("[*]$", code)) {
+ code <- sub("[*]$", "", code)
+ collapse(ji_find(code)$emoji)
+ } else {
+ ji(code)
+ }
+}
+
+glue_ji <- function(..., .envir = parent.frame()) {
+ glue(..., .open = ":", .close = ":", .envir = .envir, .transformer = emoji_transformer)
+}
+glue_ji("one :heart:")
+glue_ji("many :heart*:")
+```
+
+### sprintf transformer
+
+A transformer which allows succinct sprintf format strings.
+
+```{r}
+sprintf_transformer <- function(code, envir) {
+ m <- regexpr(":.+$", code)
+ if (m != -1) {
+ format <- substring(regmatches(code, m), 2)
+ regmatches(code, m) <- ""
+ res <- evaluate(code, envir)
+ do.call(sprintf, list(glue("%{format}f"), res))
+ } else {
+ evaluate(code, envir)
+ }
+}
+
+glue_fmt <- function(..., .envir = parent.frame()) {
+ glue(..., .transformer = sprintf_transformer, .envir = .envir)
+}
+glue_fmt("π = {pi:.2}")
+```
+
+### safely transformer
+
+A transformer that acts like `purrr::safely()`, which returns a value instead of an error.
+
+```{r}
+safely_transformer <- function(otherwise = NA) {
+ function(code, envir) {
+ tryCatch(evaluate(code, envir),
+ error = function(e) if (is.language(otherwise)) eval(otherwise) else otherwise)
+ }
+}
+
+glue_safely <- function(..., .otherwise = NA, .envir = parent.frame()) {
+ glue(..., .transformer = safely_transformer(.otherwise), .envir = .envir)
+}
+
+# Default returns missing if there is an error
+glue_safely("foo: {xyz}")
+
+# Or an empty string
+glue_safely("foo: {xyz}", .otherwise = "Error")
+
+# Or output the error message in red
+library(crayon)
+glue_safely("foo: {xyz}", .otherwise = quote(glue("{red}Error: {conditionMessage(e)}{reset}")))
+```
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-glue.git
More information about the debian-med-commit
mailing list