>$.", .open = "<<", .close = ">>")
#' @useDynLib glue glue_
#' @name glue
#' @export
glue_data <- function(.x, ..., .sep = "", .envir = parent.frame(),
.open = "{", .close = "}", .na = "NA", .null = character(),
.comment = "#", .literal = FALSE, .transformer = identity_transformer, .trim = TRUE) {
.envir <- .envir %||% emptyenv()
# Perform all evaluations in a temporary environment
if (is.null(.x)) {
parent_env <- .envir
} else if (is.environment(.x)) {
parent_env <- .x
} else {
parent_env <- list2env(as.list(.x), parent = .envir)
}
# Capture unevaluated arguments
dots <- eval(substitute(alist(...)))
named <- has_names(dots)
# Evaluate named arguments, add results to environment
env <- bind_args(dots[named], parent_env)
# Concatenate unnamed arguments together
unnamed_args <- lapply(
which(!named),
function(x) {
# Any evaluation to `NULL` is replaced with `.null`:
# - If `.null == character()` then if any output's length is 0 the
# whole output should be forced to be `character(0)`.
# - If `.null == NULL` then it is allowed and any such argument will be
# silently dropped.
# - In other cases output is treated as it was evaluated to `.null`.
eval(call("force", as.symbol(paste0("..", x)))) %||% .null
}
)
unnamed_args <- drop_null(unnamed_args)
if (length(unnamed_args) == 0) {
# This is equivalent to `paste0(NULL)`
return(as_glue(character(0)))
}
lengths <- lengths(unnamed_args)
if (any(lengths == 0)) {
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)
if (isTRUE(.trim)) {
unnamed_args <- trim(unnamed_args)
}
f <- function(expr){
eval_func <- .transformer(expr, env) %||% .null
# crayon functions *can* be used, so we use tryCatch()
# to give as.character() a chance to work
tryCatch(
# Output can be `NULL` only if `.null` is `NULL`. Then it should be
# returned as is, because `as.character(NULL)` is `character()`.
if (is.null(eval_func)) NULL else as.character(eval_func),
error = function(e) {
# if eval_func is a function, provide informative error-message
if (is.function(eval_func)) {
message <- paste0(
"glue cannot interpolate functions into strings.\n",
"* object '",
expr,
"' is a function."
)
stop(message, call. = FALSE)
}
# default stop
stop(e)
}
)
}
# Parse any glue strings
res <- .Call(glue_, unnamed_args, f, .open, .close, .comment, .literal)
res <- drop_null(res)
if (any(lengths(res) == 0)) {
return(as_glue(character(0)))
}
if (!is.null(.na)) {
res[] <- lapply(res, function(x) replace(x, is.na(x), .na))
} else {
na_rows <- na_rows(res)
}
res <- do.call(paste0, recycle_columns(res))
if (is.null(.na)) {
res <- replace(res, na_rows, NA)
}
as_glue(res)
}
#' @export
#' @rdname glue
glue <- function(..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = "NA", .null = character(), .comment = "#", .literal = FALSE, .transformer = identity_transformer, .trim = TRUE) {
glue_data(.x = NULL, ..., .sep = .sep, .envir = .envir, .open = .open, .close = .close, .na = .na, .null = .null, .comment = .comment, .literal = .literal, .transformer = .transformer, .trim = .trim)
}
#' Collapse a character vector
#'
#' `glue_collapse()` collapses a character vector of any length into a length 1 vector.
#' `glue_sql_collapse()` does the same but returns a `[DBI::SQL()]`
#' object rather than a glue object.
#'
#' @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
#' @returns Always returns a length-1 glue object, as created by [as_glue()].
#' @examples
#' glue_collapse(glue("{1:10}"))
#'
#' # Wide values can be truncated
#' glue_collapse(glue("{1:10}"), width = 5)
#'
#' glue_collapse(1:4, ", ", last = " and ")
#' @export
glue_collapse <- function(x, sep = "", width = Inf, last = "") {
if (length(x) == 0) {
return(as_glue(""))
}
if (any(is.na(x))) {
return(as_glue(NA_character_))
}
if (nzchar(last) && length(x) > 1) {
res <- glue_collapse(x[seq(1, length(x) - 1)], sep = sep, width = Inf)
return(glue_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.
#' @returns A character vector.
#' @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) any(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)])
if (length(x) > 0) {
cat(x, ..., sep = sep)
}
invisible(x)
}
#' Coerce object to glue
#'
#' A glue object is a character vector with S3 class `"glue"`. The `"glue"`
#' class implements a print method that shows the literal contents (rather than
#' the string implementation) and a `+` method, so that you can concatenate with
#' the addition operator.
#'
#' @param x object to be coerced.
#' @param ... further arguments passed to methods.
#' @returns A character vector with S3 class `"glue"`.
#' @export
#' @examples
#' x <- as_glue(c("abc", "\"\\\\", "\n"))
#' x
#'
#' x <- 1
#' y <- 3
#' glue("x + y") + " = {x + y}"
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")
enc2utf8(x)
}
#' @export
as.character.glue <- function(x, ...) {
unclass(x)
}
#' @export
`[.glue` <- function(x, i, ...) {
as_glue(NextMethod())
}
#' @export
`[[.glue` <- function(x, i, ...) {
as_glue(NextMethod())
}
#' @export
`+.glue` <- function(e1, e2) {
if (!is.null(e1) && !is.character(e1)) {
stop("LHS must be a character vector.")
}
if (!is.null(e2) && !is.character(e2)) {
stop("RHS must be a character vector.")
}
glue_data(
"{e1}{e2}",
.x = list(e1 = e1, e2 = e2),
.envir = parent.frame()
)
}
#' @importFrom methods setOldClass
setOldClass(c("glue", "character"))
#' Deprecated Functions
#'
#' These functions are Deprecated in this release of glue, they will be removed
#' in a future version.
#' @name glue-deprecated
#' @keywords internal
NULL
glue/R/safe.R 0000644 0001762 0000144 00000002131 14503407331 012445 0 ustar ligges users #' Safely interpolate strings
#'
#' `glue_safe()` and `glue_data_safe()` differ from [glue()] and [glue_data()]
#' in that the safe versions only look up symbols from an environment using
#' [get()]. They do not execute any R code. This makes them suitable for use
#' with untrusted input, such as inputs in a Shiny application, where using the
#' normal functions would allow an attacker to execute arbitrary code.
#' @inheritParams glue
#' @inherit glue return
#' @export
#' @examples
#' "1 + 1" <- 5
#' # glue actually executes the code
#' glue("{1 + 1}")
#'
#' # glue_safe just looks up the value
#' glue_safe("{1 + 1}")
#'
#' rm("1 + 1")
glue_safe <- function(..., .envir = parent.frame()) {
glue(..., .envir = .envir, .transformer = get_transformer)
}
#' @rdname glue_safe
#' @export
glue_data_safe <- function(.x, ..., .envir = parent.frame()) {
glue_data(.x, ..., .envir = .envir, .transformer = get_transformer)
}
get_transformer <- function(text, envir) {
if (!exists(text, envir = envir)) {
stop("object '", text, "' not found", call. = FALSE)
} else {
get(text, envir = envir)
}
}
glue/R/transformer.R 0000644 0001762 0000144 00000001662 14531745332 014110 0 ustar ligges users #' Parse and Evaluate R code
#'
#' This is a simple wrapper around `eval(parse())`, used as the default
#' transformer.
#' @param text Text (typically) R code to parse and evaluate.
#' @param envir environment to evaluate the code in
#' @seealso `vignette("transformers", "glue")` for documentation on creating
#' custom glue transformers and some common use cases.
#' @export
identity_transformer <- function(text, envir = parent.frame()) {
with_glue_error(
expr <- parse(text = text, keep.source = FALSE),
"Failed to parse glue component"
)
with_glue_error(
eval(expr, envir),
paste0("Failed to evaluate glue component {", text, "}")
)
}
with_glue_error <- function(expr, message) {
if (!requireNamespace("rlang", quietly = TRUE)) {
return(expr)
}
withCallingHandlers(
expr,
error = function(cnd) {
rlang::abort(
message,
parent = cnd,
call = NULL
)
}
)
}
glue/R/sql.R 0000644 0001762 0000144 00000017444 14541066114 012345 0 ustar ligges users #' Interpolate strings with SQL escaping
#'
#' @description
#' 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_data_sql()` are analogs to [glue()] and [glue_data()] which handle the
#' SQL quoting. `glue_sql_collapse()` can be used to collapse [DBI::SQL()] objects.
#'
#' They automatically quote character results, quote identifiers if the glue
#' expression is surrounded by backticks '\verb{`}' and do not quote
#' non-characters such as numbers. If numeric data is stored in a character
#' column (which should be quoted) pass the data to `glue_sql()` as a
#' character.
#'
#' Returning the result with [DBI::SQL()] will suppress quoting if desired for
#' a given value.
#'
#' Note [parameterized queries](https://solutions.posit.co/connections/db/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
#' @seealso [glue_sql_collapse()] to collapse [DBI::SQL()] objects.
#' @param .con \[`DBIConnection`]: A DBI connection object obtained from
#' [DBI::dbConnect()].
#' @param .na \[`character(1)`: `DBI::SQL("NULL")`]\cr Value to replace
#' `NA` values with. If `NULL` missing values are propagated, that is an `NA`
#' result will cause `NA` output. Otherwise the value is replaced by the
#' value of `.na`.
#' @return A [DBI::SQL()] object with the given query.
#' @examplesIf requireNamespace("DBI", quietly = TRUE) && requireNamespace("RSQLite", quietly = TRUE)
#' con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
#' iris2 <- iris
#' colnames(iris2) <- gsub("[.]", "_", tolower(colnames(iris)))
#' DBI::dbWriteTable(con, "iris", iris2)
#' 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)
#'
#' # If sepal_length is store on the database as a character explicitly convert
#' # the data to character to quote appropriately.
#' glue_sql("
#' SELECT {`var`}
#' FROM {`tbl`}
#' WHERE {`tbl`}.sepal_length > {as.character(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)
#'
#' # If you need to reference variables from multiple tables use `DBI::Id()`.
#' # Here we create a new table of nicknames, join the two tables together and
#' # select columns from both tables. Using `DBI::Id()` and the special
#' # `glue_sql()` syntax ensures all the table and column identifiers are quoted
#' # appropriately.
#'
#' iris_db <- "iris"
#' nicknames_db <- "nicknames"
#'
#' nicknames <- data.frame(
#' species = c("setosa", "versicolor", "virginica"),
#' nickname = c("Beachhead Iris", "Harlequin Blueflag", "Virginia Iris"),
#' stringsAsFactors = FALSE
#' )
#'
#' DBI::dbWriteTable(con, nicknames_db, nicknames)
#'
#' cols <- list(
#' DBI::Id(iris_db, "sepal_length"),
#' DBI::Id(iris_db, "sepal_width"),
#' DBI::Id(nicknames_db, "nickname")
#' )
#'
#' iris_species <- DBI::Id(iris_db, "species")
#' nicknames_species <- DBI::Id(nicknames_db, "species")
#'
#' query <- glue_sql("
#' SELECT {`cols`*}
#' FROM {`iris_db`}
#' JOIN {`nicknames_db`}
#' ON {`iris_species`}={`nicknames_species`}",
#' .con = con
#' )
#' query
#'
#' DBI::dbGetQuery(con, query, n = 5)
#'
#' DBI::dbDisconnect(con)
#' @export
glue_sql <- function(...,
.con,
.sep = "",
.envir = parent.frame(),
.open = "{",
.close = "}",
.na = DBI::SQL("NULL"),
.null = character(),
.comment = "#",
.literal = FALSE,
.trim = TRUE
) {
DBI::SQL(glue(
...,
.sep = .sep,
.envir = .envir,
.open = .open,
.close = .close,
.na = .na,
.null = .null,
.comment = .comment,
.literal = .literal,
.transformer = sql_quote_transformer(.con, .na),
.trim = .trim
))
}
#' @rdname glue_sql
#' @export
glue_data_sql <- function(.x,
...,
.con,
.sep = "",
.envir = parent.frame(),
.open = "{",
.close = "}",
.na = DBI::SQL("NULL"),
.null = character(),
.comment = "#",
.literal = FALSE,
.trim = TRUE) {
DBI::SQL(glue_data(
.x,
...,
.sep = .sep,
.envir = .envir,
.open = .open,
.close = .close,
.na = .na,
.null = .null,
.comment = .comment,
.literal = .literal,
.transformer = sql_quote_transformer(.con, .na),
.trim = .trim
))
}
#' @rdname glue_collapse
#' @export
glue_sql_collapse <- function(x, sep = "", width = Inf, last = "") {
DBI::SQL(glue_collapse(x, sep = sep, width = width, last = last))
}
sql_quote_transformer <- function(connection, .na) {
if (is.null(.na)) {
.na <- DBI::SQL(NA)
}
function(text, envir) {
should_collapse <- grepl("[*][[:space:]]*$", text)
if (should_collapse) {
text <- sub("[*][[:space:]]*$", "", text)
}
m <- gregexpr("^`|`$", text)
is_quoted <- any(m[[1]] != -1)
if (is_quoted) {
regmatches(text, m) <- ""
res <- identity_transformer(text, envir)
if (length(res) == 1) {
res <- DBI::dbQuoteIdentifier(conn = connection, res)
} else {
# Support lists as well
res[] <- lapply(res, DBI::dbQuoteIdentifier, conn = connection)
}
} else {
res <- identity_transformer(text, envir)
if (length(res) == 0L) {
if (should_collapse) {
return("")
} else {
return(NULL)
}
}
if (inherits(res, "SQL")) {
if (should_collapse) {
res <- glue_collapse(res, ", ")
}
return(res)
}
}
if (is.list(res)) {
res <- unlist(lapply(res, DBI::dbQuoteLiteral, conn = connection))
} else {
res <- DBI::dbQuoteLiteral(connection, res)
}
if (should_collapse) {
res <- glue_collapse(res, ", ")
}
res
}
}
glue/R/quoting.R 0000644 0001762 0000144 00000001312 14503407331 013215 0 ustar ligges users #' Quoting operators
#'
#' These functions make it easy to quote each individual element and are useful
#' in conjunction with [glue_collapse()]. These are thin wrappers around
#' [base::encodeString()].
#' @param x A character to quote.
#' @name quoting
#' @inherit base::encodeString return
#' @export
#' @examples
#' x <- 1:5
#' glue('Values of x: {glue_collapse(backtick(x), sep = ", ", last = " and ")}')
single_quote <- function(x) {
encodeString(x, quote = "'", na.encode = FALSE)
}
#' @rdname quoting
#' @export
double_quote <- function(x) {
encodeString(x, quote = '"', na.encode = FALSE)
}
#' @rdname quoting
#' @export
backtick <- function(x) {
encodeString(x, quote = "`", na.encode = FALSE)
}
glue/R/knitr.R 0000644 0001762 0000144 00000002000 14503121070 012642 0 ustar ligges users # nocov start
eng_glue <- function(options) {
glue_options <- options[names(options) %in% names(formals(glue))]
glue_options$.envir <- glue_options$.envir %||% knitr::knit_global()
out <- do.call(glue, c(list(options$code), glue_options))
knitr::engine_output(options, options$code, out)
}
eng_glue_sql <- function(options) {
glue_sql_options <- options[names(options) %in% names(formals(glue_sql))]
glue_sql_options$.con <- glue_sql_options$.con %||% options$connection
glue_sql_options$.envir <- glue_sql_options$.envir %||% knitr::knit_global()
con <- glue_sql_options$.con
if (is.character(con)) {
con <- get(con, envir = knitr::knit_global())
}
if (is.null(con)) {
stop(.call = FALSE,
"The 'connection' option (DBI connection) is required for glue_sql chunks.")
}
glue_sql_options$.con <- con
options$code <- do.call(glue_sql, c(list(paste0(options$code, collapse = "\n")), glue_sql_options))
options$engine <- "sql"
knitr::knit_engines$get("sql")(options)
}
# nocov end
glue/NEWS.md 0000644 0001762 0000144 00000017656 14541344227 012331 0 ustar ligges users # glue 1.7.0
* If rlang is installed, glue will generate more informative errors if an
interpolated expression either can't be parsed or fails to evaluate (#229).
* `+` now works in more situations, and gives errors when one side isn't a
character vector. It no longer automatically applies glue interpolation to
a non-glue input, if there is one. You'll need to do that yourself (#286).
* `glue_collapse(character())` (and hence `glue_sql_collapse(character())`) now
return `""`, so that they always return a single string (#88).
* `glue_sql()` now collapses an empty vector to `""` not `"NULL"` (#272).
* `glue_sql()` now uses `DBI::dbQuoteLiteral()` for all object types. This
should increase fidelity of escaping for different object types (#279).
* The "Speed of glue" vignette has been converted to an article, which allows
several package to be removed from `Suggests` (and re-located to
`Config/Needs/website`). The code got a light refresh, including a switch
from microbenchmark to bench and more modern use of ggplot2.
* Add `$(C_VISIBILITY)` to compiler flags to hide internal symbols from the dll (#284 @lionel-).
# glue 1.6.2
* Modify a test for better forward compatibility with R.
# glue 1.6.1
* glue now registers its custom knitr engines in a way that is more robust to namespace-loading edge cases that can arise during package installation (#254).
# glue 1.6.0
* `glue()`, `glue_data()`, `glue_col()`, and `glue_data_col()` gain a new `.literal` argument, which controls how quotes and the comment character are treated when parsing the expression string (#235). This is mostly useful when using a custom transformer.
* Trailing whitespace-only lines don't interfere with indentation (#247).
# glue 1.5.1
* Jennifer Bryan is now the maintainer.
* The existing custom language engines for knitr, `glue` and `glue_sql`, are documented in a new vignette (#71). *Detail added after release: glue now sets up registration of these engines in `.onLoad()`.*
* `glue_col()` gives special treatment to styling functions from the crayon package, e.g. `glue_col("{blue foo}")` "just works" now, even if crayon is not attached (but is installed) (#241).
* Unterminated backticks trigger the same error as unterminated single or double quotes (#237).
* `glue_sql()` collapses zero-length `DBI::SQL` object into `DBI::SQL("NULL")` (#244 @shrektan).
# glue 1.5.0
## Breaking changes
* Long deprecated function `collapse()` has been removed (#213)
## New functions and arguments
* New `glue_sql_collapse()` function to collapse inputs and return a `DBI::SQL()` object (#103).
* `glue()` gains a new `.comment` argument, to control the comment character (#193).
* `glue()` gains a new `.null` argument, to control the value to replace `NULL` values with (#217, @echasnovski).
## Bugfixes and minor changes
* `sql_quote_transformer()` is now allows whitespace after the trailing `*` (#218).
* `compare_proxy.glue()` method defined so glue objects can be compared to strings in testthat 3e without errors (#212)
* `print.glue()` no longer prints an empty newline for 0 length inputs (#214)
* Unterminated comments in glue expression now throw an error (#227, @gaborcsardi)
* Unterminated quotes in glue expressions now throw an error (#226, @gaborcsardi)
# glue 1.4.2
* `glue_safe()` gives a slightly nicer error message
* The required version of R is now 3.2 (#189)
* `glue_sql()` now collapses `DBI::SQL()` elements correctly (#192 @shrektan)
* The internal `compare()` method gains a `...` argument, for compatibility with testthat 3.0.0
# glue 1.4.1
* Internal changes for compatibility with vctrs 0.3.0 (#187).
* `glue_sql()` now replaces missing values correctly when collapsing values (#185).
* `glue_sql()` now always preserves the type of the column even in the presence of missing values (#130)
# glue 1.4.0
* `.envir = NULL` is now supported and is equivalent to passing `.envir = emptyenv()` (#140)
* New `glue_safe()` and `glue_data_safe()` functions, safer versions of
`glue()` that do not execute code, only look up values (using `get()`). These
alternatives are useful for things like shiny applications where you do not
have control of the input for your glue expressions. (#140)
* Fixed memory access issue and memory leaks found by valgrind.
# glue 1.3.2
* glue now implements vctrs methods. This ensures that vectors of glue
strings are compatible with tidyverse packages like tidyr
(r-lib/tidyselect#170, tidyverse/tidyr#773, @lionel-).
* Fix a LTO type mismatch warning (#146)
* `glue_sql()` now quotes lists of values appropriate to their type, rather
than coercing all values to characters (#153)
* `glue_data()` now implicitly coerces `.x` to a list.
* `glue()` gains the `.trim` argument, like `glue_data()`.
* `single_quote()` `double_quote()` and `backtick()` all return `NA` for `NA`
inputs (#135).
* Improve `trim()`'s handling of lines containing only indentation (#162, #163, @alandipert)
# glue 1.3.1
## Features
* `glue()` now has a `+` method to combine strings.
* `glue_sql()` now collapses zero-length vector into `DBI::SQL("NULL")` (#134 @shrektan).
## Bugfixes and minor changes
* `glue_sql()` now supports unquoting lists of Id objects.
* `glue_sql()` now quotes characters with NAs appropriately (#115).
* `glue_sql()` now quotes Dates appropriately (#98).
* A potential protection error reported by rchk was fixed.
# glue 1.3.0
## Breaking changes
* The `evaluate()` function has been removed. Changes elsewhere in glue made
the implementation trivial so it was removed for the sake of clarity.
Previous uses can be replaced by `eval(parse(text = text), envir)`.
* `collapse()` has been renamed to `glue_collapse()` to avoid namespace
collisions with `dplyr::collapse()`.
## Features
* `compare.glue()` was added, to make it easier to use glue objects in
`testthat::expect_equal()` statements.
* `glue_col()` and `glue_data_col()` functions added to display strings with
color.
## Bugfixes and minor changes
* Glue now throws an informative error message when it cannot interpolate a
function into a string (#114, @haleyjeppson & @ijlyttle).
* Glue now evaluates unnamed arguments lazily with `delayedAssign()`, so there
is no performance cost if an argument is not used. (#83, @egnha).
* Fixed a bug where names in the assigned expression of an interpolation
variable would conflict with the name of the variable itself (#89, @egnha).
* Do not drop the `glue` class when subsetting (#66).
* Fix `glue()` and `collapse()` always return UTF-8 encoded strings (#81, @dpprdan)
# 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
`vignette("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/MD5 0000644 0001762 0000144 00000005454 14547351404 011535 0 ustar ligges users e8a672dfdb5c94edf57b30272b1bcf73 *DESCRIPTION
37e6ec28ac4b70ebe41bd251c25d1c2b *LICENSE
5f7a0689117abfe9ca4956b1b044e768 *NAMESPACE
5a2a6db0d128dcfc22c9d745410b6a8b *NEWS.md
b3ae2e3c45b3ac338903fe4603e94567 *R/color.R
631cff00b52e1ea98eac1dead5843a4e *R/compat-s3-register.R
70ad6b885806696eba182090592555ae *R/glue.R
b4496d2d90fc7d40c70db0385c01d9db *R/knitr.R
b2943310b5a60be5e18701fa21b98f79 *R/quoting.R
afc3b02ea4fdc144de8a80d16946c223 *R/safe.R
fd4c32aee84f42376654112f4c9b3cc9 *R/sql.R
a86f23b5eaaa88977b16cd767d77e0f3 *R/transformer.R
bbf77a0024fee3412f09e864cccb49ca *R/utils.R
5ef3a3667cb2c2566368b6e3b9c7c0e0 *R/vctrs.R
c3c6982aa0feecfc2294eb891554536f *R/zzz.R
9d4bae64b8a59bb8e9d397c593a5d8b3 *README.md
8fdedad05ebd08e0f379d127810df3fa *build/vignette.rds
9523369b7eb6dc1cabd769ecdf851ddb *inst/doc/engines.R
691527d720a40e95c1fb335c5c36f1e7 *inst/doc/engines.Rmd
4a082717bbbbc49f62a719423917a596 *inst/doc/engines.html
60d1d75d9de750af918f793fb9cc63d9 *inst/doc/transformers.R
6468ffbb31bed10a616346ca3f9e79b7 *inst/doc/transformers.Rmd
c0af4af8b7c394bc4bf0f0a5c6b6c6d5 *inst/doc/transformers.html
6894cecea92c0ba0cf824e216b7042d2 *man/as_glue.Rd
1fbc65371dbfccd81b8863756e28e082 *man/figures/logo.png
35c0e85621f51cad1feee0b2e4e9424c *man/glue-deprecated.Rd
9149773973b653bfb4145aca92db6a65 *man/glue.Rd
9d727efe99151e63a7a3bb7079b61825 *man/glue_col.Rd
52e3a135753a411c01cfba3d927e945b *man/glue_collapse.Rd
55e863ee6f1d0e0de7b679d2f5e29e8e *man/glue_safe.Rd
b30aa471598f3c12c9d2a8abb850f8ed *man/glue_sql.Rd
b2cd06641ad3dcfbf1aaad7d2b34a488 *man/identity_transformer.Rd
39d55283753f4db4d32a0fa129f8538d *man/quoting.Rd
61e6f3ca4e89af2618cf35d28c4a81f0 *man/trim.Rd
d25d5af44b59cd40d3830b54f7a7cf7f *src/Makevars
455ddc98c78c5b6b4bd7bda409adc918 *src/glue.c
182706fd7bf7e47b2831c7ce18a85dfc *src/init.c
a7adb36e545b3379fa1ff13654f90750 *src/trim.c
2b2d5c82e65ffac3ce2300a7ba32fa68 *tests/testthat.R
01d75900d0be3642c61752e9c1cd860b *tests/testthat/_snaps/color.md
c17d51bf102ed85e7ba2b07f01e7fc4e *tests/testthat/_snaps/glue.md
3a18f5111fd12bae23d2bfcf892c8c1a *tests/testthat/_snaps/sql.md
90bca9501dcedfaf296a9a4699b576d4 *tests/testthat/_snaps/transformer.md
8ec8a5d081ce5159c0ff3d82cdd5d72a *tests/testthat/test-collapse.R
f058d991b3ad9e846c01596413ca5fe5 *tests/testthat/test-color.R
f55ea5f424fb9f71fae287038799ef11 *tests/testthat/test-glue.R
ea7ddf76c230c86181dae7fdb34426a2 *tests/testthat/test-quoting.R
4080c704a40ace6499f1bd928b920952 *tests/testthat/test-safe.R
8ed6509511e03a5ada78f0a87e461efd *tests/testthat/test-sql.R
47a958927b9f812e3d4e5b84f4b82a41 *tests/testthat/test-transformer.R
b0901ca36bdbc54cb3472eb46f6f1f4a *tests/testthat/test-trim.R
f76fda874c02b458da45e20c2d4163c3 *tests/testthat/test-vctrs.R
691527d720a40e95c1fb335c5c36f1e7 *vignettes/engines.Rmd
6468ffbb31bed10a616346ca3f9e79b7 *vignettes/transformers.Rmd
glue/inst/ 0000755 0001762 0000144 00000000000 14547017210 012164 5 ustar ligges users glue/inst/doc/ 0000755 0001762 0000144 00000000000 14547017210 012731 5 ustar ligges users glue/inst/doc/engines.R 0000644 0001762 0000144 00000000716 14547017207 014516 0 ustar ligges users ## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(echo = TRUE)
library(glue)
## -----------------------------------------------------------------------------
con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
mtcars$model <- rownames(mtcars)
DBI::dbWriteTable(con, "mtcars", mtcars)
## -----------------------------------------------------------------------------
var <- "mpg"
tbl <- "mtcars"
num <- 150
glue/inst/doc/transformers.html 0000644 0001762 0000144 00000101077 14547017210 016352 0 ustar ligges users
Transformers
Transformers
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 text
and envir, where text is the unparsed string
inside the glue block and envir is the execution
environment. Most transformers will then call
eval(parse(text = text, keep.source = FALSE), envir) which
parses and evaluates the code.
You can then supply the transformer function to glue with the
.transformer argument. In this way users can manipulate the
text 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 example 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.
glue/inst/doc/transformers.Rmd 0000644 0001762 0000144 00000015002 14503356472 016130 0 ustar ligges users ---
title: "Transformers"
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 `text` and `envir`, where
`text` is the unparsed string inside the glue block and `envir` is the
execution environment. Most transformers will then call `eval(parse(text = text,
keep.source = FALSE), envir)` which parses and evaluates the code.
You can then supply the transformer function to glue with the `.transformer`
argument. In this way users can manipulate the text 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 example 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}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
```
```{r}
library(glue)
```
### collapse transformer
A transformer which automatically collapses any glue block ending with `*`.
```{r}
collapse_transformer <- function(regex = "[*]$", ...) {
function(text, envir) {
collapse <- grepl(regex, text)
if (collapse) {
text <- sub(regex, "", text)
}
res <- identity_transformer(text, envir)
if (collapse) {
glue_collapse(res, ...)
} else {
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 "))
x <- c("one", "two")
glue("{x}: {1:5*}", .transformer = collapse_transformer(sep = ", "))
```
### Shell quoting transformer
A transformer which automatically quotes variables for use in shell commands,
e.g. via `system()` or `system2()`.
```{r}
shell_transformer <- function(type = c("sh", "csh", "cmd", "cmd2")) {
type <- match.arg(type)
function(text, envir) {
res <- identity_transformer(text, envir)
shQuote(res)
}
}
glue_sh <- function(..., .envir = parent.frame(), .type = c("sh", "csh", "cmd", "cmd2")) {
.type <- match.arg(.type)
glue(..., .envir = .envir, .transformer = shell_transformer(.type))
}
filename <- "test"
writeLines(con = filename, "hello!")
command <- glue_sh("cat {filename}")
command
system(command)
```
```{r include = FALSE}
if (file.exists("test")) {
unlink("test")
}
```
### emoji transformer
A transformer which converts the text to the equivalent emoji.
```{r, eval = require("emo")}
emoji_transformer <- function(text, envir) {
if (grepl("[*]$", text)) {
text <- sub("[*]$", "", text)
glue_collapse(ji_find(text)$emoji)
} else {
ji(text)
}
}
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(text, envir) {
m <- regexpr(":.+$", text)
if (m != -1) {
format <- substring(regmatches(text, m), 2)
regmatches(text, m) <- ""
res <- identity_transformer(text, envir)
do.call(sprintf, list(glue("%{format}"), res))
} else {
identity_transformer(text, envir)
}
}
glue_fmt <- function(..., .envir = parent.frame()) {
glue(..., .transformer = sprintf_transformer, .envir = .envir)
}
glue_fmt("π = {pi:.3f}")
```
### signif transformer
A transformer generator that represents numbers with a given number of significant digits.
This is useful if we want to represent all numbers using the same significant digits
```{r}
signif_transformer <- function(digits = 3) {
force(digits)
function(text, envir) {
x <- identity_transformer(text, envir)
if (is.numeric(x)) {
signif(x, digits = digits)
} else {
x
}
}
}
glue_signif <- function(..., .envir = parent.frame()) {
glue(..., .transformer = signif_transformer(3), .envir = .envir)
}
glue_signif("π = {pi}; 10π = {10*pi}; 100π = {100*pi}")
```
### safely transformer
A transformer that acts like `purrr::safely()`, which returns a value instead of an error.
```{r}
safely_transformer <- function(otherwise = NA) {
function(text, envir) {
tryCatch(
identity_transformer(text, 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}")))
```
### "Variables and Values" transformer
A transformer that expands input of the form `{var_name=}` into `var_name = var_value`, i.e. a shorthand for exposing variable names with their values. This is inspired by an [f-strings feature coming in Python 3.8](https://docs.python.org/3.8/whatsnew/3.8.html#f-strings-now-support-for-quick-and-easy-debugging). It's actually more general: you can use it with an expression input such as `{expr=}`.
```{r}
vv_transformer <- function(text, envir) {
regex <- "=$"
if (!grepl(regex, text)) {
return(identity_transformer(text, envir))
}
text <- sub(regex, "", text)
res <- identity_transformer(text, envir)
n <- length(res)
res <- glue_collapse(res, sep = ", ")
if (n > 1) {
res <- c("[", res, "]")
}
glue_collapse(c(text, " = ", res))
}
```
```{r}
set.seed(1234)
description <- "some random"
numbers <- sample(100, 4)
average <- mean(numbers)
sum <- sum(numbers)
glue("For {description} {numbers=}, {average=}, {sum=}.", .transformer = vv_transformer)
a <- 3
b <- 5.6
glue("{a=}\n{b=}\n{a * 9 + b * 2=}", .transformer = vv_transformer)
```
glue/inst/doc/engines.html 0000644 0001762 0000144 00000036114 14547017210 015254 0 ustar ligges users
glue custom knitr language engines
glue custom knitr language engines
Glue provides a few custom
language engines for knitr, which allows you to use glue directly in
knitr chunks.
glue engine
The first engine is the glue engine, which evaluates the
chunk contents as a glue template.
1 + 1 = {1 + 1}
## 1 + 1 = 2
Maybe the most useful use of the glue engine is to set
the knitr option results = 'asis' and output markdown or
HTML directly into the document.
```{glue, results = 'asis', echo = FALSE}
#### mtcars has **{nrow(mtcars)} rows** and _{ncol(mtcars)} columns_.
```
mtcars has 32 rows and 11 columns.
If you want to pass additional arguments into the glue call, simply
include them as chunk options.
```{glue, .open = "<<", .close = ">>", results = 'asis', echo = FALSE}
The **median waiting time** between eruptions is <<median(faithful$waiting)>>.
```
The median waiting time between eruptions is 76.
glue_sql engine
The second engine is glue_sql, which will use
glue::glue_sql() to generate a SQL query and then run the
query using the sql
engine.
First we create a new connection to an in-memory SQLite database, and
write a new table to it.
con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
mtcars$model <- rownames(mtcars)
DBI::dbWriteTable(con, "mtcars", mtcars)
Next define some variables we that we can use with glue to
interpolate.
var <- "mpg"
tbl <- "mtcars"
num <- 150
Then we can use glue_sql to construct and run a query
using those variables into that database. Note you need to
provide the connection object as a connection chunk
option.
In this example there are two type of quotes. The first is a bare
backtick, these are passed directly to the SQL engine unchanged. The
second is backticks inside of braces, which are specially interpreted to
do the proper quoting for the given SQL engine by glue. In this example
we use the sqlite engine, which uses backticks for quoting,
but you would use the same backticks inside brace syntax for postgreSQL,
and glue_sql() would automatically use double quotes for
quoting instead.
```{glue_sql, connection = con}
SELECT `model`, `hp`, {`var`}
FROM {`tbl`}
WHERE {`tbl`}.`hp` > {num}
```
SELECT `model`, `hp`, `mpg`
FROM `mtcars`
WHERE `mtcars`.`hp` > 150
Displaying records 1 - 10
| Hornet Sportabout |
175 |
18.7 |
| Duster 360 |
245 |
14.3 |
| Merc 450SE |
180 |
16.4 |
| Merc 450SL |
180 |
17.3 |
| Merc 450SLC |
180 |
15.2 |
| Cadillac Fleetwood |
205 |
10.4 |
| Lincoln Continental |
215 |
10.4 |
| Chrysler Imperial |
230 |
14.7 |
| Camaro Z28 |
245 |
13.3 |
| Pontiac Firebird |
175 |
19.2 |
glue/inst/doc/engines.Rmd 0000644 0001762 0000144 00000005646 14503356472 015050 0 ustar ligges users ---
title: "glue custom knitr language engines"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{glue custom knitr language engines}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(glue)
```
Glue provides a few [custom language engines](https://bookdown.org/yihui/rmarkdown-cookbook/custom-engine.html#custom-engine) for knitr, which allows you to use glue directly in knitr chunks.
## `glue` engine
The first engine is the `glue` engine, which evaluates the chunk contents as a glue template.
```{glue}
1 + 1 = {1 + 1}
```
Maybe the most useful use of the `glue` engine is to set the knitr option `results = 'asis'` and output markdown or HTML directly into the document.
````markdown
`r '' ````{glue, results = 'asis', echo = FALSE}
#### mtcars has **{nrow(mtcars)} rows** and _{ncol(mtcars)} columns_.
```
````
```{glue, results = 'asis', echo = FALSE}
#### mtcars has **{nrow(mtcars)} rows** and _{ncol(mtcars)} columns_.
```
If you want to pass additional arguments into the glue call, simply include them as chunk options.
````markdown
`r '' ````{glue, .open = "<<", .close = ">>", results = 'asis', echo = FALSE}
The **median waiting time** between eruptions is <>.
```
````
```{glue, .open = "<<", .close = ">>", results = 'asis', echo = FALSE}
The **median waiting time** between eruptions is <>.
```
## `glue_sql` engine
The second engine is `glue_sql`, which will use `glue::glue_sql()` to generate a SQL query and then run the query using the [sql engine](https://bookdown.org/yihui/rmarkdown/language-engines.html#sql).
First we create a new connection to an in-memory SQLite database, and write a new table to it.
```{r}
con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
mtcars$model <- rownames(mtcars)
DBI::dbWriteTable(con, "mtcars", mtcars)
```
Next define some variables we that we can use with glue to interpolate.
```{r}
var <- "mpg"
tbl <- "mtcars"
num <- 150
```
Then we can use `glue_sql` to construct and run a query using those variables into that database. *Note* you need to provide the connection object as a `connection` chunk option.
In this example there are two type of quotes. The first is a bare backtick, these are passed directly to the SQL engine unchanged.
The second is backticks inside of braces, which are specially interpreted to do the proper quoting for the given SQL engine by glue.
In this example we use the `sqlite` engine, which uses backticks for quoting, but you would use the same backticks inside brace syntax for postgreSQL, and `glue_sql()` would automatically use double quotes for quoting instead.
````markdown
`r '' ````{glue_sql, connection = con}
SELECT `model`, `hp`, {`var`}
FROM {`tbl`}
WHERE {`tbl`}.`hp` > {num}
```
````
```{glue_sql, connection = con}
SELECT `model`, `hp`, {`var`}
FROM {`tbl`}
WHERE {`tbl`}.`hp` > {num}
```
glue/inst/doc/transformers.R 0000644 0001762 0000144 00000011200 14547017210 015573 0 ustar ligges users ## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
## -----------------------------------------------------------------------------
library(glue)
## -----------------------------------------------------------------------------
collapse_transformer <- function(regex = "[*]$", ...) {
function(text, envir) {
collapse <- grepl(regex, text)
if (collapse) {
text <- sub(regex, "", text)
}
res <- identity_transformer(text, envir)
if (collapse) {
glue_collapse(res, ...)
} else {
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 "))
x <- c("one", "two")
glue("{x}: {1:5*}", .transformer = collapse_transformer(sep = ", "))
## -----------------------------------------------------------------------------
shell_transformer <- function(type = c("sh", "csh", "cmd", "cmd2")) {
type <- match.arg(type)
function(text, envir) {
res <- identity_transformer(text, envir)
shQuote(res)
}
}
glue_sh <- function(..., .envir = parent.frame(), .type = c("sh", "csh", "cmd", "cmd2")) {
.type <- match.arg(.type)
glue(..., .envir = .envir, .transformer = shell_transformer(.type))
}
filename <- "test"
writeLines(con = filename, "hello!")
command <- glue_sh("cat {filename}")
command
system(command)
## ----include = FALSE----------------------------------------------------------
if (file.exists("test")) {
unlink("test")
}
## ----eval = require("emo")----------------------------------------------------
# emoji_transformer <- function(text, envir) {
# if (grepl("[*]$", text)) {
# text <- sub("[*]$", "", text)
# glue_collapse(ji_find(text)$emoji)
# } else {
# ji(text)
# }
# }
#
# 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(text, envir) {
m <- regexpr(":.+$", text)
if (m != -1) {
format <- substring(regmatches(text, m), 2)
regmatches(text, m) <- ""
res <- identity_transformer(text, envir)
do.call(sprintf, list(glue("%{format}"), res))
} else {
identity_transformer(text, envir)
}
}
glue_fmt <- function(..., .envir = parent.frame()) {
glue(..., .transformer = sprintf_transformer, .envir = .envir)
}
glue_fmt("π = {pi:.3f}")
## -----------------------------------------------------------------------------
signif_transformer <- function(digits = 3) {
force(digits)
function(text, envir) {
x <- identity_transformer(text, envir)
if (is.numeric(x)) {
signif(x, digits = digits)
} else {
x
}
}
}
glue_signif <- function(..., .envir = parent.frame()) {
glue(..., .transformer = signif_transformer(3), .envir = .envir)
}
glue_signif("π = {pi}; 10π = {10*pi}; 100π = {100*pi}")
## -----------------------------------------------------------------------------
safely_transformer <- function(otherwise = NA) {
function(text, envir) {
tryCatch(
identity_transformer(text, 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}")))
## -----------------------------------------------------------------------------
vv_transformer <- function(text, envir) {
regex <- "=$"
if (!grepl(regex, text)) {
return(identity_transformer(text, envir))
}
text <- sub(regex, "", text)
res <- identity_transformer(text, envir)
n <- length(res)
res <- glue_collapse(res, sep = ", ")
if (n > 1) {
res <- c("[", res, "]")
}
glue_collapse(c(text, " = ", res))
}
## -----------------------------------------------------------------------------
set.seed(1234)
description <- "some random"
numbers <- sample(100, 4)
average <- mean(numbers)
sum <- sum(numbers)
glue("For {description} {numbers=}, {average=}, {sum=}.", .transformer = vv_transformer)
a <- 3
b <- 5.6
glue("{a=}\n{b=}\n{a * 9 + b * 2=}", .transformer = vv_transformer)
