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.
collapse transformer
A transformer which automatically collapses any glue block ending with *.
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 =", "))
#> 1, 2, 3, 4, 5#> a, b, c, d, eglue("{1:5*}\n{letters[1:5]*}", .transformer =collapse_transformer(sep =", ", last =" and "))
#> 1, 2, 3, 4 and 5#> a, b, c, d and e
emoji transformer
A transformer which converts the text to the equivalent emoji.
A transformer which allows succinct sprintf format strings.
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}")
#> π = 3.14
safely transformer
A transformer that acts like purrr::safely(), which returns a value instead of an error.
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 errorglue_safely("foo: {xyz}")
#> foo: NA# Or an empty stringglue_safely("foo: {xyz}", .otherwise ="Error")
#> foo: Error# Or output the error message in redlibrary(crayon)
glue_safely("foo: {xyz}", .otherwise =quote(glue("{red}Error: {conditionMessage(e)}{reset}")))
#> foo: Error: object 'xyz' not found
glue/inst/doc/speed.Rmd 0000644 0001762 0000144 00000007034 13174710706 014506 0 ustar ligges users ---
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.
glue/inst/doc/speed.html 0000644 0001762 0000144 00000032642 13175423151 014727 0 ustar ligges users
Speed of glue
Speed of glue
Jim Hester
2017-10-29
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.
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.
pystr is no longer available from CRAN due to failure to correct installation errors and was therefore removed from futher testing.↩
glue/inst/doc/transformers.Rmd 0000644 0001762 0000144 00000007600 13174372677 016145 0 ustar ligges users ---
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}")))
```
glue/inst/doc/transformers.R 0000644 0001762 0000144 00000004406 13175423152 015607 0 ustar ligges users ## ---- 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}")))
glue/tests/ 0000755 0001762 0000144 00000000000 13174372770 012363 5 ustar ligges users glue/tests/testthat.R 0000644 0001762 0000144 00000000064 13167212575 014344 0 ustar ligges users library(testthat)
library(glue)
test_check("glue")
glue/tests/testthat/ 0000755 0001762 0000144 00000000000 13175432051 014211 5 ustar ligges users glue/tests/testthat/test-glue.R 0000644 0001762 0000144 00000021444 13174371263 016260 0 ustar ligges users context("glue")
test_that("inputs are concatenated, interpolated variables recycled", {
expect_identical(as_glue(c("testastring1", "testastring2")), glue("test", "a", "string", "{1:2}"))
})
test_that("glue errors if the expression fails", {
expect_error(glue("{NoTfOuNd}"), "object .* not found")
})
test_that("glue errors if invalid format", {
expect_error(glue("x={x"), "Expecting '}'")
})
test_that("glue returns length 1 string from length 1 input", {
expect_identical(as_glue(""), glue(""))
})
test_that("glue works with single expressions", {
foo <- "foo"
expect_identical(as_glue(foo), glue("{foo}"))
foo <- 1L
expect_identical(as_glue(foo), glue("{foo}"))
foo <- as.raw(1)
expect_identical(as_glue(foo), glue("{foo}"))
foo <- TRUE
expect_identical(as_glue(foo), glue("{foo}"))
foo <- as.Date("2016-01-01")
expect_identical(as_glue(foo), glue("{foo}"))
})
test_that("glue works with repeated expressions", {
foo <- "foo"
expect_identical(as_glue(paste(foo, foo)), glue("{foo} {foo}"))
foo <- 1L
expect_identical(as_glue(paste(as.character(foo), as.character(foo))), glue("{foo} {foo}"))
foo <- as.raw(1)
expect_identical(as_glue(paste(as.character(foo), as.character(foo))), glue("{foo} {foo}"))
foo <- TRUE
expect_identical(as_glue(paste(as.character(foo), as.character(foo))), glue("{foo} {foo}"))
foo <- as.Date("2016-01-01")
expect_identical(as_glue(paste(as.character(foo), as.character(foo))), glue("{foo} {foo}"))
})
test_that("glue works with multiple expressions", {
foo <- "foo"
bar <- "bar"
expect_identical(as_glue(paste(foo, bar)), glue("{foo} {bar}"))
foo <- 1L
bar <- 2L
expect_identical(as_glue(paste(as.character(foo), as.character(bar))), glue("{foo} {bar}"))
foo <- as.raw(1)
bar <- as.raw(2)
expect_identical(as_glue(paste(as.character(foo), as.character(bar))), glue("{foo} {bar}"))
foo <- TRUE
bar <- FALSE
expect_identical(as_glue(paste(as.character(foo), as.character(bar))), glue("{foo} {bar}"))
foo <- as.Date("2016-01-01")
bar <- as.Date("2016-01-02")
expect_identical(as_glue(paste(as.character(foo), as.character(bar))), glue("{foo} {bar}"))
})
test_that("glue with doubled braces are converted glue single braces", {
expect_identical(as_glue("{foo}"), glue("{{foo}}"))
})
test_that("glue works with complex expressions", {
`foo}\`` <- "foo"
expect_identical(as_glue(`foo}\``), glue("{
{
'}\\'' # { and } in comments, single quotes
\"}\\\"\" # or double quotes are ignored
`foo}\\`` # as are { in backticks
}
}"))
})
test_that("glue works with large outputs", {
# initial buffer allocates input string length + 1024, 40 * 26 = 1040
foo <- paste(rep(letters, 40), collapse = "")
# re-allocation on result
expect_identical(as_glue(foo), glue("{foo}"))
# re-allocation on input
bar <- paste(rep(letters, 40), collapse = "")
additional <- " some more text that requires an allocation"
expect_identical(as_glue(paste0(bar, additional)), glue("{bar}", additional))
})
test_that("glue works with named arguments", {
name <- "Fred"
res <- glue('My name is {name},',
' my age next year is {age + 1},',
' a dot is a {.}',
name = "Joe",
age = 40,
. = "'.'")
expect_identical(
as_glue("My name is Joe, my age next year is 41, a dot is a '.'"),
res
)
expect_identical("Fred", name)
})
test_that("glue evaluates arguments in the expected environment", {
x <- 2
fun <- function() {
x <- 1
glue("x: {x}, x+1: {y}", y = x + 1, .envir = parent.frame())
}
expect_identical(as_glue("x: 2, x+1: 3"), fun())
})
test_that("glue assigns arguments in the environment", {
expect_identical(as_glue("1"), glue::glue("{b}", a = 1, b = a))
})
test_that("error if non length 1 inputs", {
expect_error(glue(1:2, "{1:2}"), "All unnamed arguments must be length 1")
})
test_that("error if not simple recycling", {
expect_error(glue("{1:2}{1:10}"), "Variables must be length 1 or 10")
})
test_that("recycle_columns returns if zero length input", {
expect_identical(list(), recycle_columns(list()))
expect_identical(character(), recycle_columns(list(character())))
})
test_that("glue_data evaluates in the object first, then enclosure, then parent", {
x <- 1
y <- 1
z <- 1
fun <- function(env = environment()) {
y <- 2
glue_data(list(x = 3), "{x} {y} {z}", .envir = env)
}
# The function environment
expect_identical(as_glue("3 2 1"), fun())
# This environment
env <- environment()
expect_identical(as_glue("3 1 1"), fun(env))
# A new environment
env2 <- new.env(parent = emptyenv())
env2$x <- 3
env2$y <- 3
env2$z <- 3
expect_identical(as_glue("3 3 3"), glue_data(env2, "{x} {y} {z}"))
})
test_that("converting glue to character", {
expect_identical("foo bar", as.character(glue("foo bar")))
})
test_that("converting glue to glue", {
expect_identical(as_glue("foo bar"), as_glue(glue("foo bar")))
})
test_that("printing glue identical to cat()", {
expect_output(print(glue("foo\nbar")), "foo\nbar")
})
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)}"))
})
test_that("values are trimmed before evaluation", {
x <- " a1\n b2\n c3"
expect_identical(
as_glue(
"A
a1
b2
c3
B"),
glue("
A
{x}
B
"))
})
test_that("glue works with alternative delimiters", {
expect_identical(as_glue("{1}"), glue("{1}", .open = "", .close = ""))
expect_identical(as_glue("{{}}"), glue("{{}}", .open = "", .close = ""))
expect_identical(as_glue("1"), glue("<<1>>", .open = "<<", .close = ">>"))
expect_identical(as_glue("<<>>"), glue("<<<<>>>>", .open = "<<", .close = ">>"))
expect_identical(as_glue("1"), glue("{{1}}", .open = "{{", .close = "}}"))
expect_identical(as_glue("1"), glue("{{ {{1}} }}", .open = "{{", .close = "}}"))
expect_identical(as_glue("1"), glue("{{ {{{1}}} }}", .open = "{{", .close = "}}"))
expect_identical(as_glue("1"), glue("{{ {{{{1}}}} }}", .open = "{{", .close = "}}"))
expect_identical(as_glue("a"), glue("[letters[[1]]]", .open = "[", .close = "]"))
expect_identical(as_glue("a"), glue("[[ letters[[1]] ]]", .open = "[[", .close = "]]"))
})
test_that("glue always returns UTF-8 encoded strings regardless of input encodings", {
x <- "fa\xE7ile"
Encoding(x) <- "latin1"
x_out <- as_glue(enc2utf8(x))
expect_identical(x_out, glue(x))
expect_identical(x_out, glue("{x}"))
y <- "p\u00E4o"
Encoding(y) <- "UTF-8"
y_out <- as_glue(enc2utf8(y))
expect_identical(y_out, glue(y))
expect_identical(y_out, glue("{y}"))
xy_out <- as_glue(paste0(x_out, y_out))
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"))
})
glue/tests/testthat/test-collapse.R 0000644 0001762 0000144 00000003517 13167212575 017131 0 ustar ligges users context("collapse")
test_that("collapse works like paste(collapse=)", {
# Always return 0 length outputs for 0 length inputs.
#expect_identical(paste(collapse = "", character(0)), collapse(character(0)))
expect_identical(as_glue(paste(collapse = "", "")), collapse(""))
expect_identical(as_glue(paste(collapse = "", 1:10)), collapse(1:10))
expect_identical(as_glue(paste(collapse = " ", 1:10)), collapse(1:10, sep = " "))
})
test_that("collapse truncates", {
expect_identical(as_glue("12345678910"), collapse(1:10, width = 11))
expect_identical(as_glue("12345678910"), collapse(1:10, width = 100))
expect_identical(as_glue("1234567..."), collapse(1:10, width = 10))
expect_identical(as_glue("123..."), collapse(1:10, width = 6))
expect_identical(as_glue("1..."), collapse(1:10, width = 4))
expect_identical(as_glue("..."), collapse(1:10, width = 0))
})
test_that("last argument to collapse", {
expect_equal(collapse(character(), last = " and "), as_glue(character()))
expect_equal(collapse("", last = " and "), as_glue(""))
expect_equal(collapse(1, last = " and "), as_glue("1"))
expect_equal(collapse(1:2, last = " and "),as_glue( "1 and 2"))
expect_equal(collapse(1:4, ", ", last = " and "), as_glue("1, 2, 3 and 4"))
expect_equal(collapse(1:4, ", ", last = " and ", width = 5), as_glue("1,..."))
expect_equal(collapse(1:4, ", ", last = " and ", width = 10), as_glue("1, 2, 3..."))
})
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_))
})
glue/tests/testthat/test-quoting.R 0000644 0001762 0000144 00000001364 13167212575 017013 0 ustar ligges users context("quoting")
test_that("single_quote works", {
expect_identical(single_quote(character()), character())
expect_identical(single_quote(""), "''")
expect_identical(single_quote(1:5),
c("'1'",
"'2'",
"'3'",
"'4'",
"'5'"
))
})
test_that("double_quote works", {
expect_identical(double_quote(character()), character())
expect_identical(double_quote(""), '""')
expect_identical(double_quote(1:5),
c('"1"',
'"2"',
'"3"',
'"4"',
'"5"'
))
})
test_that("backtick works", {
expect_identical(backtick(character()), character())
expect_identical(backtick(""), '``')
expect_identical(backtick(1:5),
c("`1`",
"`2`",
"`3`",
"`4`",
"`5`"
))
})
glue/tests/testthat/test-trim.R 0000644 0001762 0000144 00000004251 13167212575 016276 0 ustar ligges users 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)
})
glue/tests/testthat/test-sql.R 0000644 0001762 0000144 00000003046 13167653473 016131 0 ustar ligges users 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"))
})
})
glue/src/ 0000755 0001762 0000144 00000000000 13175423153 012001 5 ustar ligges users glue/src/trim.c 0000644 0001762 0000144 00000004677 13175423153 013136 0 ustar ligges users #include "Rinternals.h"
#include
#include
#include // 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) {
const char* xx = Rf_translateCharUTF8(STRING_ELT(x, num));
size_t str_len = strlen(xx);
char* str = (char*)malloc(str_len + 1);
size_t i = 0, start = 0;
bool new_line = false;
/* 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;
}
new_line = true;
}
size_t indent = 0;
/* Maximum size of size_t */
size_t min_indent = (size_t)-1;
/* find minimum indent */
while (i < str_len) {
if (xx[i] == '\n') {
new_line = true;
} else if (new_line) {
if (xx[i] == ' ' || xx[i] == '\t') {
++indent;
} else {
if (indent < min_indent) {
min_indent = indent;
}
indent = 0;
new_line = false;
}
}
++i;
}
if (new_line && indent < min_indent) {
min_indent = indent;
}
new_line = true;
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) {
if (xx[i] == '\n') {
new_line = true;
} else if (xx[i] == '\\' && i + 1 < str_len && xx[i + 1] == '\n') {
new_line = true;
i += 2;
continue;
} else if (new_line) {
if (i + min_indent < str_len && (xx[i] == ' ' || xx[i] == '\t')) {
i += min_indent;
}
new_line = false;
}
str[j++] = xx[i++];
}
str[j] = '\0';
/* Remove trailing whitespace up to the first newline */
size_t end = j;
while (j > 0) {
if (str[j] == '\n') {
end = j;
break;
} else if (str[j] == '\0' || str[j] == ' ' || str[j] == '\t') {
--j;
} else {
break;
}
}
str[end] = '\0';
SET_STRING_ELT(out, num, Rf_mkCharCE(str, CE_UTF8));
free(str);
}
UNPROTECT(1);
return out;
}
glue/src/init.c 0000644 0001762 0000144 00000001013 13175423153 013103 0 ustar ligges users #include
#include
#include
#include // for NULL
/* .Call calls */
extern SEXP glue_(SEXP, SEXP);
extern SEXP trim_(SEXP);
static const R_CallMethodDef CallEntries[] = {{"glue_", (DL_FUNC)&glue_, 4},
{"trim_", (DL_FUNC)&trim_, 1},
{NULL, NULL, 0}};
void R_init_glue(DllInfo *dll) {
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
R_useDynamicSymbols(dll, FALSE);
}
glue/src/glue.c 0000644 0001762 0000144 00000010004 13175423153 013074 0 ustar ligges users #include "Rinternals.h"
#include
#include
SEXP set(SEXP x, int i, SEXP val) {
size_t len = Rf_length(x);
if (i >= len) {
// Gives us the growth sequence 3, 5, 9, 17, ...
// This works well because for the glue case the final number of elements
// will always be odd, and for common cases is 3 or 5.
len = (len * 2) - 1;
x = Rf_lengthgets(x, len);
}
SET_VECTOR_ELT(x, i, val);
return x;
}
SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg) {
typedef enum {
text,
escape,
single_quote,
double_quote,
backtick,
delim,
comment
} states;
const char* xx = Rf_translateCharUTF8(STRING_ELT(x, 0));
size_t str_len = strlen(xx);
char* str = (char*)malloc(str_len + 1);
const char* open = CHAR(STRING_ELT(open_arg, 0));
size_t open_len = strlen(open);
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);
size_t j = 0;
size_t k = 0;
int delim_level = 0;
size_t start = 0;
states state = text;
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;
}
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;
}
break;
}
case double_quote: {
if (xx[i] == '\\') {
prev_state = double_quote;
state = escape;
} else if (xx[i] == '\"') {
state = delim;
}
break;
}
case backtick: {
if (xx[i] == '\\') {
prev_state = backtick;
state = escape;
} else if (xx[i] == '`') {
state = delim;
}
break;
}
case comment: {
if (xx[i] == '\n') {
state = delim;
}
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;
}
};
}
str[j] = '\0';
REPROTECT(out = Rf_lengthgets(out, k + 1), out_idx);
SET_VECTOR_ELT(out, k, Rf_ScalarString(Rf_mkCharLenCE(str, j, CE_UTF8)));
if (state == delim) {
Rf_error("Expecting '%s'", close);
}
free(str);
UNPROTECT(1);
return out;
}
glue/NAMESPACE 0000644 0001762 0000144 00000000670 13167212575 012441 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(as.character,glue)
S3method(as_glue,character)
S3method(as_glue,default)
S3method(as_glue,glue)
S3method(print,glue)
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_)
glue/.aspell/ 0000755 0001762 0000144 00000000000 13175155245 012554 5 ustar ligges users glue/.aspell/defaults.R 0000644 0001762 0000144 00000000231 13175155156 014503 0 ustar ligges users Rd_files <- vignettes <- R_files <- description <-
list(encoding = "UTF-8",
language = "en",
dictionaries = c("en_stats", "glue"))
glue/.aspell/glue.rds 0000644 0001762 0000144 00000000070 13175155245 014217 0 ustar ligges users b```b`fab`b2Hs'e |]c( glue/NEWS.md 0000644 0001762 0000144 00000002712 13174711203 012305 0 ustar ligges users # 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.
# glue 1.1.0
* Fix for PROTECT errors when resizing output strings.
* `glue()` always returns 'UTF-8' strings, converting inputs if in other
encodings if needed.
* `to()` and `to_data()` have been removed.
* `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).
# glue 0.0.0.9000
* Fix `glue()` to admit `.` as an embedded expression in a string (#15, @egnha).
* Added a `NEWS.md` file to track changes to the package.
glue/R/ 0000755 0001762 0000144 00000000000 13174371354 011417 5 ustar ligges users glue/R/utils.R 0000644 0001762 0000144 00000002461 13174370566 012711 0 ustar ligges users has_names <- function(x) {
nms <- names(x)
if (is.null(nms)) {
rep(FALSE, length(x))
} else {
!(is.na(nms) | nms == "")
}
}
assign_args <- function(args, envir) {
res <- vector("list", length(args))
nms <- names(args)
for (i in seq_along(args)) {
assign(nms[[i]], eval(args[[i]], envir), envir = envir)
}
}
# From tibble::recycle_columns
recycle_columns <- function (x) {
if (length(x) == 0) {
return(x)
}
lengths <- vapply(x, NROW, integer(1))
if (any(lengths) == 0) {
return(character())
}
max <- max(lengths)
bad_len <- lengths != 1L & lengths != max
if (any(bad_len)) {
stop(call. = FALSE,
ngettext(max,
"Variables must be length 1",
paste0("Variables must be length 1 or ", max), domain = NA))
}
short <- lengths == 1
if (max != 1L && any(short)) {
x[short] <- lapply(x[short], rep, max)
}
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))
}
glue/R/quoting.R 0000644 0001762 0000144 00000001047 13167212575 013233 0 ustar ligges users #' Quoting operators
#'
#' These functions make it easy to quote each individual element and are useful
#' in conjunction with `collapse()`.
#' @param x A character to quote.
#' @name quoting
#' @export
#' @examples
#' x <- 1:5
#' glue('Values of x: {collapse(backtick(x), sep = ", ", last = " and ")}')
single_quote <- function(x) {
encodeString(x, quote = "'")
}
#' @rdname quoting
#' @export
double_quote <- function(x) {
encodeString(x, quote = '"')
}
#' @rdname quoting
#' @export
backtick <- function(x) {
encodeString(x, quote = "`")
}
glue/R/transformer.R 0000644 0001762 0000144 00000001243 13174365721 014105 0 ustar ligges users #' 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
glue/R/glue.R 0000644 0001762 0000144 00000016313 13174371354 012502 0 ustar ligges users #' Format and interpolate a string
#'
#' Expressions enclosed by braces will be evaluated as R code. Single braces
#' can be inserted by doubling them.
#' @param .x \[`listish`]\cr An environment, list or data frame used to lookup values.
#' @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.
#' @param .open \[`character(1)`: \sQuote{\\\{}]\cr The opening delimiter. Doubling the
#' full delimiter escapes it.
#' @param .close \[`character(1)`: \sQuote{\\\}}]\cr The closing delimiter. Doubling the
#' 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 and
#' upon which this is based.
#' @examples
#' name <- "Fred"
#' age <- 50
#' anniversary <- as.Date("1991-10-12")
#' glue('My name is {name},',
#' 'my age next year is {age + 1},',
#' 'my anniversary is {format(anniversary, "%A, %B %d, %Y")}.')
#'
#' # single braces can be inserted by doubling them
#' glue("My name is {name}, not {{name}}.")
#'
#' # Named arguments can also be supplied
#' glue('My name is {name},',
#' ' my age next year is {age + 1},',
#' ' my anniversary is {format(anniversary, "%A, %B %d, %Y")}.',
#' name = "Joe",
#' age = 40,
#' anniversary = as.Date("2001-10-12"))
#'
#' # `glue_data()` is useful in magrittr pipes
#' library(magrittr)
#' mtcars %>% glue_data("{rownames(.)} has {hp} hp")
#'
#' # Alternative delimiters can also be used if needed
#' one <- "1"
#' glue("The value of $e^{2\\pi i}$ is $<>$.", .open = "<<", .close = ">>")
#' @useDynLib glue glue_
#' @name glue
#' @export
glue_data <- function(.x, ..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = "NA", .transformer = identity_transformer) {
# Perform all evaluations in a temporary environment
if (is.null(.x)) {
env <- new.env(parent = .envir)
} else if (is.environment(.x)) {
env <- new.env(parent = .x)
} else {
env <- list2env(.x, parent = .envir)
}
# Capture unevaluated arguments
dots <- eval(substitute(alist(...)))
named <- has_names(dots)
# Evaluate named arguments, add results to environment
assign_args(dots[named], env)
# Concatenate unnamed arguments together
unnamed_args <- lapply(which(!named), function(x) eval(call("force", as.symbol(paste0("..", x)))))
lengths <- lengths(unnamed_args)
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, 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)
}
#' @export
#' @rdname glue
glue <- function(..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}") {
glue_data(.x = NULL, ..., .sep = .sep, .envir = .envir, .open = .open, .close = .close)
}
#' Collapse a character vector
#'
#' Collapses a character vector of any length into a length 1 vector.
#' @param x The character vector to collapse.
#' @param width The maximum string width before truncating with `...`.
#' @param last String used to separate the last two items if `x` has at least
#' 2 items.
#' @inheritParams base::paste
#' @examples
#' collapse(glue("{1:10}"))
#'
#' # Wide values can be truncated
#' collapse(glue("{1:10}"), width = 5)
#'
#' collapse(1:4, ",", last = " and ")
#' #> 1, 2, 3 and 4
#' @export
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(paste0(res, last, x[length(x)]), width = width))
}
x <- paste0(x, collapse = sep)
if (width < Inf) {
x_width <- nchar(x, "width")
too_wide <- x_width > width
if (too_wide) {
x <- paste0(substr(x, 1, width - 3), "...")
}
}
as_glue(x)
}
#' Trim a character vector
#'
#' 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
#' Can have multiple lines
#' with additional indention preserved
#' ")
#'
#' glue("
#' \\ntrailing or leading newlines can be added explicitly\\n
#' ")
#'
#' glue("
#' A formatted string \\
#' can also be on a \\
#' single line
#' ")
#' @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)
}
#' Coerce object to glue
#' @param x object to be coerced.
#' @param ... further arguments passed to methods.
#' @export
as_glue <- function(x, ...) {
UseMethod("as_glue")
}
#' @export
as_glue.default <- function(x, ...) {
as_glue(as.character(x))
}
#' @export
as_glue.glue <- function(x, ...) {
x
}
#' @export
as_glue.character <- function(x, ...) {
class(x) <- c("glue", "character")
x
}
#' @export
as.character.glue <- function(x, ...) {
unclass(x)
}
#' @importFrom methods setOldClass
setOldClass(c("glue", "character"))
glue/R/sql.R 0000644 0001762 0000144 00000007546 13173717102 012347 0 ustar ligges users #' 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
}
}
glue/vignettes/ 0000755 0001762 0000144 00000000000 13175423153 013222 5 ustar ligges users glue/vignettes/speed.Rmd 0000644 0001762 0000144 00000007034 13174710706 014774 0 ustar ligges users ---
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.
glue/vignettes/transformers.Rmd 0000644 0001762 0000144 00000007600 13174372677 016433 0 ustar ligges users ---
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}")))
```
glue/README.md 0000644 0001762 0000144 00000013771 13175155755 012514 0 ustar ligges users
glue
====
[](https://cran.r-project.org/package=glue) [](https://travis-ci.org/tidyverse/glue) [](https://codecov.io/github/tidyverse/glue?branch=master) [](https://ci.appveyor.com/project/tidyverse/glue)
Glue strings to data in R. Small, fast, dependency free interpreted string literals.
Installation
------------
``` r
# install.packages("devtools")
devtools::install_github("tidyverse/glue")
```
Usage
-----
##### Long strings are broken by line and concatenated together.
``` r
library(glue)
name <- "Fred"
age <- 50
anniversary <- as.Date("1991-10-12")
glue('My name is {name},',
' my age next year is {age + 1},',
' my anniversary is {format(anniversary, "%A, %B %d, %Y")}.')
#> My name is Fred, my age next year is 51, my anniversary is Saturday, October 12, 1991.
```
##### Named arguments are used to assign temporary variables.
``` r
glue('My name is {name},',
' my age next year is {age + 1},',
' my anniversary is {format(anniversary, "%A, %B %d, %Y")}.',
name = "Joe",
age = 40,
anniversary = as.Date("2001-10-12"))
#> My name is Joe, my age next year is 41, my anniversary is Friday, October 12, 2001.
```
##### `glue_data()` is useful with [magrittr](https://cran.r-project.org/package=magrittr) pipes.
``` r
`%>%` <- magrittr::`%>%`
head(mtcars) %>% glue_data("{rownames(.)} has {hp} hp")
#> Mazda RX4 has 110 hp
#> Mazda RX4 Wag has 110 hp
#> Datsun 710 has 93 hp
#> Hornet 4 Drive has 110 hp
#> Hornet Sportabout has 175 hp
#> Valiant has 105 hp
```
##### Leading whitespace and blank lines from the first and last lines are automatically trimmed.
This lets you indent the strings naturally in code.
``` r
glue("
A formatted string
Can have multiple lines
with additional indention preserved
")
#> A formatted string
#> Can have multiple lines
#> with additional indention preserved
```
##### An additional newline can be used if you want a leading or trailing newline.
``` r
glue("
leading or trailing newlines can be added explicitly
")
#>
#> leading or trailing newlines can be added explicitly
```
##### `\\` at the end of a line continues it without a new line.
``` r
glue("
A formatted string \\
can also be on a \\
single line
")
#> A formatted string can also be on a single line
```
##### A literal brace is inserted by using doubled braces.
``` r
name <- "Fred"
glue("My name is {name}, not {{name}}.")
#> My name is Fred, not {name}.
```
##### Alternative delimiters can be specified with `.open` and `.close`.
``` r
one <- "1"
glue("The value of $e^{2\\pi i}$ is $<>$.", .open = "<<", .close = ">>")
#> The value of $e^{2\pi i}$ is $1$.
```
##### All valid R code works in expressions, including braces and escaping.
Backslashes do need to be doubled just like in all R strings.
``` r
`foo}\`` <- "foo"
glue("{
{
'}\\'' # { and } in comments, single quotes
\"}\\\"\" # or double quotes are ignored
`foo}\\`` # as are { in backticks
}
}")
#> 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)
#> 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)
#> 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)
#> SELECT * FROM `iris` WHERE sepal_length IN (1)
glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})",
vals = 1:5, .con = con)
#> 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)
#> SELECT * FROM `iris` WHERE species IN ('setosa')
glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})",
vals = c("setosa", "versicolor"), .con = con)
#> 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](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)
glue/MD5 0000644 0001762 0000144 00000003371 13175432051 011523 0 ustar ligges users 3664b0802a3d612d6ae33c4f7893735b *DESCRIPTION
e2965db868cda3b9ce7b138d8ca0e6bc *LICENSE
ae349adef7e0739d3386fcc0c52480de *NAMESPACE
c47e244b4a12c4c56dd9aaa21b2921b6 *NEWS.md
e25da04b994548eac701fca4d2d9bb46 *R/glue.R
f25d8ed7f568473df44c353211f35c9d *R/quoting.R
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
e39d219a644c1562a928d3ec7d3ec4f7 *man/evaluate.Rd
ea676c946f7177fc2c9cff93099c9af1 *man/glue.Rd
fcc55814a60c9f1c290e1c0a608c3305 *man/glue_sql.Rd
5665d168b1fb64b49e96dfd9302184d9 *man/quoting.Rd
4d9003660e95938f16e32c0ccf290507 *man/trim.Rd
3be79898495ab85253552b1a1796b73b *src/glue.c
57c4e91a5ecf31acbbc061d6650584bb *src/init.c
b4b59da64bd5a1062aa1e7638ad28921 *src/trim.c
2b2d5c82e65ffac3ce2300a7ba32fa68 *tests/testthat.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
glue/build/ 0000755 0001762 0000144 00000000000 13175423153 012311 5 ustar ligges users glue/build/vignette.rds 0000644 0001762 0000144 00000000340 13175423153 014645 0 ustar ligges users uM0˟QS6n!m# qZCI\BLb&1- and Docstrings
and Julia's Triple-Quoted String Literals
.
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
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-10-29 19:05:15 UTC; jhester
Author: Jim Hester [aut, cre]
Maintainer: Jim Hester
Repository: CRAN
Date/Publication: 2017-10-29 20:03:53 UTC
glue/man/ 0000755 0001762 0000144 00000000000 13173717102 011763 5 ustar ligges users glue/man/as_glue.Rd 0000644 0001762 0000144 00000000462 13167212575 013702 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/glue.R
\name{as_glue}
\alias{as_glue}
\title{Coerce object to glue}
\usage{
as_glue(x, ...)
}
\arguments{
\item{x}{object to be coerced.}
\item{...}{further arguments passed to methods.}
}
\description{
Coerce object to glue
}
glue/man/quoting.Rd 0000644 0001762 0000144 00000001025 13167212575 013745 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/quoting.R
\name{quoting}
\alias{quoting}
\alias{single_quote}
\alias{double_quote}
\alias{backtick}
\title{Quoting operators}
\usage{
single_quote(x)
double_quote(x)
backtick(x)
}
\arguments{
\item{x}{A character to quote.}
}
\description{
These functions make it easy to quote each individual element and are useful
in conjunction with \code{collapse()}.
}
\examples{
x <- 1:5
glue('Values of x: {collapse(backtick(x), sep = ", ", last = " and ")}')
}
glue/man/evaluate.Rd 0000644 0001762 0000144 00000001352 13174112454 014061 0 ustar ligges users % 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.
}
glue/man/glue.Rd 0000644 0001762 0000144 00000005335 13174373143 013220 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/glue.R
\name{glue}
\alias{glue}
\alias{glue_data}
\alias{glue}
\title{Format and interpolate a string}
\usage{
glue_data(.x, ..., .sep = "", .envir = parent.frame(), .open = "{",
.close = "}", .na = "NA", .transformer = identity_transformer)
glue(..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}")
}
\arguments{
\item{.x}{[\code{listish}]\cr An environment, list or data frame used to lookup values.}
\item{...}{[\code{expressions}]\cr Expressions string(s) to format, multiple inputs are concatenated together before formatting.}
\item{.sep}{[\code{character(1)}: \sQuote{""}]\cr Separator used to separate elements.}
\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{.open}{[\code{character(1)}: \sQuote{\{}]\cr The opening delimiter. Doubling the
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
can be inserted by doubling them.
}
\examples{
name <- "Fred"
age <- 50
anniversary <- as.Date("1991-10-12")
glue('My name is {name},',
'my age next year is {age + 1},',
'my anniversary is {format(anniversary, "\%A, \%B \%d, \%Y")}.')
# single braces can be inserted by doubling them
glue("My name is {name}, not {{name}}.")
# Named arguments can also be supplied
glue('My name is {name},',
' my age next year is {age + 1},',
' my anniversary is {format(anniversary, "\%A, \%B \%d, \%Y")}.',
name = "Joe",
age = 40,
anniversary = as.Date("2001-10-12"))
# `glue_data()` is useful in magrittr pipes
library(magrittr)
mtcars \%>\% glue_data("{rownames(.)} has {hp} hp")
# Alternative delimiters can also be used if needed
one <- "1"
glue("The value of $e^{2\\\\pi i}$ is $<>$.", .open = "<<", .close = ">>")
}
\seealso{
\url{https://www.python.org/dev/peps/pep-0498/} and
\url{https://www.python.org/dev/peps/pep-0257} upon which this is based.
}
glue/man/trim.Rd 0000644 0001762 0000144 00000001773 13167212575 013244 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/glue.R
\name{trim}
\alias{trim}
\title{Trim a character vector}
\usage{
trim(x)
}
\arguments{
\item{x}{A character vector to trim.}
}
\description{
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.
\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
to the minimum indentation of all non-blank lines after the first.
\item Lines can be continued across newlines by using \code{\\}.
}
}
\examples{
glue("
A formatted string
Can have multiple lines
with additional indention preserved
")
glue("
\\\\ntrailing or leading newlines can be added explicitly\\\\n
")
glue("
A formatted string \\\\
can also be on a \\\\
single line
")
}
glue/man/collapse.Rd 0000644 0001762 0000144 00000001401 13167212575 014057 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/glue.R
\name{collapse}
\alias{collapse}
\title{Collapse a character vector}
\usage{
collapse(x, sep = "", width = Inf, last = "")
}
\arguments{
\item{x}{The character vector to collapse.}
\item{sep}{a character string to separate the terms. Not
\code{\link{NA_character_}}.}
\item{width}{The maximum string width before truncating with \code{...}.}
\item{last}{String used to separate the last two items if \code{x} has at least
2 items.}
}
\description{
Collapses a character vector of any length into a length 1 vector.
}
\examples{
collapse(glue("{1:10}"))
# Wide values can be truncated
collapse(glue("{1:10}"), width = 5)
collapse(1:4, ",", last = " and ")
#> 1, 2, 3 and 4
}
glue/man/glue_sql.Rd 0000644 0001762 0000144 00000006772 13167212575 014110 0 ustar ligges users % 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)
}
glue/LICENSE 0000644 0001762 0000144 00000000050 13027304473 012211 0 ustar ligges users YEAR: 2016
COPYRIGHT HOLDER: Jim Hester