glue/0000755000176200001440000000000014173114312011203 5ustar liggesusersglue/NAMESPACE0000644000176200001440000000115514172657475012451 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("+",glue) S3method("[",glue) S3method("[[",glue) 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(double_quote) export(glue) export(glue_col) export(glue_collapse) export(glue_data) export(glue_data_col) export(glue_data_safe) export(glue_data_sql) export(glue_safe) export(glue_sql) export(glue_sql_collapse) export(identity_transformer) export(single_quote) export(trim) importFrom(methods,setOldClass) useDynLib(glue,glue_) useDynLib(glue,trim_) glue/LICENSE0000644000176200001440000000005214152560265012216 0ustar liggesusersYEAR: 2021 COPYRIGHT HOLDER: glue authors glue/.aspell/0000755000176200001440000000000014152560265012552 5ustar liggesusersglue/.aspell/defaults.R0000644000176200001440000000023114152560265014500 0ustar liggesusersRd_files <- vignettes <- R_files <- description <- list(encoding = "UTF-8", language = "en", dictionaries = c("en_stats", "glue")) glue/.aspell/glue.rds0000644000176200001440000000007014152560265014215 0ustar liggesusersb```b`fab`b2Hs'e|]c(glue/README.md0000644000176200001440000002042614172661312012474 0ustar liggesusers # glue [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/glue)](https://cran.r-project.org/package=glue) [![R-CMD-check](https://github.com/tidyverse/glue/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/tidyverse/glue/actions/workflows/R-CMD-check.yaml) [![test-coverage](https://github.com/tidyverse/glue/actions/workflows/test-coverage.yaml/badge.svg)](https://github.com/tidyverse/glue/actions/workflows/test-coverage.yaml) ## Overview Glue offers interpreted string literals that are small, fast, and dependency-free. Glue does this by embedding R expressions in curly braces which are then evaluated and inserted into the argument string. ## Installation
``` r # Install released version from CRAN install.packages("glue") ```
``` r # Install development version from GitHub devtools::install_github("tidyverse/glue") ```
## Usage ##### Variables can be passed directly into strings. ``` r library(glue) name <- "Fred" glue('My name is {name}.') #> My name is Fred. ``` Note that `glue::glue()` is also made available via `stringr::str_glue()`. So if you’ve already attached stringr (or perhaps the whole tidyverse), you can access `glue()` like so: ``` r library(stringr) # or library(tidyverse) stringr_fcn <- "`stringr::str_glue()`" glue_fcn <- "`glue::glue()`" str_glue('{stringr_fcn} is essentially an alias for {glue_fcn}.') #> `stringr::str_glue()` is essentially an alias for `glue::glue()`. ``` ##### 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 ``` ##### Or within dplyr pipelines ``` r library(dplyr) head(iris) %>% mutate(description = glue("This {Species} has a petal length of {Petal.Length}")) #> Sepal.Length Sepal.Width Petal.Length Petal.Width Species #> 1 5.1 3.5 1.4 0.2 setosa #> 2 4.9 3.0 1.4 0.2 setosa #> 3 4.7 3.2 1.3 0.2 setosa #> 4 4.6 3.1 1.5 0.2 setosa #> 5 5.0 3.6 1.4 0.2 setosa #> 6 5.4 3.9 1.7 0.4 setosa #> description #> 1 This setosa has a petal length of 1.4 #> 2 This setosa has a petal length of 1.4 #> 3 This setosa has a petal length of 1.3 #> 4 This setosa has a petal length of 1.5 #> 5 This setosa has a petal length of 1.4 #> 6 This setosa has a petal length of 1.7 ``` ##### 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 conjunction 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') ``` ##### Optionally combine strings with `+` ``` r x <- 1 y <- 3 glue("x + y") + " = {x + y}" #> x + y = 4 ``` # Other implementations Some other implementations of string interpolation in R (although not using identical syntax). - [stringr::str_interp](https://stringr.tidyverse.org/reference/str_interp.html) - [R.utils::gstring](https://cran.r-project.org/package=R.utils) - [rprintf](https://cran.r-project.org/package=rprintf) String templating is closely related to string interpolation, although not exactly the same concept. Some packages implementing string templating in R include. - [whisker](https://cran.r-project.org/package=whisker) - [brew](https://cran.r-project.org/package=brew) ## Code of Conduct Please note that the glue project is released with a [Contributor Code of Conduct](https://glue.tidyverse.org/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. glue/man/0000755000176200001440000000000014172657456012002 5ustar liggesusersglue/man/glue-deprecated.Rd0000644000176200001440000000044614152560265015314 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glue.R \name{glue-deprecated} \alias{glue-deprecated} \title{Deprecated Functions} \description{ These functions are Deprecated in this release of glue, they will be removed in a future version. } \keyword{internal} glue/man/glue_safe.Rd0000644000176200001440000000305014156753073014213 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/safe.R \name{glue_safe} \alias{glue_safe} \alias{glue_data_safe} \title{Safely interpolate strings} \usage{ glue_safe(..., .envir = parent.frame()) glue_data_safe(.x, ..., .envir = parent.frame()) } \arguments{ \item{...}{[\code{expressions}]\cr Unnamed arguments are taken to be expression string(s) to format. Multiple inputs are concatenated together before formatting. Named arguments are taken to be temporary variables available for substitution.} \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. If \code{NULL} is passed, it is equivalent to \code{\link[=emptyenv]{emptyenv()}}.} \item{.x}{[\code{listish}]\cr An environment, list, or data frame used to lookup values.} } \description{ \code{glue_safe()} and \code{glue_data_safe()} differ from \code{\link[=glue]{glue()}} and \code{\link[=glue_data]{glue_data()}} in that the safe versions only look up symbols from an environment using \code{\link[=get]{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. } \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/man/identity_transformer.Rd0000644000176200001440000000111514152560265016527 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/transformer.R \name{identity_transformer} \alias{identity_transformer} \title{Parse and Evaluate R code} \usage{ identity_transformer(text, envir) } \arguments{ \item{text}{Text (typically) R code to parse and evaluate.} \item{envir}{environment to evaluate the code in} } \description{ This is a simple wrapper around \code{eval(parse())}, used as the default transformer. } \seealso{ \code{vignette("transformers", "glue")} for documentation on creating custom glue transformers and some common use cases. } glue/man/as_glue.Rd0000644000176200001440000000046214152560265013677 0ustar liggesusers% 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/glue.Rd0000644000176200001440000001111314156753073013214 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glue.R \name{glue} \alias{glue} \alias{glue_data} \title{Format and interpolate a string} \usage{ glue_data( .x, ..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = "NA", .null = character(), .comment = "#", .literal = FALSE, .transformer = identity_transformer, .trim = TRUE ) glue( ..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = "NA", .null = character(), .comment = "#", .literal = FALSE, .transformer = identity_transformer, .trim = TRUE ) } \arguments{ \item{.x}{[\code{listish}]\cr An environment, list, or data frame used to lookup values.} \item{...}{[\code{expressions}]\cr Unnamed arguments are taken to be expression string(s) to format. Multiple inputs are concatenated together before formatting. Named arguments are taken to be temporary variables available for substitution.} \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. If \code{NULL} is passed, it is equivalent to \code{\link[=emptyenv]{emptyenv()}}.} \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 \code{NA} values with. If \code{NULL} missing values are propagated, that is an \code{NA} result will cause \code{NA} output. Otherwise the value is replaced by the value of \code{.na}.} \item{.null}{[\code{character(1)}: \sQuote{character()}]\cr Value to replace NULL values with. If \code{character()} whole output is \code{character()}. If \code{NULL} all NULL values are dropped (as in \code{paste0()}). Otherwise the value is replaced by the value of \code{.null}.} \item{.comment}{[\code{character(1)}: \sQuote{#}]\cr Value to use as the comment character.} \item{.literal}{[\code{boolean(1)}: \sQuote{FALSE}]\cr Whether to treat single or double quotes, backticks, and comments as regular characters (vs. as syntactic elements), when parsing the expression string. Setting \code{.literal = TRUE} probably only makes sense in combination with a custom \code{.transformer}, as is the case with \code{glue_col()}. Regard this argument (especially, its name) as experimental.} \item{.transformer}{[\verb{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")}.} \item{.trim}{[\code{logical(1)}: \sQuote{TRUE}]\cr Whether to trim the input template with \code{\link[=trim]{trim()}} or not.} } \description{ Expressions enclosed by braces will be evaluated as R code. Long strings are broken by line and concatenated together. Leading whitespace and blank lines from the first and last lines are automatically trimmed. } \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 be used to assign temporary variables. 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()` can also be used in user defined functions intro <- function(name, profession, country){ glue("My name is {name}, a {profession}, from {country}") } intro("Shelmith", "Senior Data Analyst", "Kenya") intro("Cate", "Data Scientist", "Kenya") # `glue_data()` is useful in magrittr pipes if (require(magrittr)) { mtcars \%>\% glue_data("{rownames(.)} has {hp} hp") # Or within dplyr pipelines if (require(dplyr)) { head(iris) \%>\% mutate(description = glue("This {Species} has a petal length of {Petal.Length}")) }} # 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/quoting.Rd0000644000176200001440000000106614152560265013747 0ustar liggesusers% 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{\link[=glue_collapse]{glue_collapse()}}. } \examples{ x <- 1:5 glue('Values of x: {glue_collapse(backtick(x), sep = ", ", last = " and ")}') } glue/man/glue_collapse.Rd0000644000176200001440000000200514152560265015071 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glue.R, R/sql.R \name{glue_collapse} \alias{glue_collapse} \alias{glue_sql_collapse} \title{Collapse a character vector} \usage{ glue_collapse(x, sep = "", width = Inf, last = "") glue_sql_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[base]{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{ \code{glue_collapse()} collapses a character vector of any length into a length 1 vector. \code{glue_sql_collapse()} does the same but returns a \verb{[DBI::SQL()]} object rather than a glue object. } \examples{ glue_collapse(glue("{1:10}")) # Wide values can be truncated glue_collapse(glue("{1:10}"), width = 5) glue_collapse(1:4, ", ", last = " and ") #> 1, 2, 3 and 4 } glue/man/trim.Rd0000644000176200001440000000177014156753073013243 0ustar liggesusers% 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 \verb{\\\\}. } } \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/glue_col.Rd0000644000176200001440000000645714156753073014070 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/color.R \name{glue_col} \alias{glue_col} \alias{glue_data_col} \title{Construct strings with color} \usage{ glue_col(..., .envir = parent.frame(), .na = "NA", .literal = FALSE) glue_data_col(.x, ..., .envir = parent.frame(), .na = "NA", .literal = FALSE) } \arguments{ \item{...}{[\code{expressions}]\cr Unnamed arguments are taken to be expression string(s) to format. Multiple inputs are concatenated together before formatting. Named arguments are taken to be temporary variables available for substitution.} \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. If \code{NULL} is passed, it is equivalent to \code{\link[=emptyenv]{emptyenv()}}.} \item{.na}{[\code{character(1)}: \sQuote{NA}]\cr Value to replace \code{NA} values with. If \code{NULL} missing values are propagated, that is an \code{NA} result will cause \code{NA} output. Otherwise the value is replaced by the value of \code{.na}.} \item{.literal}{[\code{boolean(1)}: \sQuote{FALSE}]\cr Whether to treat single or double quotes, backticks, and comments as regular characters (vs. as syntactic elements), when parsing the expression string. Setting \code{.literal = TRUE} probably only makes sense in combination with a custom \code{.transformer}, as is the case with \code{glue_col()}. Regard this argument (especially, its name) as experimental.} \item{.x}{[\code{listish}]\cr An environment, list, or data frame used to lookup values.} } \description{ The \link[crayon:crayon]{crayon} package defines a number of functions used to color terminal output. \code{glue_col()} and \code{glue_data_col()} functions provide additional syntax to make using these functions in glue strings easier. Using the following syntax will apply the function \code{\link[crayon:crayon]{crayon::blue()}} to the text 'foo bar'.\preformatted{\{blue foo bar\} } If you want an expression to be evaluated, simply place that in a normal brace expression (these can be nested).\preformatted{\{blue 1 + 1 = \{1 + 1\}\} } If the text you want to color contains, e.g., an unpaired quote or a comment character, specify \code{.literal = TRUE}. } \examples{ \dontshow{if (require(crayon)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} library(crayon) glue_col("{blue foo bar}") glue_col("{blue 1 + 1 = {1 + 1}}") glue_col("{blue 2 + 2 = {green {2 + 2}}}") white_on_black <- bgBlack $ white glue_col("{white_on_black Roses are {red {colors()[[552]]}}, Violets are {blue {colors()[[26]]}}, `glue_col()` can show \\\\ {red c}{yellow o}{green l}{cyan o}{blue r}{magenta s} and {bold bold} and {underline underline} too! }") # this would error due to an unterminated quote, if we did not specify # `.literal = TRUE` glue_col("{yellow It's} happening!", .literal = TRUE) # `.literal = TRUE` also prevents an error here due to the `#` comment glue_col( "A URL: {magenta https://github.com/tidyverse/glue#readme}", .literal = TRUE ) # `.literal = TRUE` does NOT prevent evaluation x <- "world" y <- "day" glue_col("hello {x}! {green it's a new {y}!}", .literal = TRUE) \dontshow{\}) # examplesIf} } glue/man/figures/0000755000176200001440000000000014152560265013433 5ustar liggesusersglue/man/figures/logo.png0000644000176200001440000013547314152560265015116 0ustar liggesusersPNG  IHDRX?gAMA a cHRMz&u0`:pQ<bKGD pHYs!7!73XztIME1YIDATxw-IV~+"v\[hKca= @B '7f͌B 0Bnh0jPc@wVmEzDDfsVݪ~[uΌXַgq#63Ƙ ( qzz&gr&`f0󄙿3%Ƙc̭əvefc3Wc̜Lkrm EGxVwL)Ji(f1^#J)Z33"/XΗX.WqLW]cg1ᲬcXk'*vQPJAkuLWr_opvEQ֚6EUVs˲RV?晜ǗxŭǙyqUŰ3sY-3ưRjCU>~ Z[gr&On)ܪ0w1C+RJqU)gl^R*ս·1s'ppL%Jp5|#3g+6ԊWUٷwTbƘZma93yK`lrNώYUUVsc֟ O4G3x $w"BG]m"<C̿BDa\s3yLo+3|2NfΪiV0̐27Uj"BErXPJ`]=Z?RVSNqBL{1*(9D()3CWBFѠ3V)%lЏqfwD!5V%wnl?Sʙ?\,0!3.v A**WR6 ]) ʆmm+8$lA$M?`i=B->rc@ B/^ @y QA*h!;^Z**IZI^LZ -7:j r oB¯gə?F\cJ"V""w>v m_c ֙7 ]u@ `R` U*DiRVfkt"ׇs[frtgc'g |Ek "g&_?'+^m-3v?~lLo, iⶺt_ zax_]-s J )@5r,Ac{G3*0[#8IhmۻZiB:J39p߇ų_[>.LorYiğOD 3D@z!UVev\eFUVB 8ۖ$쾟(sK¯@Jyl8_PZ!NzEvRmf"03ș? [UH8@ pe6P8!: ǘ>9]64{^G:r{ُSEc$ߘ{1oBhcQtfD鐥*$ ==A"nXx[[3;7r) `NҾvR#rwf)oq(W|,XeO5"@%.\tk=L$i~6`! S'ǭp 5>0zmaZ6oR8u; >.kozǛlAeUi!k(w3Ȱ)p eYzBMvX^Si@P+\dZJ3E1f(aNULm\7~\mYXqmQ iҞ=(u%nZeY!MH)R_aUzS&Lr [8/$s9=8]i+T{" )AhV5N؀lԷgí,%IxpЙDZF08P =خD(MpS!WK)!IYRJj:<))\gL&lu o% li*wʞ%t7Qq"pgosNf1,+@(M7:ѨmD|3 3tE{ZkUIG%H8Fzvz)w0e)~ xmP%K eghi8j(Y˲r x@㪬PL#D${H+WU:RJi d(9^A%.Q@TExXhЦ :I 8pS=Rŏ2K)??Ȍ9ٕDD(UPjg rV֣HA)hjxV@nhq膽֚0_ukںn:LvP-1< s+Eyõ.!?R3=(|>k>Z^ K|7:9@wR v^"r:I F^}Qt_&BƀҞ(쎠g1ly{7oݩA\}Xkj+ױX,Q9"H缗 ! 3fǽ}q@D\_WD" r!eSm#d]lbAf;$`(wqp*v.\埁 oFønx$u¶7 YG`E$| ?.e1ZKUU5۹$^)Yc̿$I&W6pO7Z0|qЦVD‰H~J} )ZmO>bmM+.{ڇPG?=((ewN"$>[_͈|&TQ8Z lזrP~XDItJiJ#Ju7·-+-xcmMeN!QE!ă^?2?.X{cBPG!D"c'µce& $2͸oY#IшR~?Gt'D?I);u41G&muB1>Ovy+p'v Հ 4 "Bqs1W^#5 [YEn l4җ_v. Ɔ~uljWO|b "$I4M{y锃[){Q$6ubKba/!_1̱1[mՓRy]aE?*'^BHC,~OCBgVOnmvEQbXbe-oW0#_FD?EȽ(d'x:l?K~;5gn237vm\1q CڰZ]\h\AM x)tC t4_@?UBU^5RU *elÿZTQ*NFi:~c/WX̗/Ȳ|؁v2.7/33$IFO'<8H1_%!^_0=^D"x8*+tY 9EnBҡ+{V@ع 8̺ _q }2A/0 ^06uvD0,~'W xz׬Fi1TuD[4ҕF(„Re9tY5`\e]UȲ C@(X,9D !~23I<-'(|6}26u+[lJ+y KΣe,6=0A؀enKX0ׁ0QAw-v]ZHH",pyRLN @8[Ҹ݇n b>PQ, ϸoG̅D$A!ͭ G8┋'V[4MU$G|zUUɔV|aCC64"n4/Cn2js3c4mOސػ(͟GU=YH~+ݕ*poj|4|B'}oȃP I pgɝ"&r$pE)GQe۵5b4Jr_G+Di+ϊ&_< OHl 0_f˰ M{̍Zva= 1Lz_Y-zRy`kOv w1v0 B}D!po{^K}L,h="oqm{߿3m @ AÀ[^qurU$mM1ej{#"ec1X,S3W )OBT0\i! zͪFـfjV!JP#L[ǥ@\;,:0apgm a@x䍿S͸ڙfG?BTMhMEMR6+C"mhʢ֤@wU^?UYZ"VVQG`Xښa6ʲ&"?GD?%^ի6IG#kZ+2'FZ6 xlquqB]9a\6Kޱs̞yh Vál-:E ya45tWXG'ٳ1מȵUY?oY І0Ens{;m= fMCy$0b鍎 ko0L5x0"nl͝ÃȮMEձ6.yCe.v ;ۨ Yht5i_?egkk e4bxccW/V{WU)yʐX(!vP R8'ЍZ \n'ԵHԎ\/WDr~8m-n]!8LU (#T{PW :tEʆ\eн@#iWx6O"Lpl4G>:!6~`g+(qku[d:r rT]*Dqd֍d!J6Zi1D$z#J$Q^jPUH~g{(|rս' !~V%Ƙtk6=}| عFѧI)òrrsꮕ$ W5'ԓ>is/C{͎[Nu{@$?s(pgݽ0oVn7+Ö5F|s;t|̵ç>'e`kނcf.I?w΀7A96L͋qsg*(w},dÉ6-Hq D/0cQ=r|6a˔Xyk Uߐx N6esnxi0#pC^cq#Rv8>Ѻ[]{[mG߅a]j9Gwޡtlu @o;|kKӴEF隙sJQ?3}/k2u-6!'V ٸ  &tyҶh;"M[te3zdmJ*]2pL^K%yADeXHF3``ʲcr5{|]=cMvȱ _߂B\A1>^6 `4X'+|DHھ.UYa5%ʼh63`5_ZzY$_d buu 9vv*+wf me$?aUc,G6_a3C:5kc0MQO&&>T^UYh[>l!_ׇ H+< ꦎo)pvarф;U-UH(bHf3+[Ԛ®Xk6KIFQcKg@m, #f<0Sr@h1eS J-kf,<|8x3.z3D۰tè}?680wхWv^GˉuszXR8Dw7ٕ'Po` ^F[g7w?^k7@3|.Cw0s+t^)Jazeck@WUV;,޷љe8kb{ Xs-I'mcPp>K8 27IVKڏ:<2/N6/7Q{+sDjc,UlԴ\ j1ƀMxkGxge%ޙ֑8M5zV+lt?V'FoQ]6 ޶γ.wD-}[e7ǻGW13h?2tYF+`  T8?:v{UצIj7YVSF9~AN y]Y췣`%'VN6X_v5lj …džNzO Mn&߂@yFu~|֊`k'O#x?Zp/c5z/4}u h2lҬ*H|t. 3!uZU\5ZW?Ne^17˺j Ye 9-*۹} ,RS/'pbW/!eWM7%w|U_BHd6B}!pW^* avOQKi$DZA8b ؾfDfun Zuؠ<6}q+ye*|yכ؀14i3huD&zLbiTi|[JFpqTAm c$@BHaIc"B:Zt:oe餉MkUe8M ޸}l^dҾPܢ(0l2 븒I>Rn(oܳx"a:%4Lv2$DϾ"" mD"HJYQ7rpD~!XǕj'f{MA׎hk>Bִ}t:e2yHb==4kIL)k.Gt7ٵջh6fvm; ~1|\_~4m>36pX6~:#cF ?"'x8ܫtlS?y'3>v- ϋQ!d,HoF7(IFH1{aaP;:oEM .0ZirOA_R$Y:5Jtml\>e#yuaڦhVrm@}!~M|yU˞JOeþ겲WT%u3ЮPQeY%6eV4rZꤢ *"ˇ=K*vY7V*o9D lOt ,FrPr0(12Cht9beKlP`c EXƵ-W <X,+dn}D jŒ2-fo5NpWWZtU``uUXaG<({j T^8FYT5\teGKW3)a|BʃIv):[ޖxS6lW @@Z@w@- /tpV2(yXf9VGlQ]fh-f~z,ZnblaXXpA<.a\mWDd3{:9= ;dT\&6f=ͪ,bQe+oY"[_vf%ݨ=2 SEvo+m)c`` 8mqI %Rr?6(mm$@u~(iFi D]ګH&A 爳4͞:{ks T Rï"rm53ytq!L8xgws|p5;<I69 ´Ű@z58%v*)v 6Ya^z{R}EUm2g"sbx.zSmiemy yGw 4>!pXWOa{s!J*lsb/EY`oVWZn 콇 Njl{@ֆUbff<WGIWbs ë39LJi)~^_S`qNߊk몄.fl$ &Ӎ\}4lua :̷vVڥ3v UXfGCSΏ;Bv#,[-pGP%")1Zl6ZAPNvOx``|aR$M>dqS?C` VW!Q44a*K>Q];pPZбMUIbm:9g0h_{ocy(3+䱯~Q=+ߪP2DIWzKe r рWXF2ȎuE wa׶mӤUaQWRJdFG-dig zX4teC3rB၉W; cU8 " %NfX VV[!ئu!NGMoJHWVXSaǔ*'ɸB,.JD4DN=j/lyTlҭ Moq`v5Did2*˖;LU0M#YD*Y]8[8E:۶V ̚&;3v?#ATwB'Ox=~7w۶punuIΖշM]:Ms &ٵr?0|6VwOƉ9u>JR2+k `6:?; ^ڕ+MH9-}0u!t5}r}2Cx_vf ޣwHfmfCồ:8ƅ8n2`\b5!Ne% f8#6,צaGV0wwrhlf^xnK0EfBxX w>I*aM㘫v^\(% 1&h\E^&B;Xe@ r]k*^alu*5N o/ (ĺe[dacشaӄ?\=mg \Q+:{jiu<1\djQ̥bwm;vi؀6Ȉn$,rQ9ȿJfh5kٻHVuTӻ7gfG vcУ\R6"lvuaF:Z&ќDC5ݩu*c(aLCZ]:ٿ~뒥 n- mpAU4A,c@5lU;>TƔleʼW8b9 x 6!`6(4YG'%5ef0+6EVXXpu[|s}zf)NO>38!u9ZluR3euM~ģԤun_#!lj`V p?>MQ(4c|ͭT q LWHPVu}~L ʙ"FWE1@U:UQ:Eq1$- l\ܽAJYIwmr]HWPc?5/IHYnAdݲEmqpB# )!!fUhVGpΖ8NF:xG& cQrVٚƁr閌SΨar'=*i:Dͪg*2LGvck *]*b?o5mM%>v&ۃɶFWHVtwFS:cU^`48HbznJv61_mզ:(AW>Al`vz>lW㚆 P}כJ'{I(›cnwxQ;95l5~ơ־^7otd2n>ljcջ]+jpt:FkS19Q2R6 Cmۓ@{X{5hxvرXgkU\TyuͯG0HW̨tripSλp̲,C$Pұ+p)C9q= VT!_['F@CÖX``SH : AF $gd0>o],5^Dqq7o\>Շ𲗿w?9k7@rw۷1ߐ ;'\ݠnAEap4j bR,B> Gضvt="`  FН8nnuQUT5%L(QfEwXNWN*& 5ն, [ǃktLQW(WE_l//K0 /Js*J|}鷰XՈX8bq x衏~,;l%yۦV^Z2/pxubǪ#{Ȏ-8| bw.pV;e!5˽C{+ji@7TY>qC Qo| ] .m[lm&LAԽػ"( 3+%BlP10K؎r]y3<J)fDk,{njrwN2_~lwMX1ڠK$J#)Qu ֹJ܉}۬OM FIe0a*]=gAy!0ښ 6G34ӫgN w *j6E9F6_!c4x}43E+W! (5g\b4^ݫw;&`C(P\*` 5Z$|Sw <sS7̍vbp]s{\r h@t3aNhM)M7 0>fuudNνaLO&-H29L֑ #ޖj`H17uJWn̺ww 6Xkȝg3uuÿTk nrӯhhZ ]1v⽪jX~?׶fҮ>QR=zSXIt /p~D.8__*:?dfFƽRD՝ Nd@\62U]g(EHt2jjD9u* ECDlbcG,J.,[(MPfI:3,%N\ΐ$SKXP[xʬ@:8t2d(u]%mt([Ɖ~C/4;]Ն90; U^ǰ(ZmCW}WljX eQXe*ϗsݟadU2:Y*J̯ԊΫVG|@ZL.6Ȏ_p/ڟop:pMսvR~(q5~Qq>l=falHGh:~Eg[H9\j$ I뗭m~q_Rᆷ 9:QrH;e@!%`mjtBd4Xb+ Btbz%m,h4;^m2Im(-D5 Z#D fS(fqiZlb !o qM[xkcd&w:V!k ̀ "䡫ݦlw"y4m;}F9Ѻ@jOyi4"A&L9ꟃlΆ{-jX ik4Z wڲ7YnB]9_k;I왜LG(RЅ^[aи]Ҡ'vk<ƆsuoF`Ewi~W=7i񌅱WeP*/Z縈$RAuE&s]̊`:QEQ8FASvyJ#UVPeHֿ)\˳щ_8BvhUC Lu! hj`&b!vvV:mQc {G5VW CW C'xdY\+t?RX"{kyI+xacӷWҐl3m l%ؖZѪQ ٣X(N׵H`(}K"pF2ę"B7p,t*Nq#6e*u ,g8aR>&\x{Z D$1ٞ([yŻ˽$3[Zf X<1?h+w 3]A }/hSkRZm]aoZaA‘F/Eߣ|xh`IWYƘ1E@X F|hY k~6+͹vq IG;6JGƱW]S\9j9XCv$q87ChCs;wjFĭLmrĮuZR(a8𠣊(Dkx2W67ۯut10kj%=78Ȁ.O&S\pW>q̦t'[)4=W3f)gad`4N1\=f(Itһ6ɛe`6!E^LFѭ K)19Q:X A 0mCGQS3- &bSm`zN|M8u cO-c-'xm!:o-3( ct+2B]ۗZie,B.#J478R LO 9&$H2YwÌDrUi S_|nx \hgDqh A|UBJn1a-\8NqlKz 1-e_1pHx  &e{$#]B$B*Frh ٦!J[S -q8_`{ ALY;Fil8x@ YBm/Vyhk:?(Mua 3)靿=jcj ްxñǬ?h>rc3,qɘv1]̨щ ^J)q]w"cVȲ2{&9$41gr W涫PfXt{ egtnmKň\bQ'*wl4RMQ5o|jԋГT `%յʞrہQ @]%h೴0:JY*YVSª(Q%dҧ9RBH|5!<\l9PRBJb j#1Ū^t2mWd@8o_BFU8v@Kp^sJ"AMۮǒ3y* @ )|T]H74pj]wgy8qClBJD85əXcϿY7LG?2:)U萪y'Zsbk 5Was&O 56M7oV0ԜkI7>E|QVYւVFZU2k ŪQEp^38j+B|&ܐdr]˽v?xޢCptz.iGlɕn{WV#dYEq%A n@~QUQCMFT>4䆎U^t¶ 5YPQev:֋_%O>kO]|tw2WLعȎ(pr׶XؽB";N']: BMCK`Gm7n;ApgZ@k`9-@Y1@ $϶̾ 1l"%|;G։:U{v@ɖS8Iw,k!B5F -s3P] x{ G}XTuR(v<楯y uqTޕȱ`ߥGid@+(ޜ$cTUɽ J"eb߰1 ~DuMV-!Z:6n?IZքS G  G@(OO!8a?%K*-3:9`ULch?uQt+f0Qxd1JawVۨnC"k-@v)5~U :;/9x^4yg򸈟 ~ t!F;J8nbmNj%jxB))4\qלX28uZRo+(mFr3@G]' _>6\!}]q`ytu`(ZQYUADݭ#L(߅]9hkj9 WU~٠*fy^ UZB=]t`EǨe7AۚZqW1 ΞL"{l: DS8CҺuQUicQ *.fPDIlY-I0` TyrtNXI>>+= V_ݟ3Z]}4wڣ)T@ gvI[s7͗-2/!z|wQ ϗ-2_,xhwZ!zgA>#g'JOZ;x{ք6ڽzDw\jSCz\ݻH@l;e)qFU4PY-}rYYvރWPֵVs?U⁾ˬvy0 XԲ,qppԆ-4`(ȎG Fc6WRՔ;sBJD*溯1P-@D$1LU Ux!?nwq&=oBm(B:BkJ"Lg`6vqZ 2̂k Lv`\'L\QU dgvVu_c e6$|1VM-Q?lp@Y! ܔx*Jz -Fl4a6+`rE zۺȮ~D?ǻExV $N9.W4dA9q1l(qtu513Q,:'_*rhݖLJaA^K;36tJhkyt :JTybn!D2Jz[(g>ζҡwʆpqPt62R$iU-0`R YvpvZDaGj4,;noWa[h̝FI{uqGNg>lDuBB2 \!h g*2vhs-tg,N?AQQqjC^PuN\v¸a:5ۦ1Q$I68avmڨp84l2X.ÉOTi!z@7Ъu.dȼjۭBd -`ݶR tsm3㨭7(0Y%DUU(5eG866`)+f^[{+eQGt smBLyp:Ձ hZq`6b Y8fT8A Q}BģU90dB2 B2A,%g\t wfTyMS0pUrb < P:/%ol״t(_!g綑GkX-A#1غdlZ1m[wV![x>*J 3Y5$JlFRhHb5 {~@oOӕ`Q~Ĵ5WHٸ䘝 .:# [lε.s|m;ed}KQ$1kG$7:O18ddF%h}z4 'MXhoQָr 7+pJwR'  щ-dz~lhuCΠ[+=6JoޔE(Oɡ͋dPukSk2CRGImv;VdTĪ(*$M :@c Uf e)Iac!e>qZt\d@UbGvt-t|@@>吷sxo^G$yLv|qr ٤`yH&Æ5Jczn|6KoU:N\[X-0ˈsZbcQ7 ߍ+i gQf1m>@yȎFI{\0Jcr]:XOx @O A =/y#(~G}-#pH.U:G(F߈ hΗF[?}:e3! O>hh0W9 g7HP2ߍ-ѵ}0s=eV _f)Dva:r;3m]'U^6xwNa]}d6ʲj eLz%J~]=M8٭q0ۂDq*Q ])ƀ_F g~;z1\@lͷ<A(X'Q͈_ 7#Vbc ~Zfh襟w~vg|5m^ ?s~{ J{QX!{zĢ9Q#:]FDԮM:#J~l1V2&<Ȳ q#ֳ23DQk)̦V^?&Q̮Ka@p1sӐ aF F_@`iWgUv@[@2v[h ycw4F@O=0C>Eg>oI3 c$k0C9_ q.p(]D{9ĥa(Ey_3&Aٮ7ܾnKa *B\%)TuI05cfjZ9lg؈&ϐ]tʣL`RP`mh,F ?!Ev.)݄)"W%$zuIJ(2l OK?& ʣNf(NmE1UQ"Vc3̋fcPd*䐪6Sd9djq8x4!vwv\W, y}wQA *# UU(VcP2K%E{Е@42z[|Ტpfį"? qc,0#_!O l<^֣h<9+}v$Em0o)/^m{Nv71\Dj'u:jʎJ[Η!N ~W*H`Ij&bevu?eesb\|D(Zť(78at6p t*+4p&X~lmxTLH#TE5 #^y/Կ鏽_%%7h{uP M-.6|*[:‰EH ~/Kvp mFC>~7q;oGs~w=|!~Ns;eB FBHR`3E(WFI6|wQc9^n)Ơ\fo0M{ W!\*+$vlDrm0@ Hhѫf+\27e!&FaS $tXAiVު@[G(1ͪ9n)c!_v'yv;}gzGG= ҿsVnG? 7[oۨw"z'B2~T=u=ãm;NfYf ze,ZUX-W+~ *09зu+f7"6nfym=hgZyyyoPA򛃫0׀V- q ^9jXU6uJP0ퟄ\d > q nE?ilo|@QV`P<71̭sϓh(Bs`֧;_7tyZb:0̃HA[Ufs0U^[xIXC֗ "HZCg{.ٚ~]}?\{f@B\~xu??d-%c4g|])7Z&;1;Ǜ v/4@u _ʨS-^Ծv6q!MSI&PWѶ=DU4_t;D>_|qÈr`uJP}+6iϫEf\q:IDAThs ֖=|? sKU/X= }Mi<߳4q1!_)O.zlE1ƕiqj=r0{7Z]kmbi̘B+ )%Flr V``8=ʲ.WgÌ2AI# !%r~-[XD"P,v4@a]M$N6⪰Ymb\㶞TUh č.G⶧5NddpӖ#\RM KSڿP" A$lJkȑN'ȗ,_;|UVH;$)LK[h-ٶUYa47$)NȎx?k& a9#뿗RBJY+BʖN#BF- ίZ'Ɩ1ς4P2'1O{M2A# Ckh‡tX"'ukW'@`uA }}+OlUi=Ȼ|_AGګQd ❐dg~"ą^cm+kLJЏb*Yk(2׳͎E|7NAR0 j"5m&\J堭]pY@>50e^Z[ͭbլpB$zje6HH;h3A}vU_ q31Kw}J'0  qgˋS9@uz{X-G o)q nsum q#MShIbc+0}neU,Jo,V 'յ  H YCp)W0Jzblzv,}!@A;K*'@>m\@[hw6ɸَSw<bȧ=Ɲ@9f;$i}Mj̵!~#C? z}lsm4/ְs`=)(qC6*"R`w$Uhb(rqXiQ.3}0ZTx2-H\G¥/ç )z0֖@S{N]cꋇW[wx0YoDoem7^:9ټ0ۭѠ0%S^S;s lyI.s _E<|xa: ozכNRA`B_ݙZDM2QeSeI%W~7.vi>&4N{8hi$g`*δRI#yn3*NJa5Tt:F6(db0T,tOɶER9Ht ̠ H>+@|x <n(M{nC"!?0C\~$7n+3;30W`{?̵̓Ux.s udv) EB3 5JA%o#N̐/V0l %Еݗ!]t:xw| cBR.u;d[ n|윏O3MIu)Cuо[++$qU2tp{[$2pYzӯ9orL[##uvEm8=xmh(7n}lw+i2Ja> /ڣ|&/4Ͻ&]S`, ہynEܦs:Ï/_ڈ4ZȋF^61d$b֡E@lPOQdы_sZ{?7@l ftg\?]+j@$:|"M䂡e[~ }o3LR?{4Bv)d<Ѧ5Sîs+p*[G'm/aqkea$/i`{k<!uL>DF DUV3˲lnQXeێ[&tOe} '||ª uX%F1/Ł}|o+"p%sb%83Cl_` O?|<]yn0F2 ud%6m#Dqd=헺-N 19JF yLɫ}T^{ T%8X>/-U8[&s?yą;aįBp67"@h!`YqQQykڊc2aGd!N\t:NFilq>=nGQCO`H;Kzכn!nWZ!vEO1 a"Kw?6@BD/~U}w nF{5~ŻG^jڄ >Ӝ{:O3ʛ~kN :nې yZ[[[PR1o0ZCW~וwji|̕zV?Cmz}> v.b Xi4*z}k!ԟViۤB /6z7L-2+ 4{7>}8@y_k?6 ^|]_@|mx0c+w1ly UQ_IsɝX݆Qa>_*Tyhlt6lgXmCBvh6K(,`t*-.0|c"D0| @.ۤeey;b%#0s_0#4Gu|M1K^ӿIKw=H@^Bϲ AiD/LI8v~B~ch|cWW1h7ؗȸykw{te2kg]U 4[|qp%1q|v._dw+Oַۚ͐Mn>(Mq.4EX7ɺ-qq# F[YTYAWfwZ>[B~mzU'e_CD8%6X:#A!@>8{@ ai֜@[ooӅͻ"^b=UV}3/[jH\_VqNį2ğV*AO!BP#ϳ=؄ 87W"9|AAUrn e D/z}:xw z+ )kG}tW+,HUlΏo^X ,/]΍ sfuf~ ?^*M$Cî0C4z=0,"(?6`F_-@jmPt&{Hoq+>hMDn(s,& +"Ĺ`Z"|ُ;}§ZJ@|lTbcύmˊ",~>"7ptX5]X"Btb]&~+3a~ ZҲgfRf.n J7$qB&󐾔$؁Di2ϑ/}iP )%xy^F<WPA^S\O^D\9$ -  :|mkK蜀yC~z[\CÝl#A}lk8jE6BY, ǛGJz>ѕؒYMH\iI.㞧?F^fƘ/# `Bs {>r]|uBoP%%Hb2`<!p=we=DErjJ; z/3(ZDZz?\^MeZ]Nw ɫĮIoA04 2u?$tNy4cGЮf8⪪,vxRb3EѴAH!}n L;Ֆ]OҴRJc{{رo! "zWQ(ER`4AJl mljV~|`~wa2m3FK*"y  5y Lpiqۛ31?Iy!BFJ3b:@JC!>:)3Ye?y+勸;lU7 Q.;lFtK#ģQa[=%O"Kh=ڹi}>Oބg Vqގc.An2(ŝ܍{t\x;7'U/VY)%$Dv>0xA+s,Vekv78B0a4!IL'Sf[ LF20aA'yer^g.2dz|n<69^&3L9(n\$ .~;;;uR)f]f~+++Opy혝߁*k|e߾r3q;`_.^6DԊ"2^bXZV1\ykvwwݍsΝJy]ƘoVZW~LgXj.,_;<:&m2_:hRb{k XnXd,C\hoaكZͱ(uZ'Ƙ'1,trj/5P`/OH |x2"":vww$ <# BIFiY(Il'i|v.(Wa-ڽ'zBJ]H0e,|fb{g%Uug3\U=̣ $"ʠ(8&1:|7k}Y7ܕ/+F$CqAA@A&'ϸꁦAT_zթs]TiA͙tn5*{ !3D :bqP$I(=8h8Few:]vI&qlw :{-:rFN̾s {`~csld,.(ǽ6L"(.3Ƒdy7EpxPu8UUɶD,JBBۍP(-%ڹ?LAEU%Eahԡ ONhR\߹ |P0ZZ7 ָ֧eI''T QUYH׭!I(*t"Y !؏uM>!d*xsz'c`$ !OqίB@=.TVC"D۶(?hʪ*"d rXk9Iasrlg7[N\^H}ýל[Ȟ yuIƠ1tpz q>W)%t:TNjVP.( YwoB&\C( >=nibP,^MCP\FƏA!ښlί}{!NPӲ@$r9h&1!˜JH_ߞ^ʮcM!d^!B.$IHhkuJSw.q_)qR]0ܷ鑫Su5&lApݐe H^T;`8%' Bax 9\t['b]30udӠ,= 8%R^_e"¶lއBA{Y !>?bk^7.Ia9zt;،PMGc)?%@UҊho! s+=7R Z: f;[H 巂W:ncwz& .7M+ؾmy@hKB@uyP\E%UPCE\)-󣔢91}jL$hL"C4Md4 .w+-6V0v c!?0GUd,i83)W@5-BV3nt9!UUSU^R*)UA˴y7E!uv}=,6}SCG{ٵKB@^g̅wp 2_nD— x<~TPA (0M TנSGCe-RU՘6u*;Y+>hTE(!2>#L!G:N+r@Daqp…L)$(j]4@]΁$v?;t ;>N"j$|&憞A:NBBG9/ɲF)EŹ^O,t(!Ϝ+SxDՇ@P]Af~n[2%BɎ/P_s;$om_Z> "xŠʱ|!T& gߜ0Mr#e⏜+)AU>+^ À,; ӼOU׳zMuqlCCPT? =-mi<|q K5  D—`[qBHH ánhZAUZ*ne~5uku %}^tY!ٖ{!py2B t ts If)Ho W#jh_~tHĠ,$ bw*g@~'Lz8Z$|^j)8#4y g!5xACE0L x ‘2x\,=Jŗ!J.}"Ʒ0$xCm@u .BҐI5J <"HrWKdVχcц6yB;n%@$ZAP&] Zֵt)P7!CHnZ ]r=9,#0a&M&tk$#,[ Co`yi#Z#,$-JJ?z;,# E ] l> k2Y7A P,.?:-  oמQBUh}϶3lcr@-Fќ#r Ćٱ3|l˄$+:z2 Q9{ܲzp7 r=JǕNZͤjHwB2ft Ċ*yT@v9 ho~]-kOaQk= 6vhm-n/l>PlhiW!2pU 7uH~6a".1 CG:GaGӌ44 ]캔z/!vKm@(_ js`{yXkAd4ȯ-巁7޾ٰ<|,4ބQYNVJA1 ^ȥ73` 3dvmFќy /u,Rٟ5-[ ~5ʜd2 ;]Gt'=޲ 9׀9+`8}|^ P&_{S.?!3 "Zy?ґJwnrs{l^ tn6@5t  nxe@1 Bl=bY+.'nĈr=2'3B$Qx!HlBޟ5(;#u-Pν$[j&0 s -ٖy!7o x S^[amX e rOC9PLbP9EsnP ,* z|=?h{G g Q铜bOE۶J  cXYXiX ZY}[ASc}1]3xqrtJ  -'LsX"U=s!8aFHhऋ:3{ۙ3jlmBrzM<#g w|l @,;=wI2h.|lfgB]Тm 50'+ž(l-*0uHF9`@6B V>Ⱦi Ћn+! 9 7 '>Qp&lEgSV ɝP8\L'/ுVjI̦:U-I\gc^8AljD̏߂}_8{}eZ-8/N`|Ҡ< iho"S˂ꣂbSz ඵۖ8*ףrGSހwۚ @DuBZ~ _lP#Iu#f>:7q7$; t%P~(e$x'ky%WNEq"BT-omkao_iH FA|̥8垉* yx }jjs?=gu23ɧpIڄtDM?9D߷JQ){7 &М&޶\ ~#6!q- kbn-[ u+5{PΛ[*qa[qC(h[ۉ1SN|RT-GJg}T"=[`wHςr5Cu0>2I'u<,8!yd[VV@ 0 ) D*:7@y=hq1[XY˸iYk])h-rl9*yGRU= rQ9XB u'p~O uwM k݇0?zp>uB 4ȤX-2bƏZ\× PP̈́z͐}J91-vjQŸ61Ouڐ v!k·\s>, <&X.WA¥Pϛeu*v }65 [@+Bzԋn )g'2Z?UO4y$[VB-9,RJ=[ $bQ󟁽SS2NGXv^pZ-ǚsH50~lfgjͻ @y=BX,U! Hk @u/cv:UoޏOz>ɤ7zd6-}u{NdF=@Q^tcQݓhixke\DB#!HRF9!37Ar6 IOw`.Њp) dc2e~̶fفr=gy}(UJ lQVf2\돂G @dD skXk"sJ˛Y}k@=òs/ ƻODJLk; l[cF=Nom-(sáS] θrx)Xރ V4zS3PjwgOͤ|O1y]5 J,RI=ۈTLQ=0 G! gگr܌@X:hqe2!2TP!nhݰY6Dz%C'OA۹v BTl,7'qu`mgBX!6a,Hza,|^&!,\t:}݇#зDC0ӷ10j,[By*>2</ {y7ڰ3vY0avd|w%OSÊf;mm;۶0&2O//aǢbxm3a^_?[g#OS7V[3^0x{P-~;Rg-tt|"go?qn[OrC+I!eUo7O~7f\n[7P)[M2Y ;і˓'n!zgZ\ලص6q K' 簓1$}ʓ"v!x#DPnemL Bi)Mr}y $?O3UypSqC_>!ח'O {Mv +cKi̵nnmPwN6W:Q҉v|s'%﷎%tEXtdate:create2019-01-19T11:49:01-06:00=%tEXtdate:modify2019-01-19T11:49:01-06:00q`7IENDB`glue/man/glue_sql.Rd0000644000176200001440000001367614172657456014121 0ustar liggesusers% 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(), .na = DBI::SQL("NULL")) glue_data_sql(.x, ..., .con, .envir = parent.frame(), .na = DBI::SQL("NULL")) } \arguments{ \item{...}{[\code{expressions}]\cr Unnamed arguments are taken to be expression string(s) to format. Multiple inputs are concatenated together before formatting. Named arguments are taken to be temporary variables available for substitution.} \item{.con}{[\code{DBIConnection}]: A DBI connection object obtained from \code{\link[DBI:dbConnect]{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. If \code{NULL} is passed, it is equivalent to \code{\link[=emptyenv]{emptyenv()}}.} \item{.na}{[\code{character(1)}: \sQuote{NA}]\cr Value to replace \code{NA} values with. If \code{NULL} missing values are propagated, that is an \code{NA} result will cause \code{NA} output. Otherwise the value is replaced by the value of \code{.na}.} \item{.x}{[\code{listish}]\cr An environment, list, or data frame used to lookup values.} } \value{ A \code{\link[DBI:SQL]{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_data_sql()} are analogs to \code{\link[=glue]{glue()}} and \code{\link[=glue_data]{glue_data()}} which handle the SQL quoting. \code{glue_sql_collapse()} can be used to collapse \code{\link[DBI:SQL]{DBI::SQL()}} objects. } \details{ 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 \code{glue_sql()} as a character. Returning the result with \code{\link[DBI:SQL]{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{ \dontshow{if (requireNamespace("DBI", quietly = TRUE) && requireNamespace("RSQLite", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 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(table = iris_db, column = "sepal_length"), DBI::Id(table = iris_db, column = "sepal_width"), DBI::Id(table = nicknames_db, column = "nickname") ) iris_species <- DBI::Id(table = iris_db, column = "species") nicknames_species <- DBI::Id(table = nicknames_db, column = "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) \dontshow{\}) # examplesIf} } \seealso{ \code{\link[=glue_sql_collapse]{glue_sql_collapse()}} to collapse \code{\link[DBI:SQL]{DBI::SQL()}} objects. } glue/DESCRIPTION0000644000176200001440000000311514173114312012711 0ustar liggesusersPackage: glue Title: Interpreted String Literals Version: 1.6.1 Authors@R: c( person("Jim", "Hester", role = "aut", comment = c(ORCID = "0000-0002-2739-7082")), person("Jennifer", "Bryan", , "jenny@rstudio.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6983-2759")), person("RStudio", role = c("cph", "fnd")) ) Description: An implementation of interpreted string literals, inspired by Python's Literal String Interpolation and Docstrings and Julia's Triple-Quoted String Literals . License: MIT + file LICENSE URL: https://github.com/tidyverse/glue, https://glue.tidyverse.org/ BugReports: https://github.com/tidyverse/glue/issues Depends: R (>= 3.4) Imports: methods Suggests: covr, crayon, DBI, dplyr, forcats, ggplot2, knitr, magrittr, microbenchmark, R.utils, rmarkdown, rprintf, RSQLite, stringr, testthat (>= 3.0.0), vctrs (>= 0.3.0), waldo (>= 0.3.0), withr VignetteBuilder: knitr ByteCompile: true Config/Needs/website: hadley/emo, tidyverse/tidytemplate Config/testthat/edition: 3 Encoding: UTF-8 RoxygenNote: 7.1.2 NeedsCompilation: yes Packaged: 2022-01-22 01:59:35 UTC; jenny Author: Jim Hester [aut] (), Jennifer Bryan [aut, cre] (), RStudio [cph, fnd] Maintainer: Jennifer Bryan Repository: CRAN Date/Publication: 2022-01-22 23:52:42 UTC glue/build/0000755000176200001440000000000014172662404012313 5ustar liggesusersglue/build/vignette.rds0000644000176200001440000000042014172662404014646 0ustar liggesusersQN0t-$?`.zj5Ge;6:J*$^{[Y,Nl1,qmzR~n4EDePNBXvx8xe :oЍ\ ]NrKsS>a"% ޽僿 03xdcDP"d*4B %龑aCG_m?glue/tests/0000755000176200001440000000000014152560265012356 5ustar liggesusersglue/tests/testthat/0000755000176200001440000000000014173114312014205 5ustar liggesusersglue/tests/testthat/test-vctrs.R0000644000176200001440000000345214152560265016463 0ustar liggesusers test_that("common type of character and glue is glue", { expect_identical( vctrs::vec_ptype2(character(), glue()), glue()[0] ) expect_identical( vctrs::vec_ptype2(glue(), character()), glue()[0] ) }) test_that("common type is not inherited", { expect_error( vctrs::vec_ptype2(glue(), structure(character(), class = "foobar")), class = "vctrs_error_incompatible_type" ) expect_error( vctrs::vec_ptype2(structure(character(), class = "foobar"), glue()), class = "vctrs_error_incompatible_type" ) expect_error( vctrs::vec_ptype2(character(), structure(glue(), class = "foobar")), class = "vctrs_error_incompatible_type" ) expect_error( vctrs::vec_ptype2(structure(glue(), class = "foobar"), character()), class = "vctrs_error_incompatible_type" ) }) test_that("glue and character are coercible", { expect_identical( vctrs::vec_cast("foo", glue()), glue("foo") ) expect_identical( vctrs::vec_cast(glue("foo"), character()), "foo" ) expect_identical( vctrs::vec_cast(glue("foo"), glue()), glue("foo") ) }) test_that("coercion is not inherited", { expect_error( vctrs::vec_cast(glue(), structure(character(), class = "foobar")), class = "vctrs_error_incompatible_type" ) expect_error( vctrs::vec_cast(structure(character(), class = "foobar"), glue()), class = "vctrs_error_incompatible_type" ) expect_error( vctrs::vec_cast(character(), structure(glue(), class = "foobar")), class = "vctrs_error_incompatible_type" ) expect_error( vctrs::vec_cast(structure(glue(), class = "foobar"), character()), class = "vctrs_error_incompatible_type" ) }) test_that("can concatenate glue", { expect_identical( vctrs::vec_c(glue("foo"), glue("bar")), as_glue(c("foo", "bar")) ) }) glue/tests/testthat/test-collapse.R0000644000176200001440000000370614152560265017126 0ustar liggesuserstest_that("glue_collapse works like paste(glue_collapse=)", { # Always return 0 length outputs for 0 length inputs. #expect_identical(paste(glue_collapse = "", character(0)), glue_collapse(character(0))) expect_identical(as_glue(paste(collapse = "", "")), glue_collapse("")) expect_identical(as_glue(paste(collapse = "", 1:10)), glue_collapse(1:10)) expect_identical(as_glue(paste(collapse = " ", 1:10)), glue_collapse(1:10, sep = " ")) }) test_that("glue_collapse truncates", { expect_identical(as_glue("12345678910"), glue_collapse(1:10, width = 11)) expect_identical(as_glue("12345678910"), glue_collapse(1:10, width = 100)) expect_identical(as_glue("1234567..."), glue_collapse(1:10, width = 10)) expect_identical(as_glue("123..."), glue_collapse(1:10, width = 6)) expect_identical(as_glue("1..."), glue_collapse(1:10, width = 4)) expect_identical(as_glue("..."), glue_collapse(1:10, width = 0)) }) test_that("last argument to glue_collapse", { expect_equal(glue_collapse(character(), last = " and "), as_glue(character())) expect_equal(glue_collapse("", last = " and "), as_glue("")) expect_equal(glue_collapse(1, last = " and "), as_glue("1")) expect_equal(glue_collapse(1:2, last = " and "),as_glue( "1 and 2")) expect_equal(glue_collapse(1:4, ", ", last = " and "), as_glue("1, 2, 3 and 4")) expect_equal(glue_collapse(1:4, ", ", last = " and ", width = 5), as_glue("1,...")) expect_equal(glue_collapse(1:4, ", ", last = " and ", width = 10), as_glue("1, 2, 3...")) }) test_that("glue_collapse returns 0 length output for 0 length input", { expect_identical(glue_collapse(character()), as_glue(character())) }) test_that("glue_collapse returns NA_character_ if any inputs are NA", { expect_identical(glue_collapse(NA_character_), as_glue(NA_character_)) expect_identical(glue_collapse(c(1, 2, 3, NA_character_)), as_glue(NA_character_)) expect_identical(glue_collapse(c("foo", NA_character_, "bar")), as_glue(NA_character_)) }) glue/tests/testthat/test-glue.R0000644000176200001440000003332314156753073016263 0ustar liggesuserstest_that("inputs are concatenated, interpolated variables recycled", { expect_equal(glue("test", "a", "string", "{1:2}"), c("testastring1", "testastring2")) }) 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_equal(glue(""), "") }) test_that("glue works with single expressions", { foo <- "foo" expect_equal(glue("{foo}"), foo) foo <- 1L expect_identical(glue("{foo}"), as_glue(foo)) foo <- as.raw(1) expect_identical(glue("{foo}"), as_glue(foo)) foo <- TRUE expect_identical(glue("{foo}"), as_glue(foo)) foo <- as.Date("2016-01-01") expect_identical(glue("{foo}"), as_glue(foo)) }) test_that("glue works with repeated expressions", { foo <- "foo" expect_equal(glue("{foo} {foo}"), paste(foo, foo)) foo <- 1L expect_equal(glue("{foo} {foo}"), paste(as.character(foo), as.character(foo))) foo <- as.raw(1) expect_equal(glue("{foo} {foo}"), paste(as.character(foo), as.character(foo))) foo <- TRUE expect_equal(glue("{foo} {foo}"), paste(as.character(foo), as.character(foo))) foo <- as.Date("2016-01-01") expect_equal(glue("{foo} {foo}"), paste(as.character(foo), as.character(foo))) }) test_that("glue works with multiple expressions", { foo <- "foo" bar <- "bar" expect_equal(glue("{foo} {bar}"), paste(foo, bar)) foo <- 1L bar <- 2L expect_equal(glue("{foo} {bar}"), paste(as.character(foo), as.character(bar))) foo <- as.raw(1) bar <- as.raw(2) expect_equal(glue("{foo} {bar}"), paste(as.character(foo), as.character(bar))) foo <- TRUE bar <- FALSE expect_equal(glue("{foo} {bar}"), paste(as.character(foo), as.character(bar))) foo <- as.Date("2016-01-01") bar <- as.Date("2016-01-02") expect_equal(glue("{foo} {bar}"), paste(as.character(foo), as.character(bar))) }) test_that("glue with doubled braces are converted glue single braces", { expect_equal(glue("{{foo}}"), "{foo}") }) test_that("glue works with complex expressions", { `foo}\`` <- "foo" expect_equal(glue("{ { '}\\'' # { and } in comments, single quotes \"}\\\"\" # or double quotes are ignored `foo}\\`` # as are { in backticks } }"), `foo}\``) }) 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_equal(glue("{foo}"), foo) # re-allocation on input bar <- paste(rep(letters, 40), collapse = "") additional <- " some more text that requires an allocation" expect_equal(glue("{bar}", additional), paste0(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_equal( res, "My name is Joe, my age next year is 41, a dot is a '.'" ) expect_identical(name, "Fred") }) 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_equal(fun(), "x: 2, x+1: 3") }) test_that("glue assigns arguments in the environment", { expect_equal(glue("{b}", a = 1, b = a), "1") }) 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(recycle_columns(list()), list()) expect_identical(recycle_columns(list(character())), 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_equal(fun(), "3 2 1") # This environment env <- environment() expect_equal(fun(env), "3 1 1") # A new environment env2 <- new.env(parent = emptyenv()) env2$x <- 3 env2$y <- 3 env2$z <- 3 expect_equal(glue_data(env2, "{x} {y} {z}"), "3 3 3") }) test_that("glue_data lazily evaluates named interpolation variables, in order", { # Decoy 'x', which should not be evaluated delayedAssign("x", stop("This 'x' shouldn't have been referenced")) env <- new.env() env$x <- "blah" expect_equal( glue_data(.x = env, "{x}{z}", y = stop("!"), z = x), "blahblah" ) expect_equal( glue_data(.x = env, "{x}{z}", z = x, y = stop("!")), "blahblah" ) expect_equal( glue_data(.x = list(x = "blah"), "{x}{z}", y = stop("!"), z = x), "blahblah" ) expect_equal( glue_data(.x = list(x = "blah"), "{x}{z}", z = x, y = stop("!")), "blahblah" ) expect_equal( glue_data(.x = NULL, "{x}{z}", x = "blah", y = stop("!"), z = x), "blahblah" ) expect_equal( glue_data(.x = NULL, "blahblah", y = stop("!"), z = x), "blahblah" ) expect_equal( glue_data(.x = NULL, "blahblah", x = x, y = stop("!"), z = x), "blahblah" ) }) test_that("converting glue to character", { expect_identical(as.character(glue("foo bar")), "foo bar") }) test_that("converting glue to glue", { expect_equal(glue("foo bar"), "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_equal(glue("foo", character(0)), character(0)) expect_equal(glue("foo", NULL), character(0)) expect_equal(glue("foo", NULL, "bar"), character(0)) expect_equal(glue("foo", "{character(0)}"), character(0)) expect_equal(glue("foo {character(0)}"), character(0)) }) test_that("values are trimmed before evaluation", { x <- " a1\n b2\n c3" expect_equal( glue(" A {x} B "), "A a1 b2 c3 B") }) test_that("glue works with alternative delimiters", { expect_equal(glue("{1}", .open = "", .close = ""), "{1}") expect_equal(glue("{{}}", .open = "", .close = ""), "{{}}") expect_equal(glue("<<1>>", .open = "<<", .close = ">>"), "1") expect_equal(glue("<<<<>>>>", .open = "<<", .close = ">>"), "<<>>") expect_equal(glue("{{1}}", .open = "{{", .close = "}}"), "1") expect_equal(glue("{{ {{1}} }}", .open = "{{", .close = "}}"), "1") expect_equal(glue("{{ {{{1}}} }}", .open = "{{", .close = "}}"), "1") expect_equal(glue("{{ {{{{1}}}} }}", .open = "{{", .close = "}}"), "1") expect_equal(glue("[letters[[1]]]", .open = "[", .close = "]"), "a") expect_equal(glue("[[ letters[[1]] ]]", .open = "[[", .close = "]]"), "a") }) test_that("you can disable trimming in glue and glue_data", { expect_equal(glue("\nfoo\n"), "foo") expect_equal(glue("\nfoo\n", .trim = FALSE), "\nfoo\n") expect_equal(glue_data(list(), "\nfoo\n"), "foo") expect_equal(glue_data(list(), "\nfoo\n", .trim = FALSE), "\nfoo\n") }) 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(glue(x), x_out) expect_identical(glue("{x}"), x_out) expect_equal(Encoding(glue(x)), "UTF-8") expect_equal(Encoding(glue("{x}")), "UTF-8") y <- "p\u00E4o" Encoding(y) <- "UTF-8" y_out <- as_glue(enc2utf8(y)) expect_identical(glue(y), y_out) expect_identical(glue("{y}"), y_out) expect_equal(Encoding(glue(y)), "UTF-8") expect_equal(Encoding(glue("{y}")), "UTF-8") xy_out <- as_glue(paste0(x_out, y_out)) expect_identical(glue(x, y), xy_out) expect_identical(glue("{x}{y}"), xy_out) expect_equal(Encoding(glue(x, y)), "UTF-8") expect_equal(Encoding(glue("{x}{y}")), "UTF-8") expect_equal(Encoding(glue_collapse(x)), "UTF-8") skip_on_os(c("mac", "linux", "solaris")) withr::with_locale(c(LC_CTYPE = "Chinese (Simplified)_China.936"), { z <- "{format(as.Date(\"2018-01-04\"), \"%Y\U5E74\")}" z_out <- glue(z) expect_equal(Encoding(z_out), "UTF-8") expect_equal(z_out, "2018\U5E74") }) }) test_that("glue always returns NA_character_ if given any NA input and `.na` == NULL", { expect_equal( glue("{NA}", .na = NULL), NA_character_) expect_equal( glue(NA, .na = NULL), NA_character_) expect_equal( glue(NA, 1, .na = NULL), NA_character_) expect_equal( glue(1, NA, 2, .na = NULL), NA_character_) x <- c("foo", NA_character_, "bar") expect_equal( glue("{x}", .na = NULL), c("foo", NA_character_, "bar")) expect_equal( glue("{1:3} - {x}", .na = NULL), c("1 - foo", NA_character_, "3 - bar")) }) test_that("glue always returns .na if given any NA input and `.na` != NULL", { expect_equal( glue("{NA}", .na = "foo"), "foo") expect_equal( glue("{NA}", .na = "foo"), "foo") expect_equal( glue(NA, .na = "foo"), "foo") expect_equal( glue(NA, 1, .na = "foo"), "foo1") expect_equal( glue(1, NA, 2, .na = "foo"), "1foo2") x <- c("foo", NA_character_, "bar") expect_equal( glue("{x}", .na = "baz"), c("foo", "baz", "bar")) expect_equal( glue("{1:3} - {x}", .na = "baz"), c("1 - foo", "2 - baz", "3 - bar")) }) test_that("glue always returns character() if given any NULL input if `.null` == character()", { expect_equal( glue("{NULL}", .null = character()), character()) expect_equal( glue("{}", .null = character()), character()) expect_equal( glue(NULL, .null = character()), character()) expect_equal( glue(NULL, 1, .null = character()), character()) expect_equal( glue(1, NULL, 2, .null = character()), character()) expect_equal( glue("x: ", if (FALSE) "positive", .null = character()), character()) expect_equal( glue("x: {NULL}", .null = character()), character()) }) test_that("glue drops any NULL input if `.null` == NULL", { # This should work like `paste0()` expect_equal( glue("{NULL}", .null = NULL), character()) expect_equal( glue("{}", .null = NULL), character()) expect_equal( glue(NULL, .null = NULL), character()) expect_equal( glue(NULL, 1, .null = NULL), "1") expect_equal( glue(1, NULL, 2, .null = NULL), "12") expect_equal( glue("x: ", if (FALSE) "positive", .null = NULL), "x: ") expect_equal( glue("x: {NULL}", .null = NULL), "x: ") }) test_that("glue replaces NULL input if `.null` is not NULL or character()", { expect_equal( glue("{NULL}", .null = "foo"), "foo") expect_equal( glue("{}", .null = "foo"), "foo") expect_equal( glue(NULL, .null = "foo"), "foo") expect_equal( glue(NULL, 1, .null = "foo"), "foo1") expect_equal( glue(1, NULL, 2, .null = "foo"), "1foo2") expect_equal( glue("x: ", if (FALSE) "positive", .null = "foo"), "x: foo") expect_equal( glue("x: {NULL}", .null = "foo"), "x: foo") }) test_that("glue works within functions", { x <- 1 f <- function(msg) glue(msg, .envir = parent.frame()) expect_equal(f("{x}"), "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_equal( glue("a", "very", "long", "test", "of", "how", "many", "unnamed", "arguments", "you", "can", "have"), "averylongtestofhowmanyunnamedargumentsyoucanhave") }) test_that("glue does not drop it's class when subsetting", { expect_equal(glue("foo")[1], "foo") expect_equal(glue("foo")[[1]], "foo") expect_equal(glue("{1:2}")[2], "2") }) test_that("interpolation variables can have same names as their values (#89)", { x <- 1 expect_equal( glue("{x}", x = x + 1), "2") }) test_that("as_glue works", { expect_identical(as_glue(as_glue("x")), as_glue("x")) }) test_that("throws informative error if interpolating a function", { expect_error(glue("{cat}"), "is a function") # some crayon functions are OK, make sure this still works if (require("crayon")) { expect_s3_class(glue("{red}red{reset}"), "glue") } }) test_that("+ method for glue works", { expect_identical(glue("foo") + "bar", as_glue("foobar")) x <- 1 expect_identical(glue("x = ") + "{x}", glue("x = {x}")) }) test_that("unterminated quotes are error", { expect_error(glue("{this doesn\"t work}"), "Unterminated quote") expect_error(glue("{this doesn't work}"), "Unterminated quote") expect_error(glue("{this doesn`t work}"), "Unterminated quote") }) test_that("unterminated comment", { expect_error(glue("pre {1 + 5 # comment} post"), "Unterminated comment") expect_error(glue("pre {1 + 5 # comment"), "Unterminated comment") expect_equal(glue("pre {1 + 5 + #comment\n 4} post"), "pre 10 post") }) test_that("empty glue produces no output", { expect_equal(capture.output(print(glue())), character()) }) test_that("glue objects can be compared to regular strings", { expect_equal(capture.output(print(glue())), character()) }) test_that("glue can use different comment characters (#193)", { expect_equal( glue(.comment = "", "{foo#}", .transformer = function(x, ...) x), "foo#" ) }) test_that("`.literal` treats quotes and `#` as regular characters", { expect_snapshot( error = TRUE, glue("{'fo`o\"#}", .transformer = function(x, ...) x) ) expect_equal( glue("{'fo`o\"#}", .literal = TRUE, .transformer = function(x, ...) x), "'fo`o\"#" ) }) test_that("`.literal` is not about (preventing) evaluation", { x <- "world" expect_equal(glue("hello {x}!"), glue("hello {x}!", .literal = TRUE)) }) glue/tests/testthat/test-safe.R0000644000176200001440000000045114152560265016234 0ustar liggesuserstest_that("glue and glue_data safe do not execute code", { expect_error(glue_safe("{1+1}"), "object '1\\+1' not found") expect_error(glue_data_safe(mtcars, "{1+1}"), "object '1\\+1' not found") "1 + 1" <- 5 expect_equal(glue("{1 + 1}"), "2") expect_equal(glue_safe("{1 + 1}"), "5") }) glue/tests/testthat/_snaps/0000755000176200001440000000000014156753073015506 5ustar liggesusersglue/tests/testthat/_snaps/glue.md0000644000176200001440000000026514156753073016767 0ustar liggesusers# `.literal` treats quotes and `#` as regular characters Code glue("{'fo`o\"#}", .transformer = function(x, ...) x) Error Unterminated quote (') glue/tests/testthat/_snaps/color.md0000644000176200001440000000105614156753073017150 0ustar liggesusers# glue_col() can exploit the `.literal` argument Code glue_col("Colorless {green idea's} sleep furiously") Error Unterminated quote (') --- Code glue_col("Colorless {green idea\"s} sleep furiously") Error Unterminated quote (") --- Code glue_col("Colorless {green idea`s} sleep furiously") Error Unterminated quote (`) --- Code glue_col("Hey a URL: {blue https://example.com/#section}") Error Unterminated comment glue/tests/testthat/test-trim.R0000644000176200001440000001000014156753073016265 0ustar liggesuserstest_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("\x20\x20\x20\x20\x20\x20 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) }) test_that("lines containing only indentation are handled properly", { # Tabs and spaces are considered indentation. The following examples look # funny because I'm using a tab escape as the last indentation character to # prevent RStudio from removing trailing whitespace on save. expect_identical( trim(" \ta \tb \t \tc"), "a\nb\n\nc" ) expect_identical( trim(" \ta \tb \t \tc"), " \ta\nb\n \t\n \tc" ) # A line shorter than min_indent that contains only indentation should not be # trimmed, removed, or prepended to the next line. expect_identical( trim(" \ta \tb \t \tc"), "a\nb\n \t\nc" ) # Ensure empty intermedite lines are handled properly expect_identical( trim(" \ta \tb \tc"), "a\nb\n\nc" ) }) # https://github.com/tidyverse/glue/issues/238 test_that("indent counter resets at newline", { # whitespace-only line has 1 space < min_indent (which is 2) # comment in trim_() says: # "if the line consists only of tabs and spaces, and if the line is # shorter than min_indent, copy the entire line" expect_identical(trim("\n \n abcd"), " \nabcd") # whitespace-only line has n spaces, n >= min_indent expect_identical( trim("\n \n abcd"), "\nabcd") expect_identical(trim("\n \n abcd"), " \nabcd") }) # https://github.com/tidyverse/glue/issues/247 test_that("trailing whitespace-only line doesn't goof up indentation", { expect_identical(trim("\n A\n\n"), "A\n") # comment in trim_() says: # "if the line consists only of tabs and spaces, and if the line is # shorter than min_indent, copy the entire line" expect_identical(trim("\n A\n \n"), "A\n ") expect_identical(trim("\n A\n \n"), "A\n") expect_identical(trim("\n A\n \n"), "A\n ") }) glue/tests/testthat/test-color.R0000644000176200001440000000707114156753073016446 0ustar liggesuserstest_that("glue_col() is just glue() when it should be", { skip_if_not_installed("crayon") expect_identical(glue_col("foo"), as_glue("foo")) expect_identical(glue_col("1 + 1 = {1 + 1}"), glue("1 + 1 = {1 + 1}")) }) test_that("glue_col() applies crayon functions, crayon not attached", { skip_if_not_installed("crayon") skip_if("crayon" %in% (.packages())) expect_identical(glue_col("{blue foo}"), as_glue(crayon::blue("foo"))) }) test_that("glue_col() applies crayon functions, crayon is attached", { skip_if_not_installed("crayon") if(!"crayon" %in% (.packages())) { withr::local_package("crayon") } blue_and_white <- bgBlue $ white expect_identical(glue_col("{blue_and_white foo}"), as_glue(blue_and_white("foo"))) expect_identical(glue_col("{blue_and_white {1 + 1}}"), as_glue(blue_and_white("2"))) }) test_that("glue_col() works on multiline strings", { skip_if_not_installed("crayon") expect_identical( glue_col(" {red foo bar }"), as_glue(crayon::red("foo\nbar"))) }) test_that("glue_col() works on nested colors", { skip_if_not_installed("crayon") if(!"crayon" %in% (.packages())) { withr::local_package("crayon") } expect_identical( glue_col("{red This is a {green serious} problem}"), as_glue(red("This is a " %+% green("serious") %+% " problem")) ) }) test_that("glue_col() errors for invalid syntax or when color_fun can't be found", { expect_error(glue_col("{_}"), "unexpected input") expect_error(glue_col("{foo _}"), "object 'foo' of mode 'function' was not found") foo <- 1 expect_error(glue_col("{foo _}"), "object 'foo' of mode 'function' was not found") foo <- crayon::blue expect_identical(glue_col("{foo _}"), as_glue(foo("_"))) }) test_that("glue_data_col() works", { skip_if_not_installed("crayon") if(!"crayon" %in% (.packages())) { withr::local_package("crayon") } mt <- head(mtcars) expect_identical( glue_data_col(mt, "A {blue {gear}} speed car with {bold {hp}} hp!"), as_glue("A " %+% blue(mt$gear) %+% " speed car with " %+% bold(mt$hp) %+% " hp!") ) }) # https://github.com/tidyverse/glue/issues/158 test_that("glue_col() can exploit the `.literal` argument", { skip_if_not_installed("crayon") if(!"crayon" %in% (.packages())) { withr::local_package("crayon") } # single quote expect_snapshot( error = TRUE, glue_col("Colorless {green idea's} sleep furiously") ) expect_identical( glue_col("Colorless {green idea's} sleep furiously", .literal = TRUE), as_glue("Colorless " %+% green("idea's") %+% " sleep furiously") ) # double quote expect_snapshot( error = TRUE, glue_col('Colorless {green idea"s} sleep furiously') ) expect_identical( glue_col('Colorless {green idea"s} sleep furiously', .literal = TRUE), as_glue("Colorless " %+% green('idea"s') %+% " sleep furiously") ) # backtick expect_snapshot( error = TRUE, glue_col("Colorless {green idea`s} sleep furiously") ) expect_identical( glue_col("Colorless {green idea`s} sleep furiously", .literal = TRUE), as_glue("Colorless " %+% green("idea`s") %+% " sleep furiously") ) # `#` expect_snapshot( error = TRUE, glue_col("Hey a URL: {blue https://example.com/#section}") ) expect_identical( glue_col("Hey a URL: {blue https://example.com/#section}", .literal = TRUE), as_glue("Hey a URL: " %+% blue("https://example.com/#section")) ) }) test_that("`.literal` does not prevent evaluation", { expect_identical( glue_col("{blue 1 + 1' = {1 + 1}}", .literal = TRUE), as_glue("1 + 1' = 2") ) }) glue/tests/testthat/test-sql.R0000644000176200001440000001154114156753073016124 0ustar liggesusersskip_if_not_installed("DBI") skip_if_not_installed("RSQLite") 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("quotes Id identifiers", { var <- DBI::Id(schema = "foo", table = "bar", column = "baz") expect_identical(glue_sql("{`var`}", .con = con), DBI::SQL("`foo`.`bar`.`baz`")) }) it("quotes lists of Id identifiers", { var <- c( DBI::Id(schema = "foo", table = "bar", column = "baz"), DBI::Id(schema = "foo", table = "bar", column = "baz2") ) expect_identical(glue_sql("{`var`*}", .con = con), DBI::SQL("`foo`.`bar`.`baz`, `foo`.`bar`.`baz2`")) }) 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'")) }) it('collapses values should return NULL for length zero vector', { expect_identical(glue_sql("{var*}", .con = con, var = character()), DBI::SQL("NULL")) expect_identical(glue_sql("{var*}", .con = con, var = DBI::SQL(character())), DBI::SQL("NULL")) }) it("should return an SQL NULL by default for missing values", { var <- list(NA, NA_character_, NA_real_, NA_integer_) expect_identical(glue_sql("x = {var}", .con = con), rep(DBI::SQL("x = NULL"), 4)) }) it("should return NA for missing values and .na = NULL", { var <- list(NA, NA_character_, NA_real_, NA_integer_) expect_identical(glue_sql("x = {var}", .con = con, .na = NULL), rep(DBI::SQL(NA), 4)) }) it("should preserve the type of the even with missing values (#130)", { expect_identical(glue_sql("x = {c(1L, NA)}", .con = con), DBI::SQL(c(paste0("x = ", c(1, "NULL"))))) expect_identical(glue_sql("x = {c(1, NA)}", .con = con), DBI::SQL(c(paste0("x = ", c(1, "NULL"))))) expect_identical(glue_sql("x = {c('1', NA)}", .con = con), DBI::SQL(c(paste0("x = ", c("'1'", "NULL"))))) expect_identical(glue_sql("x = {c(TRUE, NA)}", .con = con), DBI::SQL(c(paste0("x = ", c("TRUE", "NULL"))))) }) it("should return NA for missing values quote strings", { var <- c("C", NA) expect_identical(glue_sql("x = {var}", .con = con), DBI::SQL(c("x = 'C'", "x = NULL"))) }) it("should return a quoted date for Dates", { var <- as.Date("2019-01-01") expect_identical(glue_sql("x = {var}", .con = con), DBI::SQL("x = '2019-01-01'")) }) it("should quote values from lists properly", { var <- list(1, 2, "three") expect_identical(glue_sql("x = {var}", .con = con), DBI::SQL(c("x = 1", "x = 2", "x = 'three'"))) }) it("should handle NA when collapsing (#185)", { expect_identical(glue_sql("x IN ({c(NA, 'A')*})", .con = con), DBI::SQL(paste0("x IN (NULL, 'A')"))) expect_identical(glue_sql("x IN ({c(NA, 1)*})", .con = con), DBI::SQL(paste0("x IN (NULL, 1)"))) expect_identical(glue_sql("x IN ({c(NA, 1L)*})", .con = con), DBI::SQL(paste0("x IN (NULL, 1)"))) expect_identical(glue_sql("x IN ({c(NA, TRUE)*})", .con = con), DBI::SQL(paste0("x IN (NULL, TRUE)"))) }) it("should handle DBI::SQL() elements correctly when collapsing (#191)", { expect_identical(glue_sql("x IN ({DBI::SQL(c('a','b'))*})", .con = con), DBI::SQL(paste0("x IN (a, b)"))) }) it("should allow whitespace after the *", { x <- 1:3 expect_identical( glue_sql(.con = con, "{x* }"), DBI::SQL(paste0("1, 2, 3")) ) }) }) 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")) }) }) describe("glue_sql_collapse", { it("returns an SQL object", { expect_identical( glue_sql_collapse(character()), DBI::SQL(character()) ) expect_identical( glue_sql_collapse(c("foo", "bar", "baz")), DBI::SQL("foobarbaz") ) }) }) glue/tests/testthat/test-quoting.R0000644000176200001440000000157014152560265017007 0ustar liggesuserstest_that("single_quote works", { expect_identical(single_quote(character()), character()) expect_identical(single_quote(NA), NA_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(NA), NA_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(NA), NA_character_) expect_identical(backtick(""), '``') expect_identical(backtick(1:5), c("`1`", "`2`", "`3`", "`4`", "`5`" )) }) glue/tests/testthat.R0000644000176200001440000000006414152560265014341 0ustar liggesuserslibrary(testthat) library(glue) test_check("glue") glue/src/0000755000176200001440000000000014172662407012006 5ustar liggesusersglue/src/init.c0000644000176200001440000000072314156753073013121 0ustar liggesusers#include #include #include #include // for NULL /* .Call calls */ extern SEXP glue_(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP trim_(SEXP); static const R_CallMethodDef CallEntries[] = { {"glue_", (DL_FUNC)&glue_, 6}, {"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.c0000644000176200001440000001165114156753073013114 0ustar liggesusers#define STRICT_R_HEADERS #define R_NO_REMAP #include "Rinternals.h" #include #include SEXP set(SEXP x, int i, SEXP val) { R_xlen_t len = Rf_xlength(x); if (i >= len) { len *= 2; x = Rf_lengthgets(x, len); } SET_VECTOR_ELT(x, i, val); return x; } SEXP resize(SEXP out, R_xlen_t n) { if (n == Rf_xlength(out)) { return out; } return Rf_xlengthgets(out, n); } SEXP glue_( SEXP x, SEXP f, SEXP open_arg, SEXP close_arg, SEXP comment_arg, SEXP literal_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); char comment_char = '\0'; if (Rf_xlength(comment_arg) > 0) { comment_char = CHAR(STRING_ELT(comment_arg, 0))[0]; } Rboolean literal = LOGICAL(literal_arg)[0]; int delim_equal = strncmp(open, close, open_len) == 0; SEXP out = Rf_allocVector(VECSXP, 1); 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; size_t i = 0; for (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 { if (!literal && xx[i] == comment_char) { state = comment; } else { switch (xx[i]) { case '\'': if (!literal) { state = single_quote; } break; case '"': if (!literal) { state = double_quote; } break; case '`': if (!literal) { state = backtick; } break; }; } } if (delim_level == 0) { /* Result of the current glue statement */ SEXP expr = PROTECT(Rf_ScalarString( Rf_mkCharLenCE(&xx[start], (i - close_len) + 1 - start, CE_UTF8))); SEXP call = PROTECT(Rf_lang2(f, expr)); SEXP result = PROTECT(Rf_eval(call, R_EmptyEnv)); /* text in between last glue statement */ if (j > 0) { str[j] = '\0'; SEXP str_ = PROTECT(Rf_ScalarString(Rf_mkCharLenCE(str, j, CE_UTF8))); REPROTECT(out = set(out, k++, str_), out_idx); UNPROTECT(1); } REPROTECT(out = set(out, k++, result), out_idx); /* Clear the string buffer */ memset(str, 0, j); j = 0; UNPROTECT(3); state = text; } break; } }; } if (k == 0 || j > 0) { str[j] = '\0'; SEXP str_ = PROTECT(Rf_ScalarString(Rf_mkCharLenCE(str, j, CE_UTF8))); REPROTECT(out = set(out, k++, str_), out_idx); UNPROTECT(1); } if (state == delim) { free(str); Rf_error("Expecting '%s'", close); } else if (state == single_quote) { free(str); Rf_error("Unterminated quote (')"); } else if (state == double_quote) { free(str); Rf_error("Unterminated quote (\")"); } else if (state == backtick) { free(str); Rf_error("Unterminated quote (`)"); } else if (state == comment) { free(str); Rf_error("Unterminated comment"); } free(str); out = resize(out, k); UNPROTECT(1); return out; } glue/src/trim.c0000644000176200001440000000610414156753073013130 0ustar liggesusers#define STRICT_R_HEADERS #define R_NO_REMAP #include "Rinternals.h" #include #include #include // for strlen(), strchr(), strncpy() SEXP trim_(SEXP x) { size_t len = LENGTH(x); SEXP out = PROTECT(Rf_allocVector(STRSXP, len)); size_t num; for (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; indent = 0; } 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 string ends with '\n', `indent = 0` only because we made it so */ if (xx[str_len - 1] != '\n' && 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) { size_t skipped = strspn(xx + i, "\t "); /* * if the line consists only of tabs and spaces, and if the line is * shorter than min_indent, copy the entire line and proceed to the * next */ if (*(xx + i + skipped) == '\n' && skipped < min_indent) { strncpy(str + j, xx + i, skipped); i += skipped; j += skipped; } else { if (i + min_indent < str_len && (xx[i] == ' ' || xx[i] == '\t')) { i += min_indent; } } new_line = false; continue; } 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/vignettes/0000755000176200001440000000000014172662407013227 5ustar liggesusersglue/vignettes/speed.Rmd0000644000176200001440000000707214156753073015003 0ustar liggesusers--- title: "Speed of glue" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Speed of glue} %\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("EVAL_VIGNETTES", "FALSE")), cache = FALSE) library(glue) ``` ```{r setup2, include = FALSE} plot_comparison <- function(x, ...) { library(ggplot2) library(microbenchmark) 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, message = FALSE} bar <- "baz" simple <- microbenchmark::microbenchmark( glue = glue::glue("foo{bar}"), gstring = R.utils::gstring("foo${bar}"), paste0 = paste0("foo", bar), sprintf = sprintf("foo%s", bar), str_interp = stringr::str_interp("foo${bar}"), rprintf = rprintf::rprintf("foo$bar", bar = bar) ) print(unit = "eps", order = "median", signif = 4, simple) plot_comparison(simple) ``` While `glue()` is slower than `paste0`,`sprintf()` it is twice as fast as `str_interp()` and `gstring()`, and on par with `rprintf()`. Although `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, and so was removed. ```{r, message = FALSE} 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 further testing. glue/vignettes/transformers.Rmd0000644000176200001440000001367614156753073016437 0ustar liggesusers--- 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 <- eval(parse(text = text, keep.source = FALSE), 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 <- eval(parse(text = text, keep.source = FALSE), envir) do.call(sprintf, list(glue("%{format}"), res)) } else { eval(parse(text = text, keep.source = FALSE), envir) } } glue_fmt <- function(..., .envir = parent.frame()) { glue(..., .transformer = sprintf_transformer, .envir = .envir) } glue_fmt("π = {pi:.3f}") ``` ### 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( eval(parse(text = text, keep.source = FALSE), 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/vignettes/engines.Rmd0000644000176200001440000000564214172662167015335 0ustar liggesusers--- 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/R/0000755000176200001440000000000014172657456011430 5ustar liggesusersglue/R/color.R0000644000176200001440000000606314156753073012670 0ustar liggesusers#' Construct strings with color #' #' @description #' The [crayon][crayon::crayon] package defines a number of functions used to #' color terminal output. `glue_col()` and `glue_data_col()` functions provide #' additional syntax to make using these functions in glue strings easier. #' #' Using the following syntax will apply the function [crayon::blue()] to the text 'foo bar'. #' #' ``` #' {blue foo bar} #' ``` #' #' If you want an expression to be evaluated, simply place that in a normal brace #' expression (these can be nested). #' #' ``` #' {blue 1 + 1 = {1 + 1}} #' ``` #' #' If the text you want to color contains, e.g., an unpaired quote or a comment #' character, specify `.literal = TRUE`. #' #' @inheritParams glue #' @export #' @examplesIf require(crayon) #' library(crayon) #' #' glue_col("{blue foo bar}") #' #' glue_col("{blue 1 + 1 = {1 + 1}}") #' #' glue_col("{blue 2 + 2 = {green {2 + 2}}}") #' #' white_on_black <- bgBlack $ white #' glue_col("{white_on_black #' Roses are {red {colors()[[552]]}}, #' Violets are {blue {colors()[[26]]}}, #' `glue_col()` can show \\ #' {red c}{yellow o}{green l}{cyan o}{blue r}{magenta s} #' and {bold bold} and {underline underline} too! #' }") #' #' # this would error due to an unterminated quote, if we did not specify #' # `.literal = TRUE` #' glue_col("{yellow It's} happening!", .literal = TRUE) #' #' # `.literal = TRUE` also prevents an error here due to the `#` comment #' glue_col( #' "A URL: {magenta https://github.com/tidyverse/glue#readme}", #' .literal = TRUE #' ) #' #' # `.literal = TRUE` does NOT prevent evaluation #' x <- "world" #' y <- "day" #' glue_col("hello {x}! {green it's a new {y}!}", .literal = TRUE) glue_col <- function(..., .envir = parent.frame(), .na = "NA", .literal = FALSE) { glue(..., .envir = .envir, .na = .na, .literal = .literal, .transformer = color_transformer) } #' @rdname glue_col #' @export glue_data_col <- function(.x, ..., .envir = parent.frame(), .na = "NA", .literal = FALSE) { glue_data(.x, ..., .envir = .envir, .na = .na, .literal = .literal, .transformer = color_transformer) } color_transformer <- function(code, envir) { res <- tryCatch(parse(text = code, keep.source = FALSE), error = function(e) e) if (!inherits(res, "error")) { return(eval(res, envir = envir)) } code <- glue_collapse(code, "\n") m <- regexpr("(?s)^([[:alnum:]_]+)[[:space:]]+(.+)", code, perl = TRUE) has_match <- m != -1 if (!has_match) { stop(res) } starts <- attr(m, "capture.start") ends <- starts + attr(m, "capture.length") - 1L captures <- substring(code, starts, ends) fun <- captures[[1]] text <- captures[[2]] out <- glue(text, .envir = envir, .transformer = color_transformer) color_fun <- get0(fun, envir = envir, mode = "function") if (is.null(color_fun) && requireNamespace("crayon", quietly = TRUE)) { color_fun <- get0(fun, envir = asNamespace("crayon"), mode = "function") } if (is.null(color_fun)) { # let nature take its course, i.e. throw the usual error get(fun, envir = envir, mode = "function") } else { color_fun(out) } } glue/R/utils.R0000644000176200001440000000405514152560265012704 0ustar liggesusershas_names <- function(x) { nms <- names(x) if (is.null(nms)) { rep(FALSE, length(x)) } else { !(is.na(nms) | nms == "") } } bind_args <- function(args, parent) { assign_env <- parent nms <- names(args) for (i in seq_along(args)) { eval_env <- assign_env assign_env <- new.env(parent = eval_env) delayed_assign(nms[[i]], args[[i]], eval.env = eval_env, assign.env = assign_env) } assign_env } # 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)) } na_rows <- function(res) { Reduce(`|`, lapply(res, is.na)) } "%||%" <- function(x, y) if (is.null(x)) y else x # nocov drop_null <- function(x) { x[!vapply(x, is.null, logical(1))] } # A version of delayedAssign which does _not_ use substitute delayed_assign <- function(x, value, eval.env = parent.frame(1), assign.env = parent.frame(1)) { do.call(delayedAssign, list(x, value, eval.env, assign.env)) } ## @export compare.glue <- function(x, y, ...) { if (identical(class(y), "character")) { class(x) <- NULL } NextMethod("compare") } ## @export compare_proxy.glue <- function(x, path = "x") { class(x) <- NULL NextMethod("compare_proxy") } glue/R/zzz.R0000644000176200001440000000147614172601757012411 0ustar liggesusers# nocov start .onLoad <- function(...) { s3_register("testthat::compare", "glue") s3_register("waldo::compare_proxy", "glue") s3_register("vctrs::vec_ptype2", "glue.glue") s3_register("vctrs::vec_ptype2", "character.glue") s3_register("vctrs::vec_ptype2", "glue.character") s3_register("vctrs::vec_cast", "glue.glue") s3_register("vctrs::vec_cast", "character.glue") s3_register("vctrs::vec_cast", "glue.character") if (isNamespaceLoaded("knitr") && "knit_engines" %in% getNamespaceExports("knitr")) { knitr::knit_engines$set(glue = eng_glue, glue_sql = eng_glue_sql, gluesql = eng_glue_sql) } else { setHook(packageEvent("knitr", "onLoad"), function(...) { knitr::knit_engines$set(glue = eng_glue, glue_sql = eng_glue_sql, gluesql = eng_glue_sql) }) } invisible() } #nocov end glue/R/compat-s3-register.R0000644000176200001440000001204514152560265015172 0ustar liggesusers# This source code file is licensed under the unlicense license # https://unlicense.org # nocov start #' Register a method for a suggested dependency #' #' Generally, the recommended way to register an S3 method is to use the #' `S3Method()` namespace directive (often generated automatically by the #' `@export` roxygen2 tag). However, this technique requires that the generic #' be in an imported package, and sometimes you want to suggest a package, #' and only provide a method when that package is loaded. `s3_register()` #' can be called from your package's `.onLoad()` to dynamically register #' a method only if the generic's package is loaded. #' #' For R 3.5.0 and later, `s3_register()` is also useful when demonstrating #' class creation in a vignette, since method lookup no longer always involves #' the lexical scope. For R 3.6.0 and later, you can achieve a similar effect #' by using "delayed method registration", i.e. placing the following in your #' `NAMESPACE` file: #' #' ``` #' if (getRversion() >= "3.6.0") { #' S3method(package::generic, class) #' } #' ``` #' #' @section Usage in other packages: #' To avoid taking a dependency on vctrs, you copy the source of #' [`s3_register()`](https://github.com/r-lib/rlang/blob/master/R/compat-register.R) #' into your own package. It is licensed under the permissive #' [unlicense](https://choosealicense.com/licenses/unlicense/) to make it #' crystal clear that we're happy for you to do this. There's no need to include #' the license or even credit us when using this function. #' #' @param generic Name of the generic in the form `"pkg::generic"`. #' @param class Name of the class #' @param method Optionally, the implementation of the method. By default, #' this will be found by looking for a function called `generic.class` #' in the package environment. #' @examples #' # A typical use case is to dynamically register tibble/pillar methods #' # for your class. That way you avoid creating a hard dependency on packages #' # that are not essential, while still providing finer control over #' # printing when they are used. #' #' .onLoad <- function(...) { #' s3_register("pillar::pillar_shaft", "vctrs_vctr") #' s3_register("tibble::type_sum", "vctrs_vctr") #' } #' @keywords internal #' @noRd s3_register <- function(generic, class, method = NULL) { stopifnot(is.character(generic), length(generic) == 1) stopifnot(is.character(class), length(class) == 1) pieces <- strsplit(generic, "::")[[1]] stopifnot(length(pieces) == 2) package <- pieces[[1]] generic <- pieces[[2]] caller <- parent.frame() get_method_env <- function() { top <- topenv(caller) if (isNamespace(top)) { asNamespace(environmentName(top)) } else { caller } } get_method <- function(method, env) { if (is.null(method)) { get(paste0(generic, ".", class), envir = get_method_env()) } else { method } } register <- function(...) { envir <- asNamespace(package) # Refresh the method each time, it might have been updated by # `devtools::load_all()` method_fn <- get_method(method) stopifnot(is.function(method_fn)) # Only register if generic can be accessed if (exists(generic, envir)) { registerS3method(generic, class, method_fn, envir = envir) } else if (identical(Sys.getenv("NOT_CRAN"), "true")) { warn <- .rlang_s3_register_compat("warn") warn(c( sprintf( "Can't find generic `%s` in package %s to register S3 method.", generic, package ), "i" = "This message is only shown to developers using devtools.", "i" = sprintf("Do you need to update %s to the latest version?", package) )) } } # Always register hook in case package is later unloaded & reloaded setHook(packageEvent(package, "onLoad"), function(...) { register() }) # Avoid registration failures during loading (pkgload or regular). # Check that environment is locked because the registering package # might be a dependency of the package that exports the generic. In # that case, the exports (and the generic) might not be populated # yet (#1225). if (isNamespaceLoaded(package) && environmentIsLocked(asNamespace(package))) { register() } invisible() } .rlang_s3_register_compat <- function(fn) { # Compats that behave the same independently of rlang's presence out <- switch( fn, is_installed = return(function(pkg) requireNamespace(pkg, quietly = TRUE)) ) # Fall back to base compats is_interactive_compat <- function() { opt <- getOption("rlang_interactive") if (!is.null(opt)) { opt } else { interactive() } } format_msg <- function(x) paste(x, collapse = "\n") switch( fn, is_interactive = return(is_interactive_compat), abort = return(function(msg) stop(format_msg(msg), call. = FALSE)), warn = return(function(msg) warning(format_msg(msg), call. = FALSE)), inform = return(function(msg) message(format_msg(msg))) ) stop(sprintf("Internal error in rlang shims: Unknown function `%s()`.", fn)) } # nocov end glue/R/vctrs.R0000644000176200001440000000065414152560265012706 0ustar liggesusers # Registered in .onLoad() vec_ptype2.glue.glue <- function(x, y, ...) { x } vec_ptype2.glue.character <- function(x, y, ...) { x } vec_ptype2.character.glue <- function(x, y, ...) { y } # Note order of class is the opposite as for ptype2 vec_cast.glue.glue <- function(x, to, ...) { x } vec_cast.glue.character <- function(x, to, ...) { as_glue(x) } vec_cast.character.glue <- function(x, to, ...) { unclass(x) } glue/R/glue.R0000644000176200001440000002577714156753073012523 0ustar liggesusers#' Format and interpolate a string #' #' Expressions enclosed by braces will be evaluated as R code. Long strings are #' broken by line and concatenated together. Leading whitespace and blank lines #' from the first and last lines are automatically trimmed. #' #' @param .x \[`listish`]\cr An environment, list, or data frame used to lookup values. #' @param ... \[`expressions`]\cr Unnamed arguments are taken to be expression #' string(s) to format. Multiple inputs are concatenated together before formatting. #' Named arguments are taken to be temporary variables available for substitution. #' @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. If `NULL` is passed, it is equivalent to [emptyenv()]. #' @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 propagated, that is an `NA` result will #' cause `NA` output. Otherwise the value is replaced by the value of `.na`. #' @param .null \[`character(1)`: \sQuote{character()}]\cr Value to replace #' NULL values with. If `character()` whole output is `character()`. If #' `NULL` all NULL values are dropped (as in `paste0()`). Otherwise the #' value is replaced by the value of `.null`. #' @param .comment \[`character(1)`: \sQuote{#}]\cr Value to use as the comment #' character. #' @param .literal \[`boolean(1)`: \sQuote{FALSE}]\cr Whether to treat single or #' double quotes, backticks, and comments as regular characters (vs. as #' syntactic elements), when parsing the expression string. Setting `.literal #' = TRUE` probably only makes sense in combination with a custom #' `.transformer`, as is the case with `glue_col()`. Regard this argument #' (especially, its name) as experimental. #' @param .trim \[`logical(1)`: \sQuote{TRUE}]\cr Whether to trim the input #' template with [trim()] or not. #' @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 be used to assign temporary variables. #' 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()` can also be used in user defined functions #' intro <- function(name, profession, country){ #' glue("My name is {name}, a {profession}, from {country}") #' } #' intro("Shelmith", "Senior Data Analyst", "Kenya") #' intro("Cate", "Data Scientist", "Kenya") #' #' # `glue_data()` is useful in magrittr pipes #' if (require(magrittr)) { #' #' mtcars %>% glue_data("{rownames(.)} has {hp} hp") #' #' # Or within dplyr pipelines #' if (require(dplyr)) { #' #' head(iris) %>% #' mutate(description = glue("This {Species} has a petal length of {Petal.Length}")) #' #' }} #' #' # 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", .null = character(), .comment = "#", .literal = FALSE, .transformer = identity_transformer, .trim = TRUE) { if (is.null(.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 #' @examples #' glue_collapse(glue("{1:10}")) #' #' # Wide values can be truncated #' glue_collapse(glue("{1:10}"), width = 5) #' #' glue_collapse(1:4, ", ", last = " and ") #' #> 1, 2, 3 and 4 #' @export glue_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 <- 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. #' @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 #' @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") 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) { glue(e1, 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.R0000644000176200001440000000210114156753073012455 0ustar liggesusers#' 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 #' @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.R0000644000176200001440000000074414152560265014107 0ustar liggesusers#' 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) { eval(parse(text = text, keep.source = FALSE), envir) } glue/R/sql.R0000644000176200001440000001566614172657456012370 0ustar liggesusers#' 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_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://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 #' @seealso [glue_sql_collapse()] to collapse [DBI::SQL()] objects. #' @param .con \[`DBIConnection`]: A DBI connection object obtained from #' [DBI::dbConnect()]. #' @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(table = iris_db, column = "sepal_length"), #' DBI::Id(table = iris_db, column = "sepal_width"), #' DBI::Id(table = nicknames_db, column = "nickname") #' ) #' #' iris_species <- DBI::Id(table = iris_db, column = "species") #' nicknames_species <- DBI::Id(table = nicknames_db, column = "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, .envir = parent.frame(), .na = DBI::SQL("NULL")) { DBI::SQL(glue(..., .envir = .envir, .na = .na, .transformer = sql_quote_transformer(.con, .na))) } #' @rdname glue_sql #' @export glue_data_sql <- function(.x, ..., .con, .envir = parent.frame(), .na = DBI::SQL("NULL")) { DBI::SQL(glue_data(.x, ..., .envir = .envir, .na = .na, .transformer = sql_quote_transformer(.con, .na))) } #' @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 <- eval(parse(text = text, keep.source = FALSE), 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 <- eval(parse(text = text, keep.source = FALSE), envir) if (inherits(res, "SQL")) { if (should_collapse) { res <- glue_collapse(res, ", ") } if (length(res) == 0L) { res <- DBI::SQL("NULL") } return(res) } # convert objects to characters is_object <- is.object(res) if (is_object) { res <- as.character(res) } is_na <- is.na(res) if (any(is_na)) { res[is_na] <- rep(list(.na), sum(is_na)) } is_char <- vapply(res, function(x) !is.na(x) && is.character(x), logical(1)) res[is_char] <- lapply(res[is_char], function(x) DBI::dbQuoteLiteral(conn = connection, x)) res[!is_char] <- lapply(res[!is_char], function(x) DBI::SQL(conn = connection, x)) } if (should_collapse) { res <- glue_collapse(res, ", ") } if (length(res) == 0L) { res <- DBI::SQL("NULL") } res } } glue/R/quoting.R0000644000176200001440000000115214152560265013225 0ustar liggesusers#' Quoting operators #' #' These functions make it easy to quote each individual element and are useful #' in conjunction with [glue_collapse()]. #' @param x A character to quote. #' @name quoting #' @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.R0000644000176200001440000000200014156753073012664 0ustar liggesusers# 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.md0000644000176200001440000001534514172662167012330 0ustar liggesusers# 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/MD50000644000176200001440000000540714173114312011521 0ustar liggesusersee645e5aed9326e8a10c197069439013 *DESCRIPTION 4237883d0dfeba9df8257ddf7ebbe5db *LICENSE 5f7a0689117abfe9ca4956b1b044e768 *NAMESPACE fa764af9918809da529466ec5f0992d3 *NEWS.md 3a923b9894718e115935095deec42221 *R/color.R 631cff00b52e1ea98eac1dead5843a4e *R/compat-s3-register.R 47f5f286b6f89a209dc51e49e616d7a0 *R/glue.R b4496d2d90fc7d40c70db0385c01d9db *R/knitr.R 979260ebd687de0d0dd9f40d8cd4e23d *R/quoting.R 748b731e47a678da33556e60cc6b9145 *R/safe.R 6f812d53a2a11d120bc79235bc7a2479 *R/sql.R 6165b52f7c742eb23db02a3e0b43a8d8 *R/transformer.R bbf77a0024fee3412f09e864cccb49ca *R/utils.R 5ef3a3667cb2c2566368b6e3b9c7c0e0 *R/vctrs.R c3c6982aa0feecfc2294eb891554536f *R/zzz.R 38a4d4cc8dfb28b17bdcf43f767ae221 *README.md 272fc33325db2d930b52444b47bc7af7 *build/vignette.rds 9523369b7eb6dc1cabd769ecdf851ddb *inst/doc/engines.R 504669e9296d5ad4e194f62a6a4df4bf *inst/doc/engines.Rmd 8825f61f68e5ff9e5f16c48b9ca11d05 *inst/doc/engines.html ddf50f1c992301b657d69d8d2d551887 *inst/doc/speed.R 927ca206aeb2fdb6f25a798561481aef *inst/doc/speed.Rmd 27f02aed6c253a4a1bbb048e0ee29b18 *inst/doc/speed.html 5520c708fd10578fb7359abc134f2771 *inst/doc/transformers.R d13c9c321aece241cc4d8e71391c46ff *inst/doc/transformers.Rmd f609b2fad4be5d5827209ad3b2b039f2 *inst/doc/transformers.html 428090ffb747ed472a50927771a36cce *man/as_glue.Rd ac7e2258d7284d18ab570e161fa682d0 *man/figures/logo.png 35c0e85621f51cad1feee0b2e4e9424c *man/glue-deprecated.Rd c197b44445106523b2eb6aaba911a220 *man/glue.Rd 78765d0c07b034730f3bfd1c5b5f3ee5 *man/glue_col.Rd ca6072a614b39cc4aaa1137e52057f97 *man/glue_collapse.Rd fdb6d2b38ea156aab8368aa57eb0f71f *man/glue_safe.Rd 2350fece8bde5618d0b7fb3cbfedc58e *man/glue_sql.Rd a362a9409917bcd234edbd1679f31a96 *man/identity_transformer.Rd dd485d410a879378383f426e2118a33d *man/quoting.Rd 5fddb316469cd71d5d17898ec1b9acd4 *man/trim.Rd 5787572cd8914e81c393a9731778cd73 *src/glue.c d1c5e16c1a8e50ec9beabb469d71db6e *src/init.c a7adb36e545b3379fa1ff13654f90750 *src/trim.c 2b2d5c82e65ffac3ce2300a7ba32fa68 *tests/testthat.R 365fed0fa8e98975528df604912c5737 *tests/testthat/_snaps/color.md e618c766c98e8519609540801db57d0e *tests/testthat/_snaps/glue.md 31ca0b92dd1272b6cbc79ed379bae5b8 *tests/testthat/test-collapse.R 10c9df7d3e52325eb679c9f0131d18a1 *tests/testthat/test-color.R 4df1ecd140bc7b52662a2e0e07ff3aad *tests/testthat/test-glue.R ea7ddf76c230c86181dae7fdb34426a2 *tests/testthat/test-quoting.R 4080c704a40ace6499f1bd928b920952 *tests/testthat/test-safe.R 08fb8a7b43f1637f004824ea433fe2ed *tests/testthat/test-sql.R b0901ca36bdbc54cb3472eb46f6f1f4a *tests/testthat/test-trim.R f76fda874c02b458da45e20c2d4163c3 *tests/testthat/test-vctrs.R 504669e9296d5ad4e194f62a6a4df4bf *vignettes/engines.Rmd 927ca206aeb2fdb6f25a798561481aef *vignettes/speed.Rmd d13c9c321aece241cc4d8e71391c46ff *vignettes/transformers.Rmd glue/inst/0000755000176200001440000000000014172662404012171 5ustar liggesusersglue/inst/doc/0000755000176200001440000000000014172662404012736 5ustar liggesusersglue/inst/doc/engines.R0000644000176200001440000000071614172662402014513 0ustar liggesusers## ----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.html0000644000176200001440000010720414172662404016355 0ustar liggesusers 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.

library(glue)

collapse transformer

A transformer which automatically collapses any glue block ending with *.

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 = ", "))
#> 1, 2, 3, 4, 5
#> a, b, c, d, e

glue("{1:5*}\n{letters[1:5]*}", .transformer = collapse_transformer(sep = ", ", last = " and "))
#> 1, 2, 3, 4 and 5
#> a, b, c, d and e

x <- c("one", "two")
glue("{x}: {1:5*}", .transformer = collapse_transformer(sep = ", "))
#> one: 1, 2, 3, 4, 5
#> two: 1, 2, 3, 4, 5

Shell quoting transformer

A transformer which automatically quotes variables for use in shell commands, e.g. via system() or system2().

shell_transformer <- function(type = c("sh", "csh", "cmd", "cmd2")) {
  type <- match.arg(type)
  function(text, envir) {
    res <- eval(parse(text = text, keep.source = FALSE), 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
#> cat 'test'
system(command)

emoji transformer

A transformer which converts the text to the equivalent emoji.

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:")
#> one ❤️
glue_ji("many :heart*:")
#> many 💘❤️💟💌

sprintf transformer

A transformer which allows succinct sprintf format strings.

sprintf_transformer <- function(text, envir) {
  m <- regexpr(":.+$", text)
  if (m != -1) {
    format <- substring(regmatches(text, m), 2)
    regmatches(text, m) <- ""
    res <- eval(parse(text = text, keep.source = FALSE), envir)
    do.call(sprintf, list(glue("%{format}"), res))
  } else {
    eval(parse(text = text, keep.source = FALSE), envir)
  }
}

glue_fmt <- function(..., .envir = parent.frame()) {
  glue(..., .transformer = sprintf_transformer, .envir = .envir)
}
glue_fmt("π = {pi:.3f}")
#> π = 3.142

safely transformer

A transformer that acts like purrr::safely(), which returns a value instead of an error.

safely_transformer <- function(otherwise = NA) {
  function(text, envir) {
    tryCatch(
      eval(parse(text = text, keep.source = FALSE), 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}")
#> foo: NA

# Or an empty string
glue_safely("foo: {xyz}", .otherwise = "Error")
#> foo: Error

# Or output the error message in red
library(crayon)
glue_safely("foo: {xyz}", .otherwise = quote(glue("{red}Error: {conditionMessage(e)}{reset}")))
#> foo: Error: object 'xyz' not found

“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. It’s actually more general: you can use it with an expression input such as {expr=}.

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)
#> For some random numbers = [28, 80, 22, 9], average = 34.75, sum = 139.

a <- 3
b <- 5.6
glue("{a=}\n{b=}\n{a * 9 + b * 2=}", .transformer = vv_transformer)
#> a = 3
#> b = 5.6
#> a * 9 + b * 2 = 38.2
glue/inst/doc/speed.html0000644000176200001440000004447714172662403014743 0ustar liggesusers Speed of glue

Speed of glue

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.

Simple concatenation

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().

Although 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, and so was removed.

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 further testing.↩︎

glue/inst/doc/speed.Rmd0000644000176200001440000000707214156753073014515 0ustar liggesusers--- title: "Speed of glue" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Speed of glue} %\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("EVAL_VIGNETTES", "FALSE")), cache = FALSE) library(glue) ``` ```{r setup2, include = FALSE} plot_comparison <- function(x, ...) { library(ggplot2) library(microbenchmark) 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, message = FALSE} bar <- "baz" simple <- microbenchmark::microbenchmark( glue = glue::glue("foo{bar}"), gstring = R.utils::gstring("foo${bar}"), paste0 = paste0("foo", bar), sprintf = sprintf("foo%s", bar), str_interp = stringr::str_interp("foo${bar}"), rprintf = rprintf::rprintf("foo$bar", bar = bar) ) print(unit = "eps", order = "median", signif = 4, simple) plot_comparison(simple) ``` While `glue()` is slower than `paste0`,`sprintf()` it is twice as fast as `str_interp()` and `gstring()`, and on par with `rprintf()`. Although `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, and so was removed. ```{r, message = FALSE} 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 further testing. glue/inst/doc/transformers.Rmd0000644000176200001440000001367614156753073016151 0ustar liggesusers--- 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 <- eval(parse(text = text, keep.source = FALSE), 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 <- eval(parse(text = text, keep.source = FALSE), envir) do.call(sprintf, list(glue("%{format}"), res)) } else { eval(parse(text = text, keep.source = FALSE), envir) } } glue_fmt <- function(..., .envir = parent.frame()) { glue(..., .transformer = sprintf_transformer, .envir = .envir) } glue_fmt("π = {pi:.3f}") ``` ### 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( eval(parse(text = text, keep.source = FALSE), 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/speed.R0000644000176200001440000000324114172662403014160 0ustar liggesusers## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = as.logical(Sys.getenv("EVAL_VIGNETTES", "FALSE")), cache = FALSE) library(glue) ## ----setup2, include = FALSE-------------------------------------------------- # plot_comparison <- function(x, ...) { # library(ggplot2) # library(microbenchmark) # 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) # } ## ---- message = FALSE--------------------------------------------------------- # bar <- "baz" # # simple <- # microbenchmark::microbenchmark( # glue = glue::glue("foo{bar}"), # gstring = R.utils::gstring("foo${bar}"), # paste0 = paste0("foo", bar), # sprintf = sprintf("foo%s", bar), # str_interp = stringr::str_interp("foo${bar}"), # rprintf = rprintf::rprintf("foo$bar", bar = bar) # ) # # print(unit = "eps", order = "median", signif = 4, simple) # # plot_comparison(simple) ## ---- message = FALSE--------------------------------------------------------- # 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) glue/inst/doc/engines.html0000644000176200001440000004401214172662402015253 0ustar liggesusers 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
model hp mpg
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.Rmd0000644000176200001440000000564214172662167015047 0ustar liggesusers--- 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.R0000644000176200001440000001023014172662403015601 0ustar liggesusers## ---- 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 <- eval(parse(text = text, keep.source = FALSE), 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 <- eval(parse(text = text, keep.source = FALSE), envir) do.call(sprintf, list(glue("%{format}"), res)) } else { eval(parse(text = text, keep.source = FALSE), envir) } } glue_fmt <- function(..., .envir = parent.frame()) { glue(..., .transformer = sprintf_transformer, .envir = .envir) } glue_fmt("π = {pi:.3f}") ## ----------------------------------------------------------------------------- safely_transformer <- function(otherwise = NA) { function(text, envir) { tryCatch( eval(parse(text = text, keep.source = FALSE), 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)