glue/0000755000176200001440000000000015170340345011210 5ustar liggesusersglue/tests/0000755000176200001440000000000015064746373012367 5ustar liggesusersglue/tests/testthat/0000755000176200001440000000000015170340345014212 5ustar liggesusersglue/tests/testthat/test-vctrs.R0000644000176200001440000000345115170242707016461 0ustar liggesuserstest_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-quoting.R0000644000176200001440000000141715170242707017006 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/test-color.R0000644000176200001440000000704415170242707016440 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_snapshot(error = TRUE, glue_col("{%}")) expect_snapshot(error = TRUE, glue_col("{foo %}")) foo <- 1 expect_snapshot(error = TRUE, glue_col("{foo %}")) 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-safe.R0000644000176200001440000000042315170242707016232 0ustar liggesuserstest_that("glue and glue_data safe do not execute code", { expect_snapshot(glue_safe("{1+1}"), error = TRUE) expect_snapshot(glue_data_safe(mtcars, "{1+1}"), error = TRUE) "1 + 1" <- 5 expect_equal(glue("{1 + 1}"), "2") expect_equal(glue_safe("{1 + 1}"), "5") }) glue/tests/testthat/test-glue.R0000644000176200001440000005242415170242707016260 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_snapshot(glue("{NoTfOuNd}"), error = TRUE) }) test_that("glue ignores trailing empty argument", { expect_equal(glue("x", ), glue("x")) }) test_that("glue errors if invalid format", { expect_snapshot(glue("x={x"), error = TRUE) }) 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_snapshot(glue(1:2, "{1:2}"), error = TRUE) }) test_that("error if not simple recycling", { expect_snapshot(glue("{1:2}{1:10}"), error = TRUE) }) 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_snapshot(glue("{cat}"), error = TRUE) # some crayon functions are OK, make sure this still works if (require("crayon", quietly = TRUE)) { expect_s3_class(glue("{red}red{reset}"), "glue") } }) test_that("`+` method for glue works", { expect_identical(glue("foo") + "bar", "foobar") expect_identical("foo" + glue("bar"), "foobar") }) test_that("`+` method requires character vectors", { expect_snapshot(error = TRUE, { as_glue("a") + 1 1 + as_glue("a") }) }) test_that("`+` method does not interpolate twice", { expect_identical(glue("{x}", x = "{wut}") + "y", "{wut}y") }) test_that("`+` method returns length-0 if there is a length-0 input", { expect_identical(as_glue("hello") + character(), character()) }) test_that("`+` method returns length-0 if there is a `NULL` input", { expect_identical(as_glue("hello") + NULL, character()) }) test_that("`+` recycles", { x <- c("a", "b", "c") expect_identical("(" + as_glue(x) + ")", paste0("(", x, ")")) y <- as.character(1:3) expect_identical(as_glue(x) + y, c("a1", "b2", "c3")) }) test_that("`+` method errors for inputs of incompatible size", { expect_snapshot(error = TRUE, { as_glue(letters[1:2]) + letters[1:3] }) }) test_that("unterminated quotes are error", { expect_snapshot(glue("{this doesn\"t work}"), error = TRUE) expect_snapshot(glue("{this doesn't work}"), error = TRUE) expect_snapshot(glue("{this doesn`t work}"), error = TRUE) }) test_that("unterminated comment", { expect_snapshot( error = TRUE, glue("pre {1 + 5 # comment} post") ) expect_snapshot( error = TRUE, glue("pre {1 + 5 # 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_collapse ---------------------------------------------------------- test_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("")) 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 empty string for 0 length input", { expect_identical(glue_collapse(character()), as_glue("")) }) 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_) ) }) # trim ------------------------------------------------------------------- test_that("trim works", { expect_identical("", trim("")) expect_identical(character(), trim(character())) expect_identical(" ", trim(" ")) expect_identical("test", trim("test")) expect_identical(" test", trim(" test")) expect_identical("test ", trim("test ")) expect_identical("test", trim("test")) expect_identical(c("foo", "bar"), trim(c("foo", "bar"))) expect_identical(c("foo", "bar"), trim(c("\nfoo", "bar\n"))) expect_identical( "test", trim( "test" ) ) expect_identical( "test", x <- trim( "test " ) ) expect_identical( "test", trim( "\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/_snaps/0000755000176200001440000000000015170263227015500 5ustar liggesusersglue/tests/testthat/_snaps/safe.md0000644000176200001440000000037315170262544016744 0ustar liggesusers# glue and glue_data safe do not execute code Code glue_safe("{1+1}") Condition Error: ! object '1+1' not found --- Code glue_data_safe(mtcars, "{1+1}") Condition Error: ! object '1+1' not found glue/tests/testthat/_snaps/glue.md0000644000176200001440000000426215170262544016763 0ustar liggesusers# glue errors if the expression fails Code glue("{NoTfOuNd}") Condition Error: ! Failed to evaluate glue component {NoTfOuNd} Caused by error: ! object 'NoTfOuNd' not found # glue errors if invalid format Code glue("x={x") Condition Error in `glue_data()`: ! Expecting '}' # error if non length 1 inputs Code glue(1:2, "{1:2}") Condition Error: ! All unnamed arguments must be length 1 # error if not simple recycling Code glue("{1:2}{1:10}") Condition Error: ! Variables must be length 1 or 10 # throws informative error if interpolating a function Code glue("{cat}") Condition Error: ! glue cannot interpolate functions into strings. * object 'cat' is a function. # `+` method requires character vectors Code as_glue("a") + 1 Condition Error in `+.glue`: ! RHS must be a character vector. Code 1 + as_glue("a") Condition Error in `+.glue`: ! LHS must be a character vector. # `+` method errors for inputs of incompatible size Code as_glue(letters[1:2]) + letters[1:3] Condition Error: ! Variables must be length 1 or 3 # unterminated quotes are error Code glue("{this doesn\"t work}") Condition Error in `glue_data()`: ! Unterminated quote (") --- Code glue("{this doesn't work}") Condition Error in `glue_data()`: ! Unterminated quote (') --- Code glue("{this doesn`t work}") Condition Error in `glue_data()`: ! Unterminated quote (`) # unterminated comment Code glue("pre {1 + 5 # comment} post") Condition Error in `glue_data()`: ! A '#' comment in a glue expression must terminate with a newline. --- Code glue("pre {1 + 5 # comment") Condition Error in `glue_data()`: ! A '#' comment in a glue expression must terminate with a newline. # `.literal` treats quotes and `#` as regular characters Code glue("{'fo`o\"#}", .transformer = function(x, ...) x) Condition Error in `glue_data()`: ! Unterminated quote (') glue/tests/testthat/_snaps/r4.5/0000755000176200001440000000000015170263227016170 5ustar liggesusersglue/tests/testthat/_snaps/r4.5/sql.md0000644000176200001440000000037215170263227017313 0ustar liggesusers# glue_sql / errors if no connection given Code glue_sql("{var}") Condition Error: ! error in evaluating the argument 'conn' in selecting a method for function 'dbQuoteLiteral': argument ".con" is missing, with no default glue/tests/testthat/_snaps/sql.md0000644000176200001440000000145415170263227016625 0ustar liggesusers# glue_sql / errors if no connection given Code glue_sql("{var}") Condition Error in `glue_sql()`: ! `.con` is absent but must be supplied. # glue_data_sql / errors if no connection given Code glue_data_sql(mtcars, "{head(gear)*}") Condition Error in `glue_data_sql()`: ! `.con` is absent but must be supplied. # get nice errors if rlang installed Code glue_sql("{x + }", .con = con) Condition Error: ! Failed to parse glue component Caused by error in `parse()`: ! :2:0: unexpected end of input 1: x + ^ Code glue_sql("{NOTFOUND}", .con = con) Condition Error: ! Failed to evaluate glue component {NOTFOUND} Caused by error: ! object 'NOTFOUND' not found glue/tests/testthat/_snaps/transformer.md0000644000176200001440000000067115170262544020371 0ustar liggesusers# get nice errors if rlang installed Code identity_transformer("x + ") Condition Error: ! Failed to parse glue component Caused by error in `parse()`: ! :2:0: unexpected end of input 1: x + ^ Code identity_transformer("NOTFOUND") Condition Error: ! Failed to evaluate glue component {NOTFOUND} Caused by error: ! object 'NOTFOUND' not found glue/tests/testthat/_snaps/color.md0000644000176200001440000000221215170262543017135 0ustar liggesusers# glue_col() errors for invalid syntax or when color_fun can't be found Code glue_col("{%}") Condition Error in `parse()`: ! :1:1: unexpected input 1: % ^ --- Code glue_col("{foo %}") Condition Error in `get()`: ! object 'foo' of mode 'function' was not found --- Code glue_col("{foo %}") Condition Error in `get()`: ! object 'foo' of mode 'function' was not found # glue_col() can exploit the `.literal` argument Code glue_col("Colorless {green idea's} sleep furiously") Condition Error in `glue_data()`: ! Unterminated quote (') --- Code glue_col("Colorless {green idea\"s} sleep furiously") Condition Error in `glue_data()`: ! Unterminated quote (") --- Code glue_col("Colorless {green idea`s} sleep furiously") Condition Error in `glue_data()`: ! Unterminated quote (`) --- Code glue_col("Hey a URL: {blue https://example.com/#section}") Condition Error in `glue_data()`: ! A '#' comment in a glue expression must terminate with a newline. glue/tests/testthat/test-knitr.R0000644000176200001440000000214215170237027016442 0ustar liggesuserstest_that("glue engine handles a single-line chunk", { skip_if_not_installed("knitr") result <- knitr::knit( text = c( "```{glue}", "{1 + 1}", "```" ), quiet = TRUE ) expect_match(result, "2") }) test_that("glue engine handles a multiline chunk", { skip_if_not_installed("knitr") result <- knitr::knit( text = c( "```{glue}", "line 1", "line 2", "```" ), quiet = TRUE ) expect_match(result, "line 1\nline 2") }) test_that("glue engine interpolates variables from the knit environment", { skip_if_not_installed("knitr") result <- knitr::knit( text = c( "```{r, include=FALSE}", "name <- 'world'", "```", "", "```{glue}", "Hello {name}!", "```" ), quiet = TRUE ) expect_match(result, "Hello world!") }) test_that("glue engine passes chunk options through to glue", { skip_if_not_installed("knitr") result <- knitr::knit( text = c( "```{glue, .open = '<<', .close = '>>'}", "<<1 + 1>>", "```" ), quiet = TRUE ) expect_match(result, "2") }) glue/tests/testthat/test-transformer.R0000644000176200001440000000024215170237027017654 0ustar liggesuserstest_that("get nice errors if rlang installed", { expect_snapshot(error = TRUE, { identity_transformer("x + ") identity_transformer("NOTFOUND") }) }) glue/tests/testthat/test-sql.R0000644000176200001440000001274215170263227016122 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_snapshot(glue_sql("{var}"), error = TRUE) }) 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 empty values to NULL', { 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("mimics glue() when not collapsing", { expect_equal( glue_sql("{var}", .con = con, var = NULL), DBI::SQL(glue("{var}", var = 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 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("1", "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, 1)")) ) }) 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("errors if no connection given", { expect_snapshot(glue_data_sql(mtcars, "{head(gear)*}"), error = TRUE) }) 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("") ) expect_identical( glue_sql_collapse(c("foo", "bar", "baz")), DBI::SQL("foobarbaz") ) }) }) test_that("get nice errors if rlang installed", { con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:") on.exit(DBI::dbDisconnect(con)) expect_snapshot(error = TRUE, { glue_sql("{x + }", .con = con) glue_sql("{NOTFOUND}", .con = con) }) }) glue/tests/testthat.R0000644000176200001440000000006414152560265014341 0ustar liggesuserslibrary(testthat) library(glue) test_check("glue") glue/MD50000644000176200001440000000653315170340345011527 0ustar liggesusers38876ec1ee9121223fa691f25ad6542e *DESCRIPTION 0ef0e04b70ea4d2654a54d611a8a86d1 *LICENSE 5f7a0689117abfe9ca4956b1b044e768 *NAMESPACE 18e32e649bca15d2e873315afdd8bd1e *NEWS.md 759f689f193997e483295eac377dfbf0 *R/color.R 98140a413f4bea614598d9f2ceb1a00f *R/glue-package.R e52266590707185a27b92b14a4d093ce *R/glue.R f3bca322a78ff3a66398a0b8c482ee9e *R/import-standalone-s3-register.R c96799f077418ac30195fce02ac464b5 *R/knitr.R b2943310b5a60be5e18701fa21b98f79 *R/quoting.R afc3b02ea4fdc144de8a80d16946c223 *R/safe.R fa60563f848c90878b1e1ccaa0454927 *R/sql.R a86f23b5eaaa88977b16cd767d77e0f3 *R/transformer.R 1089d97e7a3408517b9b3ce5072b87b2 *R/utils.R 2bb3be5f66c5f52017b4be8346b54a5b *R/vctrs.R f95d429fd3cc3baa52e0d8e310e0124c *R/zzz.R e9c925f06ca14bfe7511a1d1b1e6b95b *README.md 480fb7140d1c4aeecfeec3c94ffd110f *build/vignette.rds 9523369b7eb6dc1cabd769ecdf851ddb *inst/doc/engines.R 663b682b30847e9755de17811ad38fb3 *inst/doc/engines.Rmd 7add0a46bc0219933e73884a1cd01f3e *inst/doc/engines.html 0faa0dbfdf09aa3fb2e9973047ef0118 *inst/doc/glue.R d15a2d46a207bb050085d9192795beee *inst/doc/glue.Rmd 0c71336380ddc85b78ce31dd7df5ede4 *inst/doc/glue.html 4de64ec771d84563ae1e64f04815fccf *inst/doc/transformers.R 6468ffbb31bed10a616346ca3f9e79b7 *inst/doc/transformers.Rmd e03026f791bd4f2beab43df5bd913c13 *inst/doc/transformers.html cfc5cfe0198c2c663745f6644aa899d0 *inst/doc/wrappers.R 98663f0dacbf9aba2621d0d62cb8ca7a *inst/doc/wrappers.Rmd eecad0de31bccc36751960f44a1aaf2c *inst/doc/wrappers.html 6894cecea92c0ba0cf824e216b7042d2 *man/as_glue.Rd 687ff5fe231707218ab78a7689b8011d *man/figures/logo.png 2fc2df8b5b91a9621aa0b250cf1a3341 *man/glue-package.Rd 0df32198f0470e089ae573e661465f09 *man/glue.Rd 176b311af39b54f92009cdda00bd2e01 *man/glue_col.Rd 52e3a135753a411c01cfba3d927e945b *man/glue_collapse.Rd 47a82803d28cdc14a0f7f90c95b779a9 *man/glue_safe.Rd 67bece1a92b64de5e3df58304c1da1ce *man/glue_sql.Rd b2cd06641ad3dcfbf1aaad7d2b34a488 *man/identity_transformer.Rd 39d55283753f4db4d32a0fa129f8538d *man/quoting.Rd 0b0bb19845895e2d2337bbef664c3e38 *man/trim.Rd d25d5af44b59cd40d3830b54f7a7cf7f *src/Makevars 455ddc98c78c5b6b4bd7bda409adc918 *src/glue.c 182706fd7bf7e47b2831c7ce18a85dfc *src/init.c a7adb36e545b3379fa1ff13654f90750 *src/trim.c 2b2d5c82e65ffac3ce2300a7ba32fa68 *tests/testthat.R 01d75900d0be3642c61752e9c1cd860b *tests/testthat/_snaps/color.md b2ee6f8c3c2777411ab0100116991b66 *tests/testthat/_snaps/glue.md 9e18020598aebe9a362e7834dd8dfea8 *tests/testthat/_snaps/r4.5/sql.md 8aa51506583d74c5327954b96ed049e4 *tests/testthat/_snaps/safe.md 0583138054bd20f9b7c885d263cf7cbe *tests/testthat/_snaps/sql.md 90bca9501dcedfaf296a9a4699b576d4 *tests/testthat/_snaps/transformer.md 3311fcffe3a4777dc1858f6d1d322735 *tests/testthat/test-color.R 5cb35136d5ad0841a5fade3710390db3 *tests/testthat/test-glue.R 44444db37c7f3d6abba5f88e9dd095e7 *tests/testthat/test-knitr.R a65c872cd53440630c1fe1b3a9b8915a *tests/testthat/test-quoting.R 6a5e684f50398dfc6b236487004095ae *tests/testthat/test-safe.R c6afb4fb1bccda0f3074a3da773d9ef1 *tests/testthat/test-sql.R 47a958927b9f812e3d4e5b84f4b82a41 *tests/testthat/test-transformer.R 1e6367521260b7c52017f580eebff585 *tests/testthat/test-vctrs.R 663b682b30847e9755de17811ad38fb3 *vignettes/engines.Rmd d15a2d46a207bb050085d9192795beee *vignettes/glue.Rmd 6468ffbb31bed10a616346ca3f9e79b7 *vignettes/transformers.Rmd 98663f0dacbf9aba2621d0d62cb8ca7a *vignettes/wrappers.Rmd glue/.aspell/0000755000176200001440000000000015064746225012557 5ustar liggesusersglue/.aspell/glue.rds0000644000176200001440000000007014152560265014215 0ustar liggesusersb```b`fab`b2Hs'e|]c(glue/.aspell/defaults.R0000644000176200001440000000023114152560265014500 0ustar liggesusersRd_files <- vignettes <- R_files <- description <- list(encoding = "UTF-8", language = "en", dictionaries = c("en_stats", "glue")) glue/R/0000755000176200001440000000000015170263676011424 5ustar liggesusersglue/R/glue-package.R0000644000176200001440000000022415170242707014062 0ustar liggesusers#' @keywords internal "_PACKAGE" ## usethis namespace: start ## usethis namespace: end ## mockable bindings: start ## mockable bindings: end NULL glue/R/vctrs.R0000644000176200001440000000066415170237027012705 0ustar liggesusers# Lazily 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/zzz.R0000644000176200001440000000170615170242707012400 0ustar liggesusers# nocov start .onLoad <- function(...) { # Do not swap these for `@exportS3Method`, which has a nasty bug (#347) 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/sql.R0000644000176200001440000001674415170263676012362 0ustar liggesusers#' Interpolate strings with SQL escaping #' #' @description #' SQL databases often have custom quotation syntax for identifiers and strings #' which make writing SQL queries error prone and cumbersome to do. `glue_sql()` and #' `glue_data_sql()` are analogs to [glue()] and [glue_data()] which handle the #' SQL quoting. `glue_sql_collapse()` can be used to collapse [DBI::SQL()] objects. #' #' They automatically quote character results, quote identifiers if the glue #' expression is surrounded by backticks '\verb{`}' and do not quote #' non-characters such as numbers. If numeric data is stored in a character #' column (which should be quoted) pass the data to `glue_sql()` as a #' character. #' #' Returning the result with [DBI::SQL()] will suppress quoting if desired for #' a given value. #' #' Note [parameterized queries](https://solutions.posit.co/connections/db/best-practices/run-queries-safely/#parameterized-queries) #' are generally the safest and most efficient way to pass user defined #' values in a query, however not every database driver supports them. #' #' If you place a `*` at the end of a glue expression the values will be #' collapsed with commas, or if there are no values, produce `NULL`. #' This is useful for (e.g.) the #' [SQL IN Operator](https://www.w3schools.com/sql/sql_in.asp). #' @inheritParams glue #' @seealso [glue_sql_collapse()] to collapse [DBI::SQL()] objects. #' @param .con \[`DBIConnection`]: A DBI connection object obtained from #' [DBI::dbConnect()]. #' @param .na \[`character(1)`: `DBI::SQL("NULL")`]\cr Value to replace #' `NA` values with. If `NULL` missing values are propagated, that is an `NA` #' result will cause `NA` output. Otherwise the value is replaced by the #' value of `.na`. #' @return A [DBI::SQL()] object with the given query. #' @examplesIf requireNamespace("DBI", quietly = TRUE) && requireNamespace("RSQLite", quietly = TRUE) #' con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:") #' iris2 <- iris #' colnames(iris2) <- gsub("[.]", "_", tolower(colnames(iris))) #' DBI::dbWriteTable(con, "iris", iris2) #' var <- "sepal_width" #' tbl <- "iris" #' num <- 2 #' val <- "setosa" #' glue_sql(" #' SELECT {`var`} #' FROM {`tbl`} #' WHERE {`tbl`}.sepal_length > {num} #' AND {`tbl`}.species = {val} #' ", .con = con) #' #' # If sepal_length is store on the database as a character explicitly convert #' # the data to character to quote appropriately. #' glue_sql(" #' SELECT {`var`} #' FROM {`tbl`} #' WHERE {`tbl`}.sepal_length > {as.character(num)} #' AND {`tbl`}.species = {val} #' ", .con = con) #' #' #' # `glue_sql()` can be used in conjuction with parameterized queries using #' # `DBI::dbBind()` to provide protection for SQL Injection attacks #' sql <- glue_sql(" #' SELECT {`var`} #' FROM {`tbl`} #' WHERE {`tbl`}.sepal_length > ? #' ", .con = con) #' query <- DBI::dbSendQuery(con, sql) #' DBI::dbBind(query, list(num)) #' DBI::dbFetch(query, n = 4) #' DBI::dbClearResult(query) #' #' # `glue_sql()` can be used to build up more complex queries with #' # interchangeable sub queries. It returns `DBI::SQL()` objects which are #' # properly protected from quoting. #' sub_query <- glue_sql(" #' SELECT * #' FROM {`tbl`} #' ", .con = con) #' #' glue_sql(" #' SELECT s.{`var`} #' FROM ({sub_query}) AS s #' ", .con = con) #' #' # If you want to input multiple values for use in SQL IN statements put `*` #' # at the end of the value and the values will be collapsed and quoted appropriately. #' glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})", #' vals = 1, .con = con) #' #' glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})", #' vals = 1:5, .con = con) #' #' glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})", #' vals = "setosa", .con = con) #' #' glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})", #' vals = c("setosa", "versicolor"), .con = con) #' #' # If you need to reference variables from multiple tables use `DBI::Id()`. #' # Here we create a new table of nicknames, join the two tables together and #' # select columns from both tables. Using `DBI::Id()` and the special #' # `glue_sql()` syntax ensures all the table and column identifiers are quoted #' # appropriately. #' #' iris_db <- "iris" #' nicknames_db <- "nicknames" #' #' nicknames <- data.frame( #' species = c("setosa", "versicolor", "virginica"), #' nickname = c("Beachhead Iris", "Harlequin Blueflag", "Virginia Iris"), #' stringsAsFactors = FALSE #' ) #' #' DBI::dbWriteTable(con, nicknames_db, nicknames) #' #' cols <- list( #' DBI::Id(iris_db, "sepal_length"), #' DBI::Id(iris_db, "sepal_width"), #' DBI::Id(nicknames_db, "nickname") #' ) #' #' iris_species <- DBI::Id(iris_db, "species") #' nicknames_species <- DBI::Id(nicknames_db, "species") #' #' query <- glue_sql(" #' SELECT {`cols`*} #' FROM {`iris_db`} #' JOIN {`nicknames_db`} #' ON {`iris_species`}={`nicknames_species`}", #' .con = con #' ) #' query #' #' DBI::dbGetQuery(con, query, n = 5) #' #' DBI::dbDisconnect(con) #' @export glue_sql <- function( ..., .con, .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = DBI::SQL("NULL"), .null = character(), .comment = "#", .literal = FALSE, .trim = TRUE ) { if (missing(.con)) { stop("`.con` is absent but must be supplied.") } DBI::SQL(glue( ..., .sep = .sep, .envir = .envir, .open = .open, .close = .close, .na = .na, .null = .null, .comment = .comment, .literal = .literal, .transformer = sql_quote_transformer(.con, .na), .trim = .trim )) } #' @rdname glue_sql #' @export glue_data_sql <- function( .x, ..., .con, .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = DBI::SQL("NULL"), .null = character(), .comment = "#", .literal = FALSE, .trim = TRUE ) { if (missing(.con)) { stop("`.con` is absent but must be supplied.") } DBI::SQL(glue_data( .x, ..., .sep = .sep, .envir = .envir, .open = .open, .close = .close, .na = .na, .null = .null, .comment = .comment, .literal = .literal, .transformer = sql_quote_transformer(.con, .na), .trim = .trim )) } #' @rdname glue_collapse #' @export glue_sql_collapse <- function(x, sep = "", width = Inf, last = "") { DBI::SQL(glue_collapse(x, sep = sep, width = width, last = last)) } sql_quote_transformer <- function(connection, .na) { if (is.null(.na)) { .na <- DBI::SQL(NA) } function(text, envir) { should_collapse <- grepl("[*][[:space:]]*$", text) if (should_collapse) { text <- sub("[*][[:space:]]*$", "", text) } m <- gregexpr("^`|`$", text) is_quoted <- any(m[[1]] != -1) if (is_quoted) { regmatches(text, m) <- "" res <- identity_transformer(text, envir) if (length(res) == 1) { res <- DBI::dbQuoteIdentifier(conn = connection, res) } else { # Support lists as well res[] <- lapply(res, DBI::dbQuoteIdentifier, conn = connection) } } else { res <- identity_transformer(text, envir) if (length(res) == 0L && should_collapse) { return(DBI::SQL("NULL")) } if (inherits(res, "SQL")) { if (should_collapse) { res <- glue_collapse(res, ", ") } return(res) } } if (is.list(res)) { res <- unlist(lapply(res, DBI::dbQuoteLiteral, conn = connection)) } else { res <- DBI::dbQuoteLiteral(connection, res) } if (should_collapse) { res <- glue_collapse(res, ", ") } res } } glue/R/import-standalone-s3-register.R0000644000176200001440000001425615170237027017353 0ustar liggesusers# Standalone file: do not edit by hand # Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-s3-register.R # Generated by: usethis::use_standalone("r-lib/rlang", "s3-register") # ---------------------------------------------------------------------- # # --- # repo: r-lib/rlang # file: standalone-s3-register.R # last-updated: 2024-05-14 # license: https://unlicense.org # --- # # ## Changelog # # 2024-05-14: # # * Mentioned `usethis::use_standalone()`. # # 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 rlang, you copy the source of #' [`s3_register()`](https://github.com/r-lib/rlang/blob/main/R/standalone-s3-register.R) #' into your own package or with #' `usethis::use_standalone("r-lib/rlang", "s3-register")`. 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) { 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() }) # For compatibility with R < 4.1.0 where base isn't locked is_sealed <- function(pkg) { identical(pkg, "base") || environmentIsLocked(asNamespace(pkg)) } # 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) && is_sealed(package)) { register() } invisible() } .rlang_s3_register_compat <- function(fn, try_rlang = TRUE) { # Compats that behave the same independently of rlang's presence out <- switch( fn, is_installed = return(function(pkg) requireNamespace(pkg, quietly = TRUE)) ) # Only use rlang if it is fully loaded (#1482) if ( try_rlang && requireNamespace("rlang", quietly = TRUE) && environmentIsLocked(asNamespace("rlang")) ) { switch( fn, is_interactive = return(rlang::is_interactive) ) # Make sure rlang knows about "x" and "i" bullets if (utils::packageVersion("rlang") >= "0.4.2") { switch( fn, abort = return(rlang::abort), warn = return((rlang::warn)), inform = return(rlang::inform) ) } } # 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/color.R0000644000176200001440000000623715170242707012665 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 #' @inherit glue return #' @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.R0000644000176200001440000000425415170242707012704 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)) } # Lazily registered in `.onLoad()` #' @exportS3Method NULL compare.glue <- function(x, y, ...) { if (identical(class(y), "character")) { class(x) <- NULL } NextMethod("compare") } # Lazily registered in `.onLoad()` #' @exportS3Method NULL compare_proxy.glue <- function(x, path = "x") { class(x) <- NULL NextMethod("compare_proxy") } glue/R/knitr.R0000644000176200001440000000207715170242707012674 0ustar liggesuserseng_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(paste0(options$code, collapse = "\n")), glue_options) ) knitr::engine_output(options, options$code, out) } # nocov start 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/R/glue.R0000644000176200001440000002730615170263671012506 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. #' #' For `glue_data()`, elements in `...` override the values in `.x`. #' @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 two arguments, `text` #' and `envir`, where `text` is the unparsed string inside the glue block and #' `envir` is the execution environment. A `.transformer` lets you modify a #' glue block before, during, or after evaluation, allowing you to create your #' own custom `glue()`-like functions. See `vignette("transformers")` for #' examples. #' @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. #' @returns A glue object, as created by [as_glue()]. #' @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 with the pipe #' head(iris, 3) |> #' glue_data("This {Species} has a petal length of {Petal.Length}") #' #' # 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 ) { .envir <- .envir %||% emptyenv() # Perform all evaluations in a temporary environment if (is.null(.x)) { stopifnot(is.environment(.envir)) 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(...))) # Trim off last argument if its empty so you can use a trailing comma n <- length(dots) if (n > 0 && identical(dots[[n]], quote(expr = ))) { dots <- dots[-n] } 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) ...elt(x) %||% .null) unnamed_args <- drop_null(unnamed_args) if (length(unnamed_args) == 0) { # This is equivalent to `paste0(NULL)` return(as_glue(character(0))) } lengths <- lengths(unnamed_args) if (any(lengths == 0)) { return(as_glue(character(0))) } if (any(lengths != 1)) { stop("All unnamed arguments must be length 1", call. = FALSE) } if (any(is.na(unnamed_args))) { if (is.null(.na)) { return(as_glue(NA_character_)) } else { unnamed_args[is.na(unnamed_args)] <- .na } } unnamed_args <- paste0(unnamed_args, collapse = .sep) if (isTRUE(.trim)) { unnamed_args <- trim(unnamed_args) } f <- function(expr) { eval_func <- .transformer(expr, env) %||% .null # crayon functions *can* be used, so we use tryCatch() # to give as.character() a chance to work tryCatch( # Output can be `NULL` only if `.null` is `NULL`. Then it should be # returned as is, because `as.character(NULL)` is `character()`. if (is.null(eval_func)) NULL else as.character(eval_func), error = function(e) { # if eval_func is a function, provide informative error-message if (is.function(eval_func)) { message <- paste0( "glue cannot interpolate functions into strings.\n", "* object '", expr, "' is a function." ) stop(message, call. = FALSE) } # default stop stop(e) } ) } # Parse any glue strings res <- .Call(glue_, unnamed_args, f, .open, .close, .comment, .literal) res <- drop_null(res) if (any(lengths(res) == 0)) { return(as_glue(character(0))) } if (!is.null(.na)) { res[] <- lapply(res, function(x) replace(x, is.na(x), .na)) } else { na_rows <- na_rows(res) } res <- do.call(paste0, recycle_columns(res)) if (is.null(.na)) { res <- replace(res, na_rows, NA) } as_glue(res) } #' @export #' @rdname glue glue <- function( ..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = "NA", .null = character(), .comment = "#", .literal = FALSE, .transformer = identity_transformer, .trim = TRUE ) { glue_data( .x = NULL, ..., .sep = .sep, .envir = .envir, .open = .open, .close = .close, .na = .na, .null = .null, .comment = .comment, .literal = .literal, .transformer = .transformer, .trim = .trim ) } #' Collapse a character vector #' #' `glue_collapse()` collapses a character vector of any length into a length 1 vector. #' `glue_sql_collapse()` does the same but returns a `[DBI::SQL()]` #' object rather than a glue object. #' #' @param x The character vector to collapse. #' @param width The maximum string width before truncating with `...`. #' @param last String used to separate the last two items if `x` has at least #' 2 items. #' @inheritParams base::paste #' @returns Always returns a length-1 glue object, as created by [as_glue()]. #' @examples #' glue_collapse(glue("{1:10}")) #' #' # Wide values can be truncated #' glue_collapse(glue("{1:10}"), width = 5) #' #' glue_collapse(1:4, ", ", last = " and ") #' @export glue_collapse <- function(x, sep = "", width = Inf, last = "") { if (length(x) == 0) { return(as_glue("")) } if (any(is.na(x))) { return(as_glue(NA_character_)) } if (nzchar(last) && length(x) > 1) { res <- glue_collapse(x[seq(1, length(x) - 1)], sep = sep, width = Inf) return(glue_collapse(paste0(res, last, x[length(x)]), width = width)) } x <- paste0(x, collapse = sep) if (width < Inf) { x_width <- nchar(x, "width") too_wide <- x_width > width if (too_wide) { x <- paste0(substr(x, 1, width - 3), "...") } } as_glue(x) } #' Trim a character vector #' #' This trims a character vector according to the trimming rules used by glue. #' These follow similar rules to [Python Docstrings](https://www.python.org/dev/peps/pep-0257/), #' with the following features. #' - Leading and trailing whitespace from the first and last lines is removed. #' - A uniform amount of indentation is stripped from the second line on, equal #' to the minimum indentation of all non-blank lines after the first. #' - Lines can be continued across newlines by using `\\`. #' @param x A character vector to trim. #' @returns A character vector. #' @export #' @examples #' glue(" #' A formatted string #' Can have multiple lines #' with additional indentation preserved #' ") #' #' glue(" #' \ntrailing or leading newlines can be added explicitly\n #' ") #' #' glue(" #' A formatted string \\ #' can also be on a \\ #' single line #' ") #' @useDynLib glue trim_ trim <- function(x) { has_newline <- function(x) any(grepl("\\n", x)) if (length(x) == 0 || !has_newline(x)) { return(x) } .Call(trim_, x) } #' @export print.glue <- function(x, ..., sep = "\n") { x[is.na(x)] <- style_na(x[is.na(x)]) if (length(x) > 0) { cat(x, ..., sep = sep) } invisible(x) } #' Coerce object to glue #' #' A glue object is a character vector with S3 class `"glue"`. The `"glue"` #' class implements a print method that shows the literal contents (rather than #' the string implementation) and a `+` method, so that you can concatenate with #' the addition operator. #' #' @param x object to be coerced. #' @param ... further arguments passed to methods. #' @returns A character vector with S3 class `"glue"`. #' @export #' @examples #' x <- as_glue(c("abc", "\"\\\\", "\n")) #' x #' #' x <- 1 #' y <- 3 #' glue("x + y") + " = {x + y}" as_glue <- function(x, ...) { UseMethod("as_glue") } #' @export as_glue.default <- function(x, ...) { as_glue(as.character(x)) } #' @export as_glue.glue <- function(x, ...) { x } #' @export as_glue.character <- function(x, ...) { class(x) <- c("glue", "character") enc2utf8(x) } #' @export as.character.glue <- function(x, ...) { unclass(x) } #' @export `[.glue` <- function(x, i, ...) { as_glue(NextMethod()) } #' @export `[[.glue` <- function(x, i, ...) { as_glue(NextMethod()) } #' @export `+.glue` <- function(e1, e2) { if (!is.null(e1) && !is.character(e1)) { stop("LHS must be a character vector.") } if (!is.null(e2) && !is.character(e2)) { stop("RHS must be a character vector.") } glue_data( "{e1}{e2}", .x = list(e1 = e1, e2 = e2), .envir = parent.frame() ) } #' @importFrom methods setOldClass setOldClass(c("glue", "character")) glue/R/quoting.R0000644000176200001440000000131215170237027013221 0ustar liggesusers#' Quoting operators #' #' These functions make it easy to quote each individual element and are useful #' in conjunction with [glue_collapse()]. These are thin wrappers around #' [base::encodeString()]. #' @param x A character to quote. #' @name quoting #' @inherit base::encodeString return #' @export #' @examples #' x <- 1:5 #' glue('Values of x: {glue_collapse(backtick(x), sep = ", ", last = " and ")}') single_quote <- function(x) { encodeString(x, quote = "'", na.encode = FALSE) } #' @rdname quoting #' @export double_quote <- function(x) { encodeString(x, quote = '"', na.encode = FALSE) } #' @rdname quoting #' @export backtick <- function(x) { encodeString(x, quote = "`", na.encode = FALSE) } glue/R/transformer.R0000644000176200001440000000166215170237027014105 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 = parent.frame()) { with_glue_error( expr <- parse(text = text, keep.source = FALSE), "Failed to parse glue component" ) with_glue_error( eval(expr, envir), paste0("Failed to evaluate glue component {", text, "}") ) } with_glue_error <- function(expr, message) { if (!requireNamespace("rlang", quietly = TRUE)) { return(expr) } withCallingHandlers( expr, error = function(cnd) { rlang::abort( message, parent = cnd, call = NULL ) } ) } glue/R/safe.R0000644000176200001440000000213115170237027012451 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 #' @inherit glue return #' @export #' @examples #' "1 + 1" <- 5 #' # glue actually executes the code #' glue("{1 + 1}") #' #' # glue_safe just looks up the value #' glue_safe("{1 + 1}") #' #' rm("1 + 1") glue_safe <- function(..., .envir = parent.frame()) { glue(..., .envir = .envir, .transformer = get_transformer) } #' @rdname glue_safe #' @export glue_data_safe <- function(.x, ..., .envir = parent.frame()) { glue_data(.x, ..., .envir = .envir, .transformer = get_transformer) } get_transformer <- function(text, envir) { if (!exists(text, envir = envir)) { stop("object '", text, "' not found", call. = FALSE) } else { get(text, envir = envir) } } glue/vignettes/0000755000176200001440000000000015170264116013221 5ustar liggesusersglue/vignettes/transformers.Rmd0000644000176200001440000001500215170263227016412 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 <- identity_transformer(text, envir) shQuote(res) } } glue_sh <- function(..., .envir = parent.frame(), .type = c("sh", "csh", "cmd", "cmd2")) { .type <- match.arg(.type) glue(..., .envir = .envir, .transformer = shell_transformer(.type)) } filename <- "test" writeLines(con = filename, "hello!") command <- glue_sh("cat {filename}") command system(command) ``` ```{r include = FALSE} if (file.exists("test")) { unlink("test") } ``` ### emoji transformer A transformer which converts the text to the equivalent emoji. ```{r, eval = require("emo")} emoji_transformer <- function(text, envir) { if (grepl("[*]$", text)) { text <- sub("[*]$", "", text) glue_collapse(ji_find(text)$emoji) } else { ji(text) } } glue_ji <- function(..., .envir = parent.frame()) { glue(..., .open = ":", .close = ":", .envir = .envir, .transformer = emoji_transformer) } glue_ji("one :heart:") glue_ji("many :heart*:") ``` ### sprintf transformer A transformer which allows succinct `sprintf` format strings. ```{r} sprintf_transformer <- function(text, envir) { m <- regexpr(":.+$", text) if (m != -1) { format <- substring(regmatches(text, m), 2) regmatches(text, m) <- "" res <- identity_transformer(text, envir) do.call(sprintf, list(glue("%{format}"), res)) } else { identity_transformer(text, envir) } } glue_fmt <- function(..., .envir = parent.frame()) { glue(..., .transformer = sprintf_transformer, .envir = .envir) } glue_fmt("π = {pi:.3f}") ``` ### signif transformer A transformer generator that represents numbers with a given number of significant digits. This is useful if we want to represent all numbers using the same significant digits ```{r} signif_transformer <- function(digits = 3) { force(digits) function(text, envir) { x <- identity_transformer(text, envir) if (is.numeric(x)) { signif(x, digits = digits) } else { x } } } glue_signif <- function(..., .envir = parent.frame()) { glue(..., .transformer = signif_transformer(3), .envir = .envir) } glue_signif("π = {pi}; 10π = {10*pi}; 100π = {100*pi}") ``` ### safely transformer A transformer that acts like `purrr::safely()`, which returns a value instead of an error. ```{r} safely_transformer <- function(otherwise = NA) { function(text, envir) { tryCatch( identity_transformer(text, envir), error = function(e) if (is.language(otherwise)) eval(otherwise) else otherwise) } } glue_safely <- function(..., .otherwise = NA, .envir = parent.frame()) { glue(..., .transformer = safely_transformer(.otherwise), .envir = .envir) } # Default returns missing if there is an error glue_safely("foo: {xyz}") # Or an empty string glue_safely("foo: {xyz}", .otherwise = "Error") # Or output the error message in red library(crayon) glue_safely("foo: {xyz}", .otherwise = quote(glue("{red}Error: {conditionMessage(e)}{reset}"))) ``` ### "Variables and Values" transformer A transformer that expands input of the form `{var_name=}` into `var_name = var_value`, i.e. a shorthand for exposing variable names with their values. This is inspired by an [f-strings feature coming in Python 3.8](https://docs.python.org/3.8/whatsnew/3.8.html#f-strings-now-support-for-quick-and-easy-debugging). It's actually more general: you can use it with an expression input such as `{expr=}`. ```{r} vv_transformer <- function(text, envir) { regex <- "=$" if (!grepl(regex, text)) { return(identity_transformer(text, envir)) } text <- sub(regex, "", text) res <- identity_transformer(text, envir) n <- length(res) res <- glue_collapse(res, sep = ", ") if (n > 1) { res <- c("[", res, "]") } glue_collapse(c(text, " = ", res)) } ``` ```{r} set.seed(1234) description <- "some random" numbers <- sample(100, 4) average <- mean(numbers) sum <- sum(numbers) glue("For {description} {numbers=}, {average=}, {sum=}.", .transformer = vv_transformer) a <- 3 b <- 5.6 glue("{a=}\n{b=}\n{a * 9 + b * 2=}", .transformer = vv_transformer) ``` glue/vignettes/glue.Rmd0000644000176200001440000002011315170263227014620 0ustar liggesusers--- title: "Introduction to glue" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Introduction to glue} %\VignetteEncoding{UTF-8} %\VignetteEngine{knitr::rmarkdown} editor_options: markdown: wrap: sentence --- ```{r, include = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ``` The glue package contains functions for string interpolation: gluing together character strings and R code. ```{r} library(glue) ``` ## Gluing and interpolating `glue()` can be used to glue together pieces of text: ```{r} glue("glue ", "some ", "text ", "together") ``` But glue's real power comes with `{}`: anything inside of `{}` is evaluated and pasted into the string. This makes it easy to interpolate variables: ```{r} name <- "glue" glue("We are learning how to use the {name} R package.") ``` As well as more complex expressions: ```{r} release_date <- as.Date("2017-06-13") glue("Release was on a {format(release_date, '%A')}.") ``` ## Control of line breaks `glue()` honors the line breaks in its input: ```{r} glue(" A formatted string Can have multiple lines with additional indentation preserved " ) ``` The example above demonstrates some other important facts about the pre-processing of the template string: - An empty first or last line is automatically trimmed. - Leading whitespace that is common across all lines is trimmed. The elimination of common leading whitespace is advantageous, because you aren't forced to choose between indenting your code normally and getting the output you actually want. This is easier to appreciate when you have `glue()` inside a function body (this example also shows an alternative way of styling the end of a `glue()` call): ```{r} foo <- function() { glue(" A formatted string Can have multiple lines with additional indentation preserved") } foo() ``` On the other hand, what if you don't want a line break in the output, but you also like to limit the length of lines in your source code to, e.g., 80 characters? The first option is to use `\\` to break the template string into multiple lines, without getting line breaks in the output: ```{r} release_date <- as.Date("2017-06-13") glue(" The first version of the glue package was released on \\ a {format(release_date, '%A')}.") ``` This comes up fairly often when an expression to evaluate inside `{}` takes up more characters than its result, i.e. `format(release_date, '%A')` versus `Tuesday`. A second way to achieve the same result is to break the template into individual pieces, which are then concatenated. ```{r} glue( "The first version of the glue package was released on ", "a {format(release_date, '%A')}." ) ``` If you want an explicit newline at the start or end, include an extra empty line. ```{r} # no leading or trailing newline x <- glue(" blah ") unclass(x) # both a leading and trailing newline y <- glue(" blah ") unclass(y) ``` We use `unclass()` above to make it easier to see the absence and presence of the newlines, i.e. to reveal the literal `\n` escape sequences. `glue()` and friends generally return a glue object, which is a character vector with the S3 class `"glue"`. The `"glue"` class exists primarily for the sake of a print method, which displays the natural formatted result of a glue string. Most of the time this is *exactly* what the user wants to see. The example above happens to be an exception, where we really do want to see the underlying string representation. Here's another example to drive home the difference between printing a glue object and looking at its string representation. `as.character()` is a another way to do this that is arguably more expressive. ```{r} x <- glue(' abc " } xyz') class(x) x unclass(x) as.character(x) ``` ## Delimiters By default, code to be evaluated goes inside `{}` in a glue string. If want a literal curly brace in your string, double it: ```{r} glue("The name of the package is {name}, not {{name}}.") ``` Sometimes it's just more convenient to use different delimiters altogether, especially if the template text comes from elsewhere or is subject to external requirements. Consider this example where we want to interpolate the function name into a code snippet that defines a function: ```{r} fn_def <- " <> <- function(x) { # imagine a function body here }" glue(fn_def, NAME = "my_function", .open = "<<", .close = ">>") ``` In this glue string, `{` and `}` have very special meaning. If we forced ourselves to double them, suddenly it doesn't look like normal R code anymore. Using alternative delimiters is a nice option in cases like this. ## Where glue looks for values By default, `glue()` evaluates the code inside `{}` in the caller environment: ```{r, eval = FALSE} glue(..., .envir = parent.frame()) ``` So, for a top-level `glue()` call, that means the global environment. ```{r} x <- "the caller environment" glue("By default, `glue()` evaluates code in {x}.") ``` But you can provide more narrowly scoped values by passing them to `glue()` in `name = value` form: ```{r} x <- "the local environment" glue( "`glue()` can access values from {x} or from {y}. {z}", y = "named arguments", z = "Woo!" ) ``` If the relevant data lives in a data frame (or list or environment), use `glue_data()` instead: ```{r} mini_mtcars <- head(cbind(model = rownames(mtcars), mtcars)) rownames(mini_mtcars) <- NULL glue_data(mini_mtcars, "{model} has {hp} hp.") ``` `glue_data()` is very natural to use with the pipe: ```{r, eval = getRversion() >= "4.1.0"} mini_mtcars |> glue_data("{model} gets {mpg} miles per gallon.") ``` Returning to `glue()`, recall that it defaults to evaluation in the caller environment. This has happy implications inside a `dplyr::mutate()` pipeline. The data-masking feature of `mutate()` means the columns of the target data frame are "in scope" for a `glue()` call: ```r library(dplyr) mini_mtcars |> mutate(note = glue("{model} gets {mpg} miles per gallon.")) |> select(note, cyl, disp) #> note cyl disp #> 1 Mazda RX4 gets 21 miles per gallon. 6 160 #> 2 Mazda RX4 Wag gets 21 miles per gallon. 6 160 #> 3 Datsun 710 gets 22.8 miles per gallon. 4 108 #> 4 Hornet 4 Drive gets 21.4 miles per gallon. 6 258 #> 5 Hornet Sportabout gets 18.7 miles per gallon. 8 360 #> 6 Valiant gets 18.1 miles per gallon. 6 225 ``` ## SQL glue has explicit support for constructing SQL statements. Use backticks to quote identifiers. Normal strings and numbers are quoted appropriately for your backend. ```{r} con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:") colnames(iris) <- gsub("[.]", "_", tolower(colnames(iris))) DBI::dbWriteTable(con, "iris", iris) var <- "sepal_width" tbl <- "iris" num <- 2 val <- "setosa" glue_sql(" SELECT {`var`} FROM {`tbl`} WHERE {`tbl`}.sepal_length > {num} AND {`tbl`}.species = {val} ", .con = con) ``` `glue_sql()` can be used in conjunction with parameterized queries using `DBI::dbBind()` to provide protection for SQL Injection attacks. ```{r} 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. ```{r} 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. ```{r} 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) ``` glue/vignettes/engines.Rmd0000644000176200001440000000557015170263227015326 0ustar liggesusers--- title: "Custom knitr language engines" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{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://yihui.org/rmarkdown-cookbook/custom-engine.html) 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://yihui.org/rmarkdown/language-engines.html). 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/vignettes/wrappers.Rmd0000644000176200001440000001224515170263227015536 0ustar liggesusers--- title: "How to write a function that wraps glue" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{How to write a function that wraps glue} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(glue) ``` Imagine that you want to call `glue()` repeatedly inside your own code (e.g. in your own package) with a non-default value for one or more arguments. For example, maybe you anticipate producing R code where `{` and `}` have specific syntactic meaning. Therefore, you'd prefer to use `<<` and `>>` as the opening and closing delimiters for expressions in `glue()`. Spoiler alert: here's the correct way to write such a wrapper: ```{r} my_glue <- function(..., .envir = parent.frame()) { glue(..., .open = "<<", .close = ">>", .envir = .envir) } ``` This is the key move: > Include `.envir = parent.frame()` as an argument of the wrapper function and pass this `.envir` to the `.envir` argument of `glue()`. If you'd like to know why this is the way, keep reading. It pays off to understand this, because the technique applies more broadly than glue. Once you recognize this setup, you'll see it in many functions in the withr, cli, and rlang packages (e.g. `withr::defer()`, `cli::cli_abort()`, `rlang::abort()`). ## Working example Here's an abbreviated excerpt of the roxygen comment that generates the documentation for the starwars dataset in dplyr (`?dplyr::starwars`): ```r #' \describe{ #' \item{name}{Name of the character} #' \item{height}{Height (cm)} #' \item{mass}{Weight (kg)} #' \item{species}{Name of species} #' \item{films}{List of films the character appeared in} #' } ``` To produce such text programmatically, the first step might be to generate the `\item{}{}` lines from a named list of column names and descriptions. Notice that `{` and `}` are important to the `\describe{...}` and `\item{}{}` syntax, so this is an example where it is nice for glue to use different delimiters for expressions. Put the metadata in a suitable list: ```{r} sw_meta <- list( name = "Name of the character", height = "Height (cm)", mass = "Weight (kg)", species = "Name of species", films = "List of films the character appeared in" ) ``` Define a custom glue wrapper and use it inside another helper that generates `\item` entries[^1]: [^1]: Note that delimiters `<<` and `>>` have special meaning in knitr (they are used for a templating feature in knitr itself). So in code chunks inside RMarkdown or Quarto documents, you may need to use different delimiters. ```{r} my_glue = function(...) { glue(..., .open = "<<", .close = ">>", .envir = parent.frame()) } named_list_to_items <- function(x) { my_glue("\\item{<>}{<>}") } ``` Apply `named_list_to_items()` to starwars metadata: ```{r} named_list_to_items(sw_meta) ``` Here's how this would fail if we did *not* handle `.envir` correctly in our wrapper function: ```{r, error = TRUE} my_glue_WRONG <- function(...) { glue(..., .open = "<<", .close = ">>") } named_list_to_items_WRONG <- function(x) { my_glue_WRONG("\\item{<>}{<>}") } named_list_to_items_WRONG(sw_meta) ``` It can be hard to understand why `x` can't be found, when it is clearly available inside `named_list_to_items_WRONG()`. Why isn't `x` available to `my_glue_WRONG()`? ## Where does `glue()` evaluate code? What's going on? It's time to look at the (redacted) signature of `glue()`: ```{r, eval = FALSE} glue(..., .envir = parent.frame(), ...) ``` The expressions inside a glue string are evaluated with respect to `.envir`, which defaults to the environment where `glue()` is called from. Everything is simple when evaluating `glue()` in the global environment: ```{r} x <- 0 y <- 0 z <- 0 glue("{x} {y} {z}") ``` Now we wrap `glue()` in our own simple function, `my_glue1()`. Notice that `my_glue1()` does not capture its caller environment and pass that along. When we execute `my_glue1()` in the global environment, there's no obvious problem. ```{r} my_glue1 <- function(...) { x <- 1 glue(...) } my_glue1("{x} {y} {z}") ``` The value of `x` is found in the execution environment of `my_glue1()`. The values of `y` and `z` are found in the global environment. Importantly, this is because that is the environment where `my_glue1()` is defined, not because that is where `my_glue1()` is called. However, if we call our `my_glue1()` inside another function, we see that all is not well. ```{r} my_glue2 <- function(...) { x <- 2 y <- 2 my_glue1(...) } my_glue2("{x} {y} {z}") ``` Why do `x` and `y` not have the value 2? Because `my_glue1()` and its eventual call to `glue()` have no access to the execution environment of `my_glue2()`, which is the caller environment of `my_glue1()`. If you want your glue wrapper to behave like `glue()` itself and to work as expected inside other functions, make sure it captures its caller environment and passes that along to `glue()`. ```{r} my_glue3 <- function(..., .envir = parent.frame()) { x <- 3 glue(..., .envir = .envir) } my_glue3("{x} {y} {z}") my_glue4 <- function(...) { x <- 4 y <- 4 my_glue3(...) } my_glue4("{x} {y} {z}") ``` glue/src/0000755000176200001440000000000015170264116012000 5ustar liggesusersglue/src/trim.c0000644000176200001440000000610414503121070013106 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/src/init.c0000644000176200001440000000116515170237027013113 0ustar liggesusers#include #include #include #include // for NULL // Compile with `C_VISIBILITY = -fvisibility=hidden` if you link to // this library #include #define export attribute_visible extern /* .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}}; export void R_init_glue(DllInfo* dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } glue/src/glue.c0000644000176200001440000001172615170237027013110 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("A '#' comment in a glue expression must terminate with a newline."); } free(str); out = resize(out, k); UNPROTECT(1); return out; } glue/src/Makevars0000644000176200001440000000003515170237027013473 0ustar liggesusersPKG_CFLAGS = $(C_VISIBILITY) glue/NAMESPACE0000644000176200001440000000115515170221215012423 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/LICENSE0000644000176200001440000000005215170242707012215 0ustar liggesusersYEAR: 2026 COPYRIGHT HOLDER: glue authors glue/NEWS.md0000644000176200001440000002162715170264053012317 0ustar liggesusers# glue 1.8.1 * The `glue` knitr engine handles multiline chunks now (#319). # glue 1.8.0 * glue has two new articles: - "Get started", with contributions from @stephhazlitt and @BrennanAntone (#137, #170, #332). - How to write a function that wraps glue (#281). * If the last argument of `glue()` is empty, it is dropped (#320). This makes it easy to structure `glue()` calls with one argument per line, and to anticipate adding arguments: ``` r glue( "here's some text, ", "and maybe more text will be added in the future?", ) ``` * `glue_sql("{var*}")` once again generates `NULL` if var is empty. This reverts #292. (#318). * The `.envir` argument to `glue()` and `glue_data()` really must be an environment now, as documented. Previously a list-ish object worked in some cases (by accident, not really by design). When you need to lookup values in a list-ish object, use `glue_data(.x =)` (#308, #317). Ditto for `glue_sql()` and `glue_data_sql()`. # glue 1.7.0 * If rlang is installed, glue will generate more informative errors if an interpolated expression either can't be parsed or fails to evaluate (#229). * `+` now works in more situations, and gives errors when one side isn't a character vector. It no longer automatically applies glue interpolation to a non-glue input, if there is one. You'll need to do that yourself (#286). * `glue_collapse(character())` (and hence `glue_sql_collapse(character())`) now return `""`, so that they always return a single string (#88). * `glue_sql()` now collapses an empty vector to `""` not `"NULL"` (#272). * `glue_sql()` now uses `DBI::dbQuoteLiteral()` for all object types. This should increase fidelity of escaping for different object types (#279). * The "Speed of glue" vignette has been converted to an article, which allows several package to be removed from `Suggests` (and re-located to `Config/Needs/website`). The code got a light refresh, including a switch from microbenchmark to bench and more modern use of ggplot2. * Add `$(C_VISIBILITY)` to compiler flags to hide internal symbols from the dll (#284 @lionel-). # glue 1.6.2 * Modify a test for better forward compatibility with R. # glue 1.6.1 * glue now registers its custom knitr engines in a way that is more robust to namespace-loading edge cases that can arise during package installation (#254). # glue 1.6.0 * `glue()`, `glue_data()`, `glue_col()`, and `glue_data_col()` gain a new `.literal` argument, which controls how quotes and the comment character are treated when parsing the expression string (#235). This is mostly useful when using a custom transformer. * Trailing whitespace-only lines don't interfere with indentation (#247). # glue 1.5.1 * Jennifer Bryan is now the maintainer. * The existing custom language engines for knitr, `glue` and `glue_sql`, are documented in a new vignette (#71). *Detail added after release: glue now sets up registration of these engines in `.onLoad()`.* * `glue_col()` gives special treatment to styling functions from the crayon package, e.g. `glue_col("{blue foo}")` "just works" now, even if crayon is not attached (but is installed) (#241). * Unterminated backticks trigger the same error as unterminated single or double quotes (#237). * `glue_sql()` collapses zero-length `DBI::SQL` object into `DBI::SQL("NULL")` (#244 @shrektan). # glue 1.5.0 ## Breaking changes * Long deprecated function `collapse()` has been removed (#213) ## New functions and arguments * New `glue_sql_collapse()` function to collapse inputs and return a `DBI::SQL()` object (#103). * `glue()` gains a new `.comment` argument, to control the comment character (#193). * `glue()` gains a new `.null` argument, to control the value to replace `NULL` values with (#217, @echasnovski). ## Bugfixes and minor changes * `sql_quote_transformer()` is now allows whitespace after the trailing `*` (#218). * `compare_proxy.glue()` method defined so glue objects can be compared to strings in testthat 3e without errors (#212) * `print.glue()` no longer prints an empty newline for 0 length inputs (#214) * Unterminated comments in glue expression now throw an error (#227, @gaborcsardi) * Unterminated quotes in glue expressions now throw an error (#226, @gaborcsardi) # glue 1.4.2 * `glue_safe()` gives a slightly nicer error message * The required version of R is now 3.2 (#189) * `glue_sql()` now collapses `DBI::SQL()` elements correctly (#192 @shrektan) * The internal `compare()` method gains a `...` argument, for compatibility with testthat 3.0.0 # glue 1.4.1 * Internal changes for compatibility with vctrs 0.3.0 (#187). * `glue_sql()` now replaces missing values correctly when collapsing values (#185). * `glue_sql()` now always preserves the type of the column even in the presence of missing values (#130) # glue 1.4.0 * `.envir = NULL` is now supported and is equivalent to passing `.envir = emptyenv()` (#140) * New `glue_safe()` and `glue_data_safe()` functions, safer versions of `glue()` that do not execute code, only look up values (using `get()`). These alternatives are useful for things like shiny applications where you do not have control of the input for your glue expressions. (#140) * Fixed memory access issue and memory leaks found by valgrind. # glue 1.3.2 * glue now implements vctrs methods. This ensures that vectors of glue strings are compatible with tidyverse packages like tidyr (r-lib/tidyselect#170, tidyverse/tidyr#773, @lionel-). * Fix a LTO type mismatch warning (#146) * `glue_sql()` now quotes lists of values appropriate to their type, rather than coercing all values to characters (#153) * `glue_data()` now implicitly coerces `.x` to a list. * `glue()` gains the `.trim` argument, like `glue_data()`. * `single_quote()` `double_quote()` and `backtick()` all return `NA` for `NA` inputs (#135). * Improve `trim()`'s handling of lines containing only indentation (#162, #163, @alandipert) # glue 1.3.1 ## Features * `glue()` now has a `+` method to combine strings. * `glue_sql()` now collapses zero-length vector into `DBI::SQL("NULL")` (#134 @shrektan). ## Bugfixes and minor changes * `glue_sql()` now supports unquoting lists of Id objects. * `glue_sql()` now quotes characters with NAs appropriately (#115). * `glue_sql()` now quotes Dates appropriately (#98). * A potential protection error reported by rchk was fixed. # glue 1.3.0 ## Breaking changes * The `evaluate()` function has been removed. Changes elsewhere in glue made the implementation trivial so it was removed for the sake of clarity. Previous uses can be replaced by `eval(parse(text = text), envir)`. * `collapse()` has been renamed to `glue_collapse()` to avoid namespace collisions with `dplyr::collapse()`. ## Features * `compare.glue()` was added, to make it easier to use glue objects in `testthat::expect_equal()` statements. * `glue_col()` and `glue_data_col()` functions added to display strings with color. ## Bugfixes and minor changes * Glue now throws an informative error message when it cannot interpolate a function into a string (#114, @haleyjeppson & @ijlyttle). * Glue now evaluates unnamed arguments lazily with `delayedAssign()`, so there is no performance cost if an argument is not used. (#83, @egnha). * Fixed a bug where names in the assigned expression of an interpolation variable would conflict with the name of the variable itself (#89, @egnha). * Do not drop the `glue` class when subsetting (#66). * Fix `glue()` and `collapse()` always return UTF-8 encoded strings (#81, @dpprdan) # glue 1.2.0 * The implementation has been tweaked to be slightly faster in most cases. * `glue()` now has a `.transformer` argument, which allows you to use custom logic on how to evaluate the code within glue blocks. See `vignette("transformers")` for more details and example transformer functions. * `glue()` now returns `NA` if any of the results are `NA` and `.na` is `NULL`. Otherwise `NA` values are replaced by the value of `.na`. * `trim()` to use the trimming logic from glue is now exported. * `glue_sql()` and `glue_data_sql()` functions added to make constructing SQL statements with glue safer and easier. * `glue()` is now easier to use when used within helper functions such as `lapply`. * Fix when last expression in `glue()` is NULL. # glue 1.1.1 * Another fix for PROTECT / REPROTECT found by the rchk static analyzer. # glue 1.1.0 * Fix for PROTECT errors when resizing output strings. * `glue()` always returns 'UTF-8' strings, converting inputs if in other encodings if needed. * `to()` and `to_data()` have been removed. * `glue()` and `glue_data()` can now take alternative delimiters to `{` and `}`. This is useful if you are writing to a format that uses a lot of braces, such as LaTeX. (#23) * `collapse()` now returns 0 length output if given 0 length input (#28). # glue 0.0.0.9000 * Fix `glue()` to admit `.` as an embedded expression in a string (#15, @egnha). * Added a `NEWS.md` file to track changes to the package. glue/inst/0000755000176200001440000000000015170264116012166 5ustar liggesusersglue/inst/doc/0000755000176200001440000000000015170264116012733 5ustar liggesusersglue/inst/doc/transformers.Rmd0000644000176200001440000001500215170263227016124 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 <- identity_transformer(text, envir) shQuote(res) } } glue_sh <- function(..., .envir = parent.frame(), .type = c("sh", "csh", "cmd", "cmd2")) { .type <- match.arg(.type) glue(..., .envir = .envir, .transformer = shell_transformer(.type)) } filename <- "test" writeLines(con = filename, "hello!") command <- glue_sh("cat {filename}") command system(command) ``` ```{r include = FALSE} if (file.exists("test")) { unlink("test") } ``` ### emoji transformer A transformer which converts the text to the equivalent emoji. ```{r, eval = require("emo")} emoji_transformer <- function(text, envir) { if (grepl("[*]$", text)) { text <- sub("[*]$", "", text) glue_collapse(ji_find(text)$emoji) } else { ji(text) } } glue_ji <- function(..., .envir = parent.frame()) { glue(..., .open = ":", .close = ":", .envir = .envir, .transformer = emoji_transformer) } glue_ji("one :heart:") glue_ji("many :heart*:") ``` ### sprintf transformer A transformer which allows succinct `sprintf` format strings. ```{r} sprintf_transformer <- function(text, envir) { m <- regexpr(":.+$", text) if (m != -1) { format <- substring(regmatches(text, m), 2) regmatches(text, m) <- "" res <- identity_transformer(text, envir) do.call(sprintf, list(glue("%{format}"), res)) } else { identity_transformer(text, envir) } } glue_fmt <- function(..., .envir = parent.frame()) { glue(..., .transformer = sprintf_transformer, .envir = .envir) } glue_fmt("π = {pi:.3f}") ``` ### signif transformer A transformer generator that represents numbers with a given number of significant digits. This is useful if we want to represent all numbers using the same significant digits ```{r} signif_transformer <- function(digits = 3) { force(digits) function(text, envir) { x <- identity_transformer(text, envir) if (is.numeric(x)) { signif(x, digits = digits) } else { x } } } glue_signif <- function(..., .envir = parent.frame()) { glue(..., .transformer = signif_transformer(3), .envir = .envir) } glue_signif("π = {pi}; 10π = {10*pi}; 100π = {100*pi}") ``` ### safely transformer A transformer that acts like `purrr::safely()`, which returns a value instead of an error. ```{r} safely_transformer <- function(otherwise = NA) { function(text, envir) { tryCatch( identity_transformer(text, envir), error = function(e) if (is.language(otherwise)) eval(otherwise) else otherwise) } } glue_safely <- function(..., .otherwise = NA, .envir = parent.frame()) { glue(..., .transformer = safely_transformer(.otherwise), .envir = .envir) } # Default returns missing if there is an error glue_safely("foo: {xyz}") # Or an empty string glue_safely("foo: {xyz}", .otherwise = "Error") # Or output the error message in red library(crayon) glue_safely("foo: {xyz}", .otherwise = quote(glue("{red}Error: {conditionMessage(e)}{reset}"))) ``` ### "Variables and Values" transformer A transformer that expands input of the form `{var_name=}` into `var_name = var_value`, i.e. a shorthand for exposing variable names with their values. This is inspired by an [f-strings feature coming in Python 3.8](https://docs.python.org/3.8/whatsnew/3.8.html#f-strings-now-support-for-quick-and-easy-debugging). It's actually more general: you can use it with an expression input such as `{expr=}`. ```{r} vv_transformer <- function(text, envir) { regex <- "=$" if (!grepl(regex, text)) { return(identity_transformer(text, envir)) } text <- sub(regex, "", text) res <- identity_transformer(text, envir) n <- length(res) res <- glue_collapse(res, sep = ", ") if (n > 1) { res <- c("[", res, "]") } glue_collapse(c(text, " = ", res)) } ``` ```{r} set.seed(1234) description <- "some random" numbers <- sample(100, 4) average <- mean(numbers) sum <- sum(numbers) glue("For {description} {numbers=}, {average=}, {sum=}.", .transformer = vv_transformer) a <- 3 b <- 5.6 glue("{a=}\n{b=}\n{a * 9 + b * 2=}", .transformer = vv_transformer) ``` glue/inst/doc/transformers.html0000644000176200001440000010115015170264114016342 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 <- identity_transformer(text, envir)
    shQuote(res)
  }
}

glue_sh <- function(..., .envir = parent.frame(), .type = c("sh", "csh", "cmd", "cmd2")) {
  .type <- match.arg(.type)
  glue(..., .envir = .envir, .transformer = shell_transformer(.type))

}

filename <- "test"
writeLines(con = filename, "hello!")

command <- glue_sh("cat {filename}")
command
#> 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:")
glue_ji("many :heart*:")

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 <- identity_transformer(text, envir)
    do.call(sprintf, list(glue("%{format}"), res))
  } else {
    identity_transformer(text, envir)
  }
}

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

signif transformer

A transformer generator that represents numbers with a given number of significant digits. This is useful if we want to represent all numbers using the same significant digits

signif_transformer <- function(digits = 3) {
    force(digits)
    function(text, envir) {
        x <- identity_transformer(text, envir)
        if (is.numeric(x)) {
            signif(x, digits = digits)
        } else {
            x
        }
    }
}
glue_signif <- function(..., .envir = parent.frame()) {
  glue(..., .transformer = signif_transformer(3), .envir = .envir)
}

glue_signif("π = {pi}; 10π = {10*pi}; 100π = {100*pi}")
#> π = 3.14; 10π = 31.4; 100π = 314

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(
      identity_transformer(text, envir),
      error = function(e) if (is.language(otherwise)) eval(otherwise) else otherwise)
  }
}

glue_safely <- function(..., .otherwise = NA, .envir = parent.frame()) {
  glue(..., .transformer = safely_transformer(.otherwise), .envir = .envir)
}

# Default returns missing if there is an error
glue_safely("foo: {xyz}")
#> 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: Failed to evaluate glue component {xyz}
#> Caused by 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/glue.html0000644000176200001440000011437615170264113014566 0ustar liggesusers Introduction to glue

Introduction to glue

The glue package contains functions for string interpolation: gluing together character strings and R code.

library(glue)

Gluing and interpolating

glue() can be used to glue together pieces of text:

glue("glue ", "some ", "text ", "together")
#> glue some text together

But glue’s real power comes with {}: anything inside of {} is evaluated and pasted into the string. This makes it easy to interpolate variables:

name <- "glue"
glue("We are learning how to use the {name} R package.")
#> We are learning how to use the glue R package.

As well as more complex expressions:

release_date <- as.Date("2017-06-13")
glue("Release was on a {format(release_date, '%A')}.")
#> Release was on a Tuesday.

Control of line breaks

glue() honors the line breaks in its input:

glue("
  A formatted string
  Can have multiple lines
    with additional indentation preserved
  "
)
#> A formatted string
#> Can have multiple lines
#>   with additional indentation preserved

The example above demonstrates some other important facts about the pre-processing of the template string:

  • An empty first or last line is automatically trimmed.
  • Leading whitespace that is common across all lines is trimmed.

The elimination of common leading whitespace is advantageous, because you aren’t forced to choose between indenting your code normally and getting the output you actually want. This is easier to appreciate when you have glue() inside a function body (this example also shows an alternative way of styling the end of a glue() call):

foo <- function() {
  glue("
    A formatted string
    Can have multiple lines
      with additional indentation preserved")
}
foo()
#> A formatted string
#> Can have multiple lines
#>   with additional indentation preserved

On the other hand, what if you don’t want a line break in the output, but you also like to limit the length of lines in your source code to, e.g., 80 characters? The first option is to use \\ to break the template string into multiple lines, without getting line breaks in the output:

release_date <- as.Date("2017-06-13")
glue("
  The first version of the glue package was released on \\
  a {format(release_date, '%A')}.")
#> The first version of the glue package was released on a Tuesday.

This comes up fairly often when an expression to evaluate inside {} takes up more characters than its result, i.e. format(release_date, '%A') versus Tuesday. A second way to achieve the same result is to break the template into individual pieces, which are then concatenated.

glue(
  "The first version of the glue package was released on ",
  "a {format(release_date, '%A')}."
)
#> The first version of the glue package was released on a Tuesday.

If you want an explicit newline at the start or end, include an extra empty line.

# no leading or trailing newline
x <- glue("
  blah
  ")
unclass(x)
#> [1] "blah"

# both a leading and trailing newline
y <- glue("

  blah

  ")
unclass(y)
#> [1] "\nblah\n"

We use unclass() above to make it easier to see the absence and presence of the newlines, i.e. to reveal the literal \n escape sequences. glue() and friends generally return a glue object, which is a character vector with the S3 class "glue". The "glue" class exists primarily for the sake of a print method, which displays the natural formatted result of a glue string. Most of the time this is exactly what the user wants to see. The example above happens to be an exception, where we really do want to see the underlying string representation.

Here’s another example to drive home the difference between printing a glue object and looking at its string representation. as.character() is a another way to do this that is arguably more expressive.

x <- glue('
  abc
  " }

  xyz')
class(x)
#> [1] "glue"      "character"

x
#> abc
#> "    }
#> 
#> xyz
unclass(x)
#> [1] "abc\n\"\t}\n\nxyz"
as.character(x)
#> [1] "abc\n\"\t}\n\nxyz"

Delimiters

By default, code to be evaluated goes inside {} in a glue string. If want a literal curly brace in your string, double it:

glue("The name of the package is {name}, not {{name}}.")
#> The name of the package is glue, not {name}.

Sometimes it’s just more convenient to use different delimiters altogether, especially if the template text comes from elsewhere or is subject to external requirements. Consider this example where we want to interpolate the function name into a code snippet that defines a function:

fn_def <- "
  <<NAME>> <- function(x) {
    # imagine a function body here
  }"
glue(fn_def, NAME = "my_function", .open = "<<", .close = ">>")
#> my_function <- function(x) {
#>   # imagine a function body here
#> }

In this glue string, { and } have very special meaning. If we forced ourselves to double them, suddenly it doesn’t look like normal R code anymore. Using alternative delimiters is a nice option in cases like this.

Where glue looks for values

By default, glue() evaluates the code inside {} in the caller environment:

glue(..., .envir = parent.frame())

So, for a top-level glue() call, that means the global environment.

x <- "the caller environment"
glue("By default, `glue()` evaluates code in {x}.")
#> By default, `glue()` evaluates code in the caller environment.

But you can provide more narrowly scoped values by passing them to glue() in name = value form:

x <- "the local environment"
glue(
  "`glue()` can access values from {x} or from {y}. {z}",
  y = "named arguments",
  z = "Woo!"
)
#> `glue()` can access values from the local environment or from named arguments. Woo!

If the relevant data lives in a data frame (or list or environment), use glue_data() instead:

mini_mtcars <- head(cbind(model = rownames(mtcars), mtcars))
rownames(mini_mtcars) <- NULL
glue_data(mini_mtcars, "{model} 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.

glue_data() is very natural to use with the pipe:

mini_mtcars |>
  glue_data("{model} gets {mpg} miles per gallon.")
#> Mazda RX4 gets 21 miles per gallon.
#> Mazda RX4 Wag gets 21 miles per gallon.
#> Datsun 710 gets 22.8 miles per gallon.
#> Hornet 4 Drive gets 21.4 miles per gallon.
#> Hornet Sportabout gets 18.7 miles per gallon.
#> Valiant gets 18.1 miles per gallon.

Returning to glue(), recall that it defaults to evaluation in the caller environment. This has happy implications inside a dplyr::mutate() pipeline. The data-masking feature of mutate() means the columns of the target data frame are “in scope” for a glue() call:

library(dplyr)

mini_mtcars |>
  mutate(note = glue("{model} gets {mpg} miles per gallon.")) |>
  select(note, cyl, disp)
#>                                            note cyl disp
#> 1           Mazda RX4 gets 21 miles per gallon.   6  160
#> 2       Mazda RX4 Wag gets 21 miles per gallon.   6  160
#> 3        Datsun 710 gets 22.8 miles per gallon.   4  108
#> 4    Hornet 4 Drive gets 21.4 miles per gallon.   6  258
#> 5 Hornet Sportabout gets 18.7 miles per gallon.   8  360
#> 6           Valiant gets 18.1 miles per gallon.   6  225

SQL

glue has explicit support for constructing SQL statements. Use backticks to quote identifiers. Normal strings and numbers are quoted appropriately for your backend.

con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
colnames(iris) <- gsub("[.]", "_", tolower(colnames(iris)))
DBI::dbWriteTable(con, "iris", iris)
var <- "sepal_width"
tbl <- "iris"
num <- 2
val <- "setosa"
glue_sql("
  SELECT {`var`}
  FROM {`tbl`}
  WHERE {`tbl`}.sepal_length > {num}
    AND {`tbl`}.species = {val}
  ", .con = con)
#> <SQL> SELECT `sepal_width`
#> FROM `iris`
#> WHERE `iris`.sepal_length > 2
#>   AND `iris`.species = 'setosa'

glue_sql() can be used in 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)
#> <SQL> SELECT s.`sepal_width`
#> FROM (SELECT *
#> FROM `iris`) AS s

If you want to input multiple values for use in SQL IN statements put * at the end of the value and the values will be collapsed and quoted appropriately.

glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})",
  vals = 1, .con = con)
#> <SQL> SELECT * FROM `iris` WHERE sepal_length IN (1)

glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})",
  vals = 1:5, .con = con)
#> <SQL> SELECT * FROM `iris` WHERE sepal_length IN (1, 2, 3, 4, 5)

glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})",
  vals = "setosa", .con = con)
#> <SQL> SELECT * FROM `iris` WHERE species IN ('setosa')

glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})",
  vals = c("setosa", "versicolor"), .con = con)
#> <SQL> SELECT * FROM `iris` WHERE species IN ('setosa', 'versicolor')
glue/inst/doc/wrappers.html0000644000176200001440000005616615170264116015502 0ustar liggesusers How to write a function that wraps glue

How to write a function that wraps glue

library(glue)

Imagine that you want to call glue() repeatedly inside your own code (e.g. in your own package) with a non-default value for one or more arguments. For example, maybe you anticipate producing R code where { and } have specific syntactic meaning. Therefore, you’d prefer to use << and >> as the opening and closing delimiters for expressions in glue().

Spoiler alert: here’s the correct way to write such a wrapper:

my_glue <- function(..., .envir = parent.frame()) {
  glue(..., .open = "<<", .close = ">>", .envir = .envir)
}

This is the key move:

Include .envir = parent.frame() as an argument of the wrapper function and pass this .envir to the .envir argument of glue().

If you’d like to know why this is the way, keep reading. It pays off to understand this, because the technique applies more broadly than glue. Once you recognize this setup, you’ll see it in many functions in the withr, cli, and rlang packages (e.g. withr::defer(), cli::cli_abort(), rlang::abort()).

Working example

Here’s an abbreviated excerpt of the roxygen comment that generates the documentation for the starwars dataset in dplyr (?dplyr::starwars):

#' \describe{
#' \item{name}{Name of the character}
#' \item{height}{Height (cm)}
#' \item{mass}{Weight (kg)}
#' \item{species}{Name of species}
#' \item{films}{List of films the character appeared in}
#' }

To produce such text programmatically, the first step might be to generate the \item{}{} lines from a named list of column names and descriptions. Notice that { and } are important to the \describe{...} and \item{}{} syntax, so this is an example where it is nice for glue to use different delimiters for expressions.

Put the metadata in a suitable list:

sw_meta <- list(
  name    = "Name of the character",
  height  = "Height (cm)",
  mass    = "Weight (kg)",
  species = "Name of species",
  films   = "List of films the character appeared in"
)

Define a custom glue wrapper and use it inside another helper that generates \item entries1:

my_glue = function(...) {
  glue(..., .open = "<<", .close = ">>", .envir = parent.frame())
}

named_list_to_items <- function(x) {
  my_glue("\\item{<<names(x)>>}{<<x>>}")
}

Apply named_list_to_items() to starwars metadata:

named_list_to_items(sw_meta)
#> \item{name}{Name of the character}
#> \item{height}{Height (cm)}
#> \item{mass}{Weight (kg)}
#> \item{species}{Name of species}
#> \item{films}{List of films the character appeared in}

Here’s how this would fail if we did not handle .envir correctly in our wrapper function:

my_glue_WRONG <- function(...) {
  glue(..., .open = "<<", .close = ">>")
}

named_list_to_items_WRONG <- function(x) {
  my_glue_WRONG("\\item{<<names(x)>>}{<<x>>}")
}

named_list_to_items_WRONG(sw_meta)

It can be hard to understand why x can’t be found, when it is clearly available inside named_list_to_items_WRONG(). Why isn’t x available to my_glue_WRONG()?

Where does glue() evaluate code?

What’s going on? It’s time to look at the (redacted) signature of glue():

glue(..., .envir = parent.frame(), ...)

The expressions inside a glue string are evaluated with respect to .envir, which defaults to the environment where glue() is called from.

Everything is simple when evaluating glue() in the global environment:

x <- 0
y <- 0
z <- 0

glue("{x} {y} {z}")
#> 0 0 0

Now we wrap glue() in our own simple function, my_glue1(). Notice that my_glue1() does not capture its caller environment and pass that along.

When we execute my_glue1() in the global environment, there’s no obvious problem.

my_glue1 <- function(...) {
  x <- 1
  glue(...)
}

my_glue1("{x} {y} {z}")
#> 1 0 0

The value of x is found in the execution environment of my_glue1(). The values of y and z are found in the global environment. Importantly, this is because that is the environment where my_glue1() is defined, not because that is where my_glue1() is called.

However, if we call our my_glue1() inside another function, we see that all is not well.

my_glue2 <- function(...) {
  x <- 2
  y <- 2
  my_glue1(...)
}

my_glue2("{x} {y} {z}")
#> 1 0 0

Why do x and y not have the value 2? Because my_glue1() and its eventual call to glue() have no access to the execution environment of my_glue2(), which is the caller environment of my_glue1().

If you want your glue wrapper to behave like glue() itself and to work as expected inside other functions, make sure it captures its caller environment and passes that along to glue().

my_glue3 <- function(..., .envir = parent.frame()) {
  x <- 3
  glue(..., .envir = .envir)
}

my_glue3("{x} {y} {z}")
#> 0 0 0

my_glue4 <- function(...) {
  x <- 4
  y <- 4
  my_glue3(...)
}

my_glue4("{x} {y} {z}")
#> 4 4 0

  1. Note that delimiters << and >> have special meaning in knitr (they are used for a templating feature in knitr itself). So in code chunks inside RMarkdown or Quarto documents, you may need to use different delimiters.↩︎

glue/inst/doc/glue.Rmd0000644000176200001440000002011315170263227014332 0ustar liggesusers--- title: "Introduction to glue" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Introduction to glue} %\VignetteEncoding{UTF-8} %\VignetteEngine{knitr::rmarkdown} editor_options: markdown: wrap: sentence --- ```{r, include = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ``` The glue package contains functions for string interpolation: gluing together character strings and R code. ```{r} library(glue) ``` ## Gluing and interpolating `glue()` can be used to glue together pieces of text: ```{r} glue("glue ", "some ", "text ", "together") ``` But glue's real power comes with `{}`: anything inside of `{}` is evaluated and pasted into the string. This makes it easy to interpolate variables: ```{r} name <- "glue" glue("We are learning how to use the {name} R package.") ``` As well as more complex expressions: ```{r} release_date <- as.Date("2017-06-13") glue("Release was on a {format(release_date, '%A')}.") ``` ## Control of line breaks `glue()` honors the line breaks in its input: ```{r} glue(" A formatted string Can have multiple lines with additional indentation preserved " ) ``` The example above demonstrates some other important facts about the pre-processing of the template string: - An empty first or last line is automatically trimmed. - Leading whitespace that is common across all lines is trimmed. The elimination of common leading whitespace is advantageous, because you aren't forced to choose between indenting your code normally and getting the output you actually want. This is easier to appreciate when you have `glue()` inside a function body (this example also shows an alternative way of styling the end of a `glue()` call): ```{r} foo <- function() { glue(" A formatted string Can have multiple lines with additional indentation preserved") } foo() ``` On the other hand, what if you don't want a line break in the output, but you also like to limit the length of lines in your source code to, e.g., 80 characters? The first option is to use `\\` to break the template string into multiple lines, without getting line breaks in the output: ```{r} release_date <- as.Date("2017-06-13") glue(" The first version of the glue package was released on \\ a {format(release_date, '%A')}.") ``` This comes up fairly often when an expression to evaluate inside `{}` takes up more characters than its result, i.e. `format(release_date, '%A')` versus `Tuesday`. A second way to achieve the same result is to break the template into individual pieces, which are then concatenated. ```{r} glue( "The first version of the glue package was released on ", "a {format(release_date, '%A')}." ) ``` If you want an explicit newline at the start or end, include an extra empty line. ```{r} # no leading or trailing newline x <- glue(" blah ") unclass(x) # both a leading and trailing newline y <- glue(" blah ") unclass(y) ``` We use `unclass()` above to make it easier to see the absence and presence of the newlines, i.e. to reveal the literal `\n` escape sequences. `glue()` and friends generally return a glue object, which is a character vector with the S3 class `"glue"`. The `"glue"` class exists primarily for the sake of a print method, which displays the natural formatted result of a glue string. Most of the time this is *exactly* what the user wants to see. The example above happens to be an exception, where we really do want to see the underlying string representation. Here's another example to drive home the difference between printing a glue object and looking at its string representation. `as.character()` is a another way to do this that is arguably more expressive. ```{r} x <- glue(' abc " } xyz') class(x) x unclass(x) as.character(x) ``` ## Delimiters By default, code to be evaluated goes inside `{}` in a glue string. If want a literal curly brace in your string, double it: ```{r} glue("The name of the package is {name}, not {{name}}.") ``` Sometimes it's just more convenient to use different delimiters altogether, especially if the template text comes from elsewhere or is subject to external requirements. Consider this example where we want to interpolate the function name into a code snippet that defines a function: ```{r} fn_def <- " <> <- function(x) { # imagine a function body here }" glue(fn_def, NAME = "my_function", .open = "<<", .close = ">>") ``` In this glue string, `{` and `}` have very special meaning. If we forced ourselves to double them, suddenly it doesn't look like normal R code anymore. Using alternative delimiters is a nice option in cases like this. ## Where glue looks for values By default, `glue()` evaluates the code inside `{}` in the caller environment: ```{r, eval = FALSE} glue(..., .envir = parent.frame()) ``` So, for a top-level `glue()` call, that means the global environment. ```{r} x <- "the caller environment" glue("By default, `glue()` evaluates code in {x}.") ``` But you can provide more narrowly scoped values by passing them to `glue()` in `name = value` form: ```{r} x <- "the local environment" glue( "`glue()` can access values from {x} or from {y}. {z}", y = "named arguments", z = "Woo!" ) ``` If the relevant data lives in a data frame (or list or environment), use `glue_data()` instead: ```{r} mini_mtcars <- head(cbind(model = rownames(mtcars), mtcars)) rownames(mini_mtcars) <- NULL glue_data(mini_mtcars, "{model} has {hp} hp.") ``` `glue_data()` is very natural to use with the pipe: ```{r, eval = getRversion() >= "4.1.0"} mini_mtcars |> glue_data("{model} gets {mpg} miles per gallon.") ``` Returning to `glue()`, recall that it defaults to evaluation in the caller environment. This has happy implications inside a `dplyr::mutate()` pipeline. The data-masking feature of `mutate()` means the columns of the target data frame are "in scope" for a `glue()` call: ```r library(dplyr) mini_mtcars |> mutate(note = glue("{model} gets {mpg} miles per gallon.")) |> select(note, cyl, disp) #> note cyl disp #> 1 Mazda RX4 gets 21 miles per gallon. 6 160 #> 2 Mazda RX4 Wag gets 21 miles per gallon. 6 160 #> 3 Datsun 710 gets 22.8 miles per gallon. 4 108 #> 4 Hornet 4 Drive gets 21.4 miles per gallon. 6 258 #> 5 Hornet Sportabout gets 18.7 miles per gallon. 8 360 #> 6 Valiant gets 18.1 miles per gallon. 6 225 ``` ## SQL glue has explicit support for constructing SQL statements. Use backticks to quote identifiers. Normal strings and numbers are quoted appropriately for your backend. ```{r} con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:") colnames(iris) <- gsub("[.]", "_", tolower(colnames(iris))) DBI::dbWriteTable(con, "iris", iris) var <- "sepal_width" tbl <- "iris" num <- 2 val <- "setosa" glue_sql(" SELECT {`var`} FROM {`tbl`} WHERE {`tbl`}.sepal_length > {num} AND {`tbl`}.species = {val} ", .con = con) ``` `glue_sql()` can be used in conjunction with parameterized queries using `DBI::dbBind()` to provide protection for SQL Injection attacks. ```{r} 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. ```{r} 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. ```{r} 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) ``` glue/inst/doc/transformers.R0000644000176200001440000001116215170264114015602 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 <- identity_transformer(text, envir) shQuote(res) } } glue_sh <- function(..., .envir = parent.frame(), .type = c("sh", "csh", "cmd", "cmd2")) { .type <- match.arg(.type) glue(..., .envir = .envir, .transformer = shell_transformer(.type)) } filename <- "test" writeLines(con = filename, "hello!") command <- glue_sh("cat {filename}") command system(command) ## ----include = FALSE---------------------------------------------------------- if (file.exists("test")) { unlink("test") } ## ----eval = require("emo")---------------------------------------------------- # emoji_transformer <- function(text, envir) { # if (grepl("[*]$", text)) { # text <- sub("[*]$", "", text) # glue_collapse(ji_find(text)$emoji) # } else { # ji(text) # } # } # # glue_ji <- function(..., .envir = parent.frame()) { # glue(..., .open = ":", .close = ":", .envir = .envir, .transformer = emoji_transformer) # } # glue_ji("one :heart:") # glue_ji("many :heart*:") ## ----------------------------------------------------------------------------- sprintf_transformer <- function(text, envir) { m <- regexpr(":.+$", text) if (m != -1) { format <- substring(regmatches(text, m), 2) regmatches(text, m) <- "" res <- identity_transformer(text, envir) do.call(sprintf, list(glue("%{format}"), res)) } else { identity_transformer(text, envir) } } glue_fmt <- function(..., .envir = parent.frame()) { glue(..., .transformer = sprintf_transformer, .envir = .envir) } glue_fmt("π = {pi:.3f}") ## ----------------------------------------------------------------------------- signif_transformer <- function(digits = 3) { force(digits) function(text, envir) { x <- identity_transformer(text, envir) if (is.numeric(x)) { signif(x, digits = digits) } else { x } } } glue_signif <- function(..., .envir = parent.frame()) { glue(..., .transformer = signif_transformer(3), .envir = .envir) } glue_signif("π = {pi}; 10π = {10*pi}; 100π = {100*pi}") ## ----------------------------------------------------------------------------- safely_transformer <- function(otherwise = NA) { function(text, envir) { tryCatch( identity_transformer(text, envir), error = function(e) if (is.language(otherwise)) eval(otherwise) else otherwise) } } glue_safely <- function(..., .otherwise = NA, .envir = parent.frame()) { glue(..., .transformer = safely_transformer(.otherwise), .envir = .envir) } # Default returns missing if there is an error glue_safely("foo: {xyz}") # Or an empty string glue_safely("foo: {xyz}", .otherwise = "Error") # Or output the error message in red library(crayon) glue_safely("foo: {xyz}", .otherwise = quote(glue("{red}Error: {conditionMessage(e)}{reset}"))) ## ----------------------------------------------------------------------------- vv_transformer <- function(text, envir) { regex <- "=$" if (!grepl(regex, text)) { return(identity_transformer(text, envir)) } text <- sub(regex, "", text) res <- identity_transformer(text, envir) n <- length(res) res <- glue_collapse(res, sep = ", ") if (n > 1) { res <- c("[", res, "]") } glue_collapse(c(text, " = ", res)) } ## ----------------------------------------------------------------------------- set.seed(1234) description <- "some random" numbers <- sample(100, 4) average <- mean(numbers) sum <- sum(numbers) glue("For {description} {numbers=}, {average=}, {sum=}.", .transformer = vv_transformer) a <- 3 b <- 5.6 glue("{a=}\n{b=}\n{a * 9 + b * 2=}", .transformer = vv_transformer) glue/inst/doc/engines.Rmd0000644000176200001440000000557015170263227015040 0ustar liggesusers--- title: "Custom knitr language engines" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{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://yihui.org/rmarkdown-cookbook/custom-engine.html) 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://yihui.org/rmarkdown/language-engines.html). 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/engines.html0000644000176200001440000003610715170264110015252 0ustar liggesusers Custom knitr language engines

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/glue.R0000644000176200001440000001064715170264113014017 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ## ----------------------------------------------------------------------------- library(glue) ## ----------------------------------------------------------------------------- glue("glue ", "some ", "text ", "together") ## ----------------------------------------------------------------------------- name <- "glue" glue("We are learning how to use the {name} R package.") ## ----------------------------------------------------------------------------- release_date <- as.Date("2017-06-13") glue("Release was on a {format(release_date, '%A')}.") ## ----------------------------------------------------------------------------- glue(" A formatted string Can have multiple lines with additional indentation preserved " ) ## ----------------------------------------------------------------------------- foo <- function() { glue(" A formatted string Can have multiple lines with additional indentation preserved") } foo() ## ----------------------------------------------------------------------------- release_date <- as.Date("2017-06-13") glue(" The first version of the glue package was released on \\ a {format(release_date, '%A')}.") ## ----------------------------------------------------------------------------- glue( "The first version of the glue package was released on ", "a {format(release_date, '%A')}." ) ## ----------------------------------------------------------------------------- # no leading or trailing newline x <- glue(" blah ") unclass(x) # both a leading and trailing newline y <- glue(" blah ") unclass(y) ## ----------------------------------------------------------------------------- x <- glue(' abc " } xyz') class(x) x unclass(x) as.character(x) ## ----------------------------------------------------------------------------- glue("The name of the package is {name}, not {{name}}.") ## ----------------------------------------------------------------------------- fn_def <- " <> <- function(x) { # imagine a function body here }" glue(fn_def, NAME = "my_function", .open = "<<", .close = ">>") ## ----eval = FALSE------------------------------------------------------------- # glue(..., .envir = parent.frame()) ## ----------------------------------------------------------------------------- x <- "the caller environment" glue("By default, `glue()` evaluates code in {x}.") ## ----------------------------------------------------------------------------- x <- "the local environment" glue( "`glue()` can access values from {x} or from {y}. {z}", y = "named arguments", z = "Woo!" ) ## ----------------------------------------------------------------------------- mini_mtcars <- head(cbind(model = rownames(mtcars), mtcars)) rownames(mini_mtcars) <- NULL glue_data(mini_mtcars, "{model} has {hp} hp.") ## ----eval = getRversion() >= "4.1.0"------------------------------------------ mini_mtcars |> glue_data("{model} gets {mpg} miles per gallon.") ## ----------------------------------------------------------------------------- con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:") colnames(iris) <- gsub("[.]", "_", tolower(colnames(iris))) DBI::dbWriteTable(con, "iris", iris) var <- "sepal_width" tbl <- "iris" num <- 2 val <- "setosa" glue_sql(" SELECT {`var`} FROM {`tbl`} WHERE {`tbl`}.sepal_length > {num} AND {`tbl`}.species = {val} ", .con = con) ## ----------------------------------------------------------------------------- sql <- 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) ## ----------------------------------------------------------------------------- sub_query <- glue_sql(" SELECT * FROM {`tbl`} ", .con = con) glue_sql(" SELECT s.{`var`} FROM ({sub_query}) AS s ", .con = con) ## ----------------------------------------------------------------------------- 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) glue/inst/doc/engines.R0000644000176200001440000000071615170264110014504 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/wrappers.Rmd0000644000176200001440000001224515170263227015250 0ustar liggesusers--- title: "How to write a function that wraps glue" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{How to write a function that wraps glue} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(glue) ``` Imagine that you want to call `glue()` repeatedly inside your own code (e.g. in your own package) with a non-default value for one or more arguments. For example, maybe you anticipate producing R code where `{` and `}` have specific syntactic meaning. Therefore, you'd prefer to use `<<` and `>>` as the opening and closing delimiters for expressions in `glue()`. Spoiler alert: here's the correct way to write such a wrapper: ```{r} my_glue <- function(..., .envir = parent.frame()) { glue(..., .open = "<<", .close = ">>", .envir = .envir) } ``` This is the key move: > Include `.envir = parent.frame()` as an argument of the wrapper function and pass this `.envir` to the `.envir` argument of `glue()`. If you'd like to know why this is the way, keep reading. It pays off to understand this, because the technique applies more broadly than glue. Once you recognize this setup, you'll see it in many functions in the withr, cli, and rlang packages (e.g. `withr::defer()`, `cli::cli_abort()`, `rlang::abort()`). ## Working example Here's an abbreviated excerpt of the roxygen comment that generates the documentation for the starwars dataset in dplyr (`?dplyr::starwars`): ```r #' \describe{ #' \item{name}{Name of the character} #' \item{height}{Height (cm)} #' \item{mass}{Weight (kg)} #' \item{species}{Name of species} #' \item{films}{List of films the character appeared in} #' } ``` To produce such text programmatically, the first step might be to generate the `\item{}{}` lines from a named list of column names and descriptions. Notice that `{` and `}` are important to the `\describe{...}` and `\item{}{}` syntax, so this is an example where it is nice for glue to use different delimiters for expressions. Put the metadata in a suitable list: ```{r} sw_meta <- list( name = "Name of the character", height = "Height (cm)", mass = "Weight (kg)", species = "Name of species", films = "List of films the character appeared in" ) ``` Define a custom glue wrapper and use it inside another helper that generates `\item` entries[^1]: [^1]: Note that delimiters `<<` and `>>` have special meaning in knitr (they are used for a templating feature in knitr itself). So in code chunks inside RMarkdown or Quarto documents, you may need to use different delimiters. ```{r} my_glue = function(...) { glue(..., .open = "<<", .close = ">>", .envir = parent.frame()) } named_list_to_items <- function(x) { my_glue("\\item{<>}{<>}") } ``` Apply `named_list_to_items()` to starwars metadata: ```{r} named_list_to_items(sw_meta) ``` Here's how this would fail if we did *not* handle `.envir` correctly in our wrapper function: ```{r, error = TRUE} my_glue_WRONG <- function(...) { glue(..., .open = "<<", .close = ">>") } named_list_to_items_WRONG <- function(x) { my_glue_WRONG("\\item{<>}{<>}") } named_list_to_items_WRONG(sw_meta) ``` It can be hard to understand why `x` can't be found, when it is clearly available inside `named_list_to_items_WRONG()`. Why isn't `x` available to `my_glue_WRONG()`? ## Where does `glue()` evaluate code? What's going on? It's time to look at the (redacted) signature of `glue()`: ```{r, eval = FALSE} glue(..., .envir = parent.frame(), ...) ``` The expressions inside a glue string are evaluated with respect to `.envir`, which defaults to the environment where `glue()` is called from. Everything is simple when evaluating `glue()` in the global environment: ```{r} x <- 0 y <- 0 z <- 0 glue("{x} {y} {z}") ``` Now we wrap `glue()` in our own simple function, `my_glue1()`. Notice that `my_glue1()` does not capture its caller environment and pass that along. When we execute `my_glue1()` in the global environment, there's no obvious problem. ```{r} my_glue1 <- function(...) { x <- 1 glue(...) } my_glue1("{x} {y} {z}") ``` The value of `x` is found in the execution environment of `my_glue1()`. The values of `y` and `z` are found in the global environment. Importantly, this is because that is the environment where `my_glue1()` is defined, not because that is where `my_glue1()` is called. However, if we call our `my_glue1()` inside another function, we see that all is not well. ```{r} my_glue2 <- function(...) { x <- 2 y <- 2 my_glue1(...) } my_glue2("{x} {y} {z}") ``` Why do `x` and `y` not have the value 2? Because `my_glue1()` and its eventual call to `glue()` have no access to the execution environment of `my_glue2()`, which is the caller environment of `my_glue1()`. If you want your glue wrapper to behave like `glue()` itself and to work as expected inside other functions, make sure it captures its caller environment and passes that along to `glue()`. ```{r} my_glue3 <- function(..., .envir = parent.frame()) { x <- 3 glue(..., .envir = .envir) } my_glue3("{x} {y} {z}") my_glue4 <- function(...) { x <- 4 y <- 4 my_glue3(...) } my_glue4("{x} {y} {z}") ``` glue/inst/doc/wrappers.R0000644000176200001440000000430115170264115014716 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(glue) ## ----------------------------------------------------------------------------- my_glue <- function(..., .envir = parent.frame()) { glue(..., .open = "<<", .close = ">>", .envir = .envir) } ## ----------------------------------------------------------------------------- sw_meta <- list( name = "Name of the character", height = "Height (cm)", mass = "Weight (kg)", species = "Name of species", films = "List of films the character appeared in" ) ## ----------------------------------------------------------------------------- my_glue = function(...) { glue(..., .open = "<<", .close = ">>", .envir = parent.frame()) } named_list_to_items <- function(x) { my_glue("\\item{<>}{<>}") } ## ----------------------------------------------------------------------------- named_list_to_items(sw_meta) ## ----error = TRUE------------------------------------------------------------- try({ my_glue_WRONG <- function(...) { glue(..., .open = "<<", .close = ">>") } named_list_to_items_WRONG <- function(x) { my_glue_WRONG("\\item{<>}{<>}") } named_list_to_items_WRONG(sw_meta) }) ## ----eval = FALSE------------------------------------------------------------- # glue(..., .envir = parent.frame(), ...) ## ----------------------------------------------------------------------------- x <- 0 y <- 0 z <- 0 glue("{x} {y} {z}") ## ----------------------------------------------------------------------------- my_glue1 <- function(...) { x <- 1 glue(...) } my_glue1("{x} {y} {z}") ## ----------------------------------------------------------------------------- my_glue2 <- function(...) { x <- 2 y <- 2 my_glue1(...) } my_glue2("{x} {y} {z}") ## ----------------------------------------------------------------------------- my_glue3 <- function(..., .envir = parent.frame()) { x <- 3 glue(..., .envir = .envir) } my_glue3("{x} {y} {z}") my_glue4 <- function(...) { x <- 4 y <- 4 my_glue3(...) } my_glue4("{x} {y} {z}") glue/README.md0000644000176200001440000001114315170247177012500 0ustar liggesusers # glue glue website [![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) [![Codecov test coverage](https://codecov.io/gh/tidyverse/glue/graph/badge.svg)](https://app.codecov.io/gh/tidyverse/glue) 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 string. ## Installation
``` r # Install released version from CRAN install.packages("glue") ```
``` r # Install development version from GitHub pak::pak("tidyverse/glue") ```
## Usage `glue()` makes it easy to interpolate data into strings: ``` r library(glue) name <- "Fred" glue("My name is {name}.") #> My name is Fred. ``` `stringr::str_glue()` is an alias for `glue::glue()`. So if you’ve already attached stringr (or perhaps the whole tidyverse), you can use `str_glue()` to access all of the functionality of `glue()`: ``` r library(stringr) # or library(tidyverse) name <- "Wilma" str_glue("My name is {name}.") #> My name is Wilma. ``` You’re not limited to using a bare symbol inside `{}`; it can be any little bit of R code: ``` r name <- "Pebbles" glue("Here is my name in uppercase and doubled: {strrep(toupper(name), 2)}.") #> Here is my name in uppercase and doubled: PEBBLESPEBBLES. ``` ### Data can come from various sources glue can interpolate values from the local environment or from data passed in `name = value` form: ``` r x <- "the local environment" glue( "`glue()` can access values from {x} or from {y}. {z}", y = "named arguments", z = "Woo!" ) #> `glue()` can access values from the local environment or from named arguments. Woo! ``` If the relevant data lives in a data frame (or list or environment), use `glue_data()` instead: ``` r mini_mtcars <- head(cbind(model = rownames(mtcars), mtcars)) glue_data(mini_mtcars, "{model} 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. ``` `glue_data()` is very natural to use with the pipe: ``` r mini_mtcars |> glue_data("{model} gets {mpg} miles per gallon.") #> Mazda RX4 gets 21 miles per gallon. #> Mazda RX4 Wag gets 21 miles per gallon. #> Datsun 710 gets 22.8 miles per gallon. #> Hornet 4 Drive gets 21.4 miles per gallon. #> Hornet Sportabout gets 18.7 miles per gallon. #> Valiant gets 18.1 miles per gallon. ``` These `glue_data()` examples also demonstrate that `glue()` is vectorized over the data. ### What you see is awfully close to what you get `glue()` lets you write code that makes it easy to predict what the final string will look like. There is considerably less syntactical noise and mystery compared to `paste()` and `sprintf()`. Empty first and last lines are automatically trimmed, as is leading whitespace that is common across all lines. You don’t have to choose between indenting your code properly and getting the output you actually want. Consider what happens when `glue()` is used inside the body of a function: ``` r foo <- function() { glue(" A formatted string Can have multiple lines with additional indentation preserved") } foo() #> A formatted string #> Can have multiple lines #> with additional indentation preserved ``` The leading whitespace that is common to all 3 lines is absent from the result. ## Learning more glue is a relatively small and focused package, but there’s more to it than the basic usage of `glue()` and `glue_data()` shown here. More recommended functions and resources: - The “Get started” article (`vignette("glue")`) demonstrates more interesting features of `glue()` and `glue_data()`. - `glue_sql()` and `glue_data_sql()` are specialized functions for producing SQL statements. - glue provides a couple of custom knitr engines that allow you to use glue syntax in chunks; learn more in `vignette("engines", package = "glue")`. ## Code of Conduct Please note that this project is released with a [Contributor Code of Conduct](https://glue.tidyverse.org/CODE_OF_CONDUCT.html). By participating in this project, you agree to abide by its terms. glue/build/0000755000176200001440000000000015170264116012310 5ustar liggesusersglue/build/vignette.rds0000644000176200001440000000047515170264116014655 0ustar liggesusersRMO0.k֬W޼'l4^كf)l#op#0Eҏy7kLHa`Z`2K"ʋL֙%uYUY̥ojJ&Ѵ`2oX)aͣ4Z%QǙ(bwZ- fīgfh_M=RmgSEC3irv@:C`9zѕo3/`ZR(Y nK(Q).l{^qX=Vi]H6b Vۊ,̰$pokhglue/man/0000755000176200001440000000000015170242707011766 5ustar liggesusersglue/man/trim.Rd0000644000176200001440000000203015170237027013222 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.} } \value{ A character vector. } \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 indentation preserved ") glue(" \ntrailing or leading newlines can be added explicitly\n ") glue(" A formatted string \\\\ can also be on a \\\\ single line ") } glue/man/quoting.Rd0000644000176200001440000000150515170237027013743 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.} } \value{ A character vector of the same length as \code{x}, with the same attributes (including names and dimensions) but with no class set. Marked UTF-8 encodings are preserved. } \description{ These functions make it easy to quote each individual element and are useful in conjunction with \code{\link[=glue_collapse]{glue_collapse()}}. These are thin wrappers around \code{\link[base:encodeString]{base::encodeString()}}. } \examples{ x <- 1:5 glue('Values of x: {glue_collapse(backtick(x), sep = ", ", last = " and ")}') } glue/man/glue_safe.Rd0000644000176200001440000000330415170237027014206 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. For \code{glue_data()}, elements in \code{...} override the values in \code{.x}.} \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.} } \value{ A glue object, as created by \code{\link[=as_glue]{as_glue()}}. } \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/glue-package.Rd0000644000176200001440000000226315170242707014605 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glue-package.R \docType{package} \name{glue-package} \alias{glue-package} \title{glue: Interpreted String Literals} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} An implementation of interpreted string literals, inspired by Python's Literal String Interpolation \url{https://www.python.org/dev/peps/pep-0498/} and Docstrings \url{https://www.python.org/dev/peps/pep-0257/} and Julia's Triple-Quoted String Literals \url{https://docs.julialang.org/en/v1.3/manual/strings/#Triple-Quoted-String-Literals-1}. } \seealso{ Useful links: \itemize{ \item \url{https://glue.tidyverse.org/} \item \url{https://github.com/tidyverse/glue} \item Report bugs at \url{https://github.com/tidyverse/glue/issues} } } \author{ \strong{Maintainer}: Jennifer Bryan \email{jenny@posit.co} (\href{https://orcid.org/0000-0002-6983-2759}{ORCID}) Authors: \itemize{ \item Jim Hester (\href{https://orcid.org/0000-0002-2739-7082}{ORCID}) } Other contributors: \itemize{ \item Posit Software, PBC (\href{https://ror.org/03wc8by49}{ROR}) [copyright holder, funder] } } \keyword{internal} glue/man/figures/0000755000176200001440000000000015170242707013432 5ustar liggesusersglue/man/figures/logo.png0000644000176200001440000013537115170242707015112 0ustar liggesusersPNG  IHDRޫh cHRMz&u0`:pQ<bKGDtIME rIDATxwmQ W餛&$ , y&[mg@ByZضs@&kaJ+!b'mۮ |70Έlg3$4A |3/7,krږ*"`d,t (Xc`,G9]סk[:r /~ hg3 s?kuUA EEZk-ڦCm8vLy|Jsc`, -5,Ҭ0u'|nO kg35A[ u_* 1,gy!',sGl1i,c`PA#sa(k`EQ}C{D\og3z ~+X-RsEk-ln$;bKa.[֐m .`N0mu%sm+yl ,׃N ` ngyZO\~ زv5Hs5ko(F TZ!ڎa#Ϡ3麝:#{| y{c@p=J)dN s/MZ~oZ6,٠R^&"tueȊI>L{vR8U*>hE˲-ЇXO@A?DD͛7qҥ;vFǴ^GO"ɾrccV .x|pOYgj;#CZ/Sa~_ w\߾$5ۻC88y1(:D4Mku]Wu\3^i=q.pIz: ADBe]ȲV* qd 7BBxw&|XY-p~p?)zAvNHDж-,%(;5gpG^uFnr fj}08SƠ ɕa,D%0wiMߴ-l!+ &AZkiZCVµEN>e ȇ%D`4F㑃]a\"s hRJ;p!s;Ugj [F_|A\  tUf}}THJ,Ngq3~3d%$IHd)4A{4u|p8H> ?37,ɞkjq>q0vPvNR=JaB /Ÿ1>q=w}/{'Ƨ$VfI^BPP}:aYUhHSJ,K  PDx9@v-MLn' Iq-2蹫)5l5n+IԒ%Uu?OM%ϳ k@&1yX *beiw70]#.? ｝ϔ{ g=8(c !ỶC[u~V ¶<ː y.S6 ?,M}77ѳ"lKM@.0Zw'('e‹x#\Y~ bx=t]ٽ Ut#lR u|Kh"_Oϔ MTNn>!щ@ 2wn+apx虮?# /Z[7e '}^!!~aa&0l< ;!pXcUܠ,ȸJ9X樎D|0ץއW~w~o¹ D_l;NC@%<9pqv11iӍ8-e4Y>H}u]?׽-3Qo#3oQZRj(E nᗽnG`z2 ƞ$F,< }ԕ̪ JhozZ5XD#N@JT>*~ܸ1 15Xd$` k:(Gdrpl"0 9O/_maEe(RY72aψ7I,J\쫈"9.] '/O.DB5Jþ5h`< >`3'9_ /ODZ'* k1)-r&Mc]"Օ}ni쯟[Wӽ}DAϨtW_>ыo!<>.o!F'E:}ӯ}ܾۡ,3<008Wx3.އ~şZJ~uIr͊Nf32|Qg Je#4>k0j#֍ ? ;D5-%bWH]@DsZ"NoW- ]?@oOVg(] ݏCu@iGH2_Lϐ>1 YGI|=ď2 U]'v )Q%U.=V  ?#`1 !0*D(l`K+ZQgE׵1ekB.cրx1+,Lqr:A}Ԕ8MKpŰo%4SvGK ;^W=LD~nz!wÚk4ˊViBY |޴&EXb9c>c6S\ϮP׵LeIz3~$G Nɏ?ot=R>5 "ZCg[Pv}Y+Rl0Z=N 'L]}ފYߥۻ+iCL&8 YeB[&k7tshp&LxN%rM0y2C״0,Zktu k؈51_ZE~}oO{M9/mݾIwM]1QN2J[v|P(/(X8gyC!>k0{כ֮?^ UV͕qկta> qO/]Yơ-ک;")1X(KM9եiZf(Zh Tub=`X=BOkXֿ{oOaK @|FT F !!}}XYUtoگ[^t6AK4r1zOzUnrr- J<"R ?)'nl G!676ob@B9x>;^ GDqcUY{-`Q>XwB oJOt\4H$wCk-z)XgZA*bG^Oq2cYlM ҊKTWC85?'`2ʶU8;b{8Ne&l߁VS oR>lQOŧ&ppC!JH^SxXFExFmHCXEpۋύ{O$lSk~ZAQt kڟE?-܆YreP"ắ #顗Ωu}@ "~zQ '9X}۶t6tt,ϱxiq0Jn<i.ӑ6 0}?iYE\┮ܥn1][UsB^gH5\T&Kc.&2DiBtaz\x}T#]վao]RM;$ v9G5n[)$P&!qLr-p" *w($%iT|k]ڮC51677bCswn/B [x->e kxpnu} s!Iwfuq>!̏{$cYġ{Yy%BZ!PRY=!Ҵ_ztu _G3`ZЭˠ:y EF>{E% OЩ"X-IVK(BaJ=aʙ/ t`0`8 sL&t][{9c_t=C [s2=Eh'6= Om]Q.X˚$\L!>D;oxrڻy9f5dby1 {QaMpf %w|m 燵HO:&a~7t֡3θ7N6it.#'hpFy6>GWn89A%/Ztun-(&7d 'a;={'5ݲv}3˨,K<ǹK0R2 2π[r`pJFBx}O>Z hWyRG ](< 5iVȊ\B>,Ycɐ:IU BݵB1R:6`f1Ѵ-F<&Ff10Hɰ8N7~ړB2'beYH Mk2A6a>?y[W0DI|^'LA=&WIT/`6 ku`Dqz݄ھ~l/]BZxuNYq}D8c R&5)_L PA+9sF#exn\.Q5Fá [| g;=iaO(D [V eIp'ja)mF {Zp^~OJn<zj/%wO?PQ@;[@W>|ݠ2` 7\.7Y/nx Q0G$r7^-lQkɪK4hAQ5bNr&+X?'#Bk\E_+(>F&hg'#C3/wUѧ,}+4%}E 7{1 􁷁v8k\Y/>;l܀upwBʤ>嬗NL{k>^_%Vѱ`A/~RY[mH7Q%ƣerl(0r ׂGHBF,AC&` mfY$syֆBbWh*d9uxhԍ0$)j76ڈf;CB<##ytutڥѶ3]Sþ @ : ^FNyAM]qP" uRm52Ik[z6G[`R{mK4E⳷]`vQN)oblz&FXO.+CTS4e2{bAo67A4d2ckw{a~O`{&Rוgc-ϡG?ےdpDv-6R֬Ÿ:u 5<ъ{q2(7 sd.Aޘ7\'례ߍ5*@3g$8ZQe'".2G7s*Ӷ#<)墋:9I κQyXE,8{ ܷcg>R(FCBbqn\iQ61A4cOgP? ̉ 8|E` _+ sܾβ|M\|P[MnDOkFQ~?P@7]~?gk"98x7"{}(~Nm1)wWD88i{5 }ݔEG N;`SNXȟk"ːX \cw;+Ek»$]%' SZ~L$1_#y#0,Da\@#ɣk@m<æn ;Rh -ֹ`dM]0úqf ib5+!z@ ư|߄F ͢Lr7 _RuhKhvjKgH :@w9\,@DؘL4-h^|poO%BR d"OęGC5&L_i MbnrwB 1)f* :+M؞z։ U^4Q7^,=tw#U0P?)T>,GQbbNf|EnR:"P%:zq^a&}1? DBg&o-[wg9Ѻkg3ƣgN x)_m"VN#} ` 5sSE(<}@HU*%%[PQI/nu\&[W4[Ayo>?0vȣC% s'@gao{aj_kMn, cw1ؽkȋԱBYv{dejz :^eyYw:G*~oق(K(aۏX:L : k:䣁+.  B 7/astƬh-t]]t)73F,n Ypf5(eob %TIl2JH!HC.Zoݓ=]%\.s/~H@7vXПY^uG KˇyhX }LG edP_aJ. PaV» ̠"[O20.hc5H 8NCUUZcksE^V2oM~\:%^"}R: .E̒py\& ޽Dj - d,ei]hq[t髝DXZ' izo'Úli0>weʆ>-Y!b6j3N qȵH ר#ܔRvwc 60ژ*T/1 a+ܣW{`SxLsHQYnWS]CmtgAz$0"Jp.직"Y$e()-ʐ1qX <a1aBRbP)DgENP*=*nMz+&#apgce&;ch{{{ KL"z-b0 }q?ik_"˞šd&߿D;LH/ kZ 0!>&BqUfo L _Ju`dK su+y$xMpa/8ߏq J)lJkn|?kqxE\KUn+-JiPaHnubҢW$=:aJڹ}PКUeb~0|8u6_ ]_)Y..9z ;Nqi峴OԳ뤫u2F oēKDi OwgrYO[n]}Cg:zC|%wW:Y?%gЪoG[}- z%ke?ޘ@]hYOc׊OзxB}[7/2)/[.Mf׎/mA5/2MBeZ_bG$7頲xYY_#t-oӶ0],^0` w/5f9676Bb^+10}%` ^r ᡑl"yV_ӷRC,WZZx lӺں~z wuM0D!v]U'h[!Y,5L/V~YM"BUM/++gqj}㾆99x?*rSk ]FcC=])ME̸&SNTӹHYVsW&A[UXhH؛͢Bu0OXZMsd|~aE܍}}k- !j~vgQ:sY67/ 9]nB4h& M5{U}PWD`y9'DQ V FY3t e +"/ :C>b\Izk+eYLZgm 8&,}0W$<5:!`r^FKBdUr]Ű4P!y9b^$se@rg~i]vt 0)F.-YO܇㨱bXɲ d(܀ѰRA|<DplPDa\` D}1.nµ2|f uVAO;%R.)j +xuTz =-'ΎgCP%WA֢9!sjR+gF_dAm°G+aN+Jȩ67$0|q$i~H2^_8a-q  w/x}ƨf)n\;i;q0w;WEomLrk n00D•zc%P֢O ~^#p%|+2>'Oǎ]8rդ07wRJu ]ty=֛,*d͐ꅢ^H DV>8) !񉾶ʶ&ŸE9&S]ڣ{֑uXPqưVb}#j'LWc]&Uu]4@!i3`]_otXi F: oU +MGH tqB@/qQ&)Qrb4?Pz*s(J?=_J["ī\EvUT$eqrV:鰻O+,+ Kr Vh?vAĿbi^BJxynbvIĮe4ULJU)=Hdkq=.Mmӈ.nqWxC@U{8|DoWRz⋻:^Mxo^]Ӹ EԊ(8RD}RAʝxieW^Qx*lqS5"*Tû0E}fXD 8) os4VdJ%A{9͕w:28N%u84]7B\Ư ޔlR!IJdC8!q#y9ruZFDJI[SWZcM8YtaCD~KQE^'k$JGHMH~B"m`>urZϗrNLi* ku*7uy JO9SLPOuN׳sTz:w)?WuʺA=]nXif@΂^5f 7m4"?dA]@Yb%zo"Yjf9)t 8qf5Ra(+9y{FR|I a^gS"ehz0FV뺸j@=.3V. _>Nۥ3'*9RʡtP#2XVFHCGQCPgXPc}$~6?5X2!`Hфu u i(쟌`X\$d+zvKAЏB^Rm} 8(p$g=UE g^}S ׆C 0@YB4E k bC {k@{ [nt @el}ºډMDIHk%WkYĎϓP'҈bg(*֚(fiXץ3}-q %+l5Uz˰Z<ԑ9tt-<G!q$\SkXiCBnn#8a4oÞLAee}= oަ#Z9'yi-T$ƹ0KbVQ[5 b6eYuxƊR;'Ȇ`i9J Xk@ .V&; D_Yċæn]:a_:ø|0/߻nÐۉS8D ")8TJ Z¶ͩpͰ6u1$ o& /xyG9FHHU}}J^̾oWhoOEP|,#B`|%_Z6,kY*QJb|T-av}u]VslںNGA:<7O(O|xn.R湁.s_kyZCJ2ut 5WZ!.yRS75#d(*YQ + ^X`+yC~o4u"[3k-N"v,r2|&2 #gr) 79evWh|UUy+ Vƥhl  [2D]9~ J1UIN8^ߋ桡rqVDAwd͑h2s`y.acLEf甜J" Cq;-P$^1&_oDEXMGԷ^'~ 5l~-$0Vg>m۩H ޡ\k<x:d]^68u5&j%R\KWݬ( UJ܈൭O+=]f\4R ဂR1ۥgT. ,굮) FCzN >]T#Fw?tYk0]ӢY{Nl:.UMx$F)dYfz[vj{1*,EḼ'J2-@Db:~u}czyIr`/^< ^9)pxYor9A]=5zwH1=QkZwnՐ+.boQP *dgY32g4`,(Wr )Y;DEpR&@Ꮢ-SpfO#%)U5E%@u{z]VhnqA=_ƴΠy0i:rjtA ^mYSF#׻ssUp`P/X5&Lg;@}0M%7]۪E 0`{AKK̮#O7'^^k,~Xoaqs?p9Zr 7C Ul:ڭs\$@F,i|_e*}ג3r;0h4pP묘yR2lV$},"C#ӇfyŁ ױk-.h4T@n8 f}35xZ%;uh떳2 Gj^lˇ7go%DJZ(1q"d`Q1p$[4[Gp3reZS=_ % B 2f@>,k䐉}-I8Ԫ`򢃼(|$JN:BVPx=%Se)!(R_Di\1^f{EpoĢ)0PZ{2#>ȺbuNOޟ( WGtYĜT!%!Jt(?u~:߹(?ndцiZKi~,u9ʏՁzzGT=q7VQ%b}GƑszC8奊bƪˤ.EjPzЗBGꈂ+)zCs! ^Ҷ gFafCvHOhw QzOMtKJ| W4YfˈY} >b]#@U=KτÍ[LNrxq`I6,'> &)9UIXPFk%+_0LhH9Ձ |X9At,ry SJ֡|4N݀`~a Q,i\~aYl>*;69mKPdRˣ:/6d#`L\eC:PP/sG;leI ]9US.Opi~n??/m\8- yY>67|0T /D k-ӟb~RV!>n: }·0X (Galt#SkquI@A:"eZ9C [ טslqL%Td\tDcZ_l[/*5 *v@'?lN1;zlkk,<0+QkǠztR=" l@e=uFv*G0j]&ԧiuu)F@1 8%kk&35p'B}6bZeO"2HB%,,g8ĉuh;.Ǭ~N)+,D zl?KDML~BDO`MHb~J"P8dD%EY9ݯvǜxm4`Z2N Mqxx6{*g >["0>1D$X(،2O bNmbvu$H.띭;@ʐ" k3⹏}lP8r1Jkev'A(C(M){9@B҇dxK4A4p>׊+9e1⠓vYYmarRɱb8t}c]qD1@8<=Ws-Y,ݭ 5b4DX 4PGi0:(C4*/ VnYKȭk|xHsQLIK(=*>e-DRУh*-6xF'WNb@)QDɽ;tRRX!T VoK{e1d`6@e r0گ @1` )$""LP1?)qK`s"mB.La>nŔ?(HEIh29>\/qdbqJ)*晷4Q (t|~CHgR` OJAN)a|sO8nnYc2]w={}MxI;lx62+xY?ް$!D5zw.s4ƽ܃`0Bc ._o;x)kWaM="}5D#'Jy:_tXW$Y`qcDgEdooƍ+0ꂇ55p>@{̵kc?/;|wa{^/s\ q|%ٓ׹\_bY{\R>١wP[=3׍59[n\"2 Dެ#XRȴI`uم>64c{_5Y+4 Vf?~ޜڋ63P [d:+예ech-(|_NEko}P׬KB=)q>aw:W^ sL51xނ-3  EQ lgG?=#/Y>G( vr."Ӵ^z:O̗^WIvu'fʍ,iL@u0Ogs\$a7E=܊38vz}an>Orx 78;aTĕcX7~uɔ+}Qz$+[E̲Aܺ)dG}c9RDE#Ȣ]} ڶI瞈 m{@vtA/׭l+uXqt0MƁCu8|-q1Ē$3YWlzA SEfӰ7BAZ&nKs3'8}bZFNCwwnm0nCO]p1"98Q|~'YL: V9܃0rb?APn`)CŠxWymhywVBl~߼7np#o|i"Ν^]ж._5w_Bkׯ͛ ﾻ1֎c:ʕkhy/bggk8W1/ﾘJ)Tx;q⽫Kj}_#R]} %(>~a}8fѓ(5']'(a6RԚk$_a#[ HzŔ~n@S{c$oyg|BTxчr˦iq:w.vw7Pڶ͛+ŝ}Ng8pzk-X,^[ nڃ1%^kŭ[m[ܼ*ST`>UR ׯ=Eu5BI>q@"*+8K_\Y)^gj6弒cz\yVR:Z$Z)B :i U>*H{p$Z- ih@.D5Zv"Gl il^g+ߚzYrtok\%:s~#@Zc Y^mkC8#m#ƑYUپ %, K[>(aLqŹlJCuuiܛ"+b-i5Du0 zd+]`w(ETIWoW7Xr,U }Aށ+1m?CB,:'lyb1yu230+0@&%no f9Cd5,~QklIΚ,ɪoDp 5M;J}<0ƓNc:l(X4uʝ I$ ô/QQMۅ6^ҙ+qkYIuRD{,C1p&>W\ͨ h s mcPQu# 6JH!\~>%YTk Vh)};FQH+h&&a0DȊ<a!/9F^Rb.W,"÷,qȚ\ ӿCTo1?A!ЏX"C6((Y"Ub!^sA+ 77z '؜,L/4Q$˨nmĀ׵0ܘT]ӢQѣb4`s?t('#a (.OtvMrcr*^#߇{8ѕSCG@CR&~z-d1% w>khuu@/x`K&9d)~Bn]_sRB=U²u`+9$-x!8L]j S-nG$NEs)3}Mx2ީY;U!Ԡ~ DK1"R$"(Dom#y% Θ#[s_35~>A@ib:Y4R`_<:Cev0Zr>4ˢf]YMi ]T"}ِe,3ipzw8%GUX\\ۺ'S!",*dE*,Xcy.y]"6ֳt BbVcvhKdev]OȊܩv)qUnPnqjܮQ$X`Gq 6Ȝ:)zŀOā9%K[Y9 @AJ]]tMҩTb-Y WEi.V9k@j拠 lΩOY;y(=\OF`; fnH_CnTT̰<ȭkZo5}85,F2biv}/)&0qϮ]֩ڟcy`{6P[+*Y="ĖEhPU͞etQ'G_ٕ;J!Ȳe׋\>+ G`,p=GD zw>(y4/V9)YF2&]xN`\+Fcv:eVqEe\0`Uu&- Q߈Pd@D~E@pVfꆃ@bʒҖgv[ 0%Œ,hnBy\`d'm=_jNS|&Su-к}_3,\x_ (屆a:b5\W l_(_[UUH9u`?w٠L#'bDE@M"{uywY!p7LcxVlmad0`K`eNhE9f9::ˠQSwBPJ#ϼ]ߗ s*ט`P \]g\kercb4 inhgK의c1^ZsB8R sl=4 ٰpgc6,y]Oxmho_9"|`kټw t/b dvK]A~:w (E}Cr5y!60U5G_E ?K:h:v1قdpؽq&hqq˳$a)CZm|_T!S{k qE8ԉ}βw̹4}.[e:=t`1TkMmX4Y)㩀5 Aī% SEs/GMK0n%t1D7;6d Y(j&T@gڀg hqm<t]o_Ĺ]`6[{H9(p9rN͢VuEL&v9 -:c8ΝZ;Kjp)rsVx{Cj8tƣdD͍sPh_@.xdB Zϳ̺>gʈ$Ji(Dk$"Y>ԷJIoƭ`ϱ@5%lCtʪRŦGÝrɊp(=do.OǴ]I?6׷[Up"MEu1A Xܠtjrt`j'pDqR5("'Β3 R@Oď'~u᝴@bT).kG&Vǡ#p#8r %2YSFMPR>1fzr'fΖ8;Z YVXZ;\G FjH]Wfs4%zVA󣡵F=] e@(a $>QLȱ̖UDr:#KT\6g@`^/\!^7rx^UҨtlhoIh^N:{de9;Ayu [>) !ZjPw.>KZU]`~z~4nA'~ɤ4@'|Jp`Uǁ'` +%L&c@Tdӡy4 #^1qD݂UTڳi}sY:j,g:@=!VGɽH,DZIC*wڶ~`8Xa/Mrӻ2!i:tM񭭵h5t!/ˈD1u|șt.+cpvN@3}5ԪֵK,WA+SLatn yQ>U>8 _h{۴ێQn Xvqk{a'Xa3lH0R n`2Ap,k9tf{8}wpAJT%BN !V+VXnA0„0b^8곞 CU3%'d53GDֳ𗊙3qgs2 u=tR2 Bv/7zh?SyP@"G@QUtPpP(q`30-9bomG$׿Lʲ4# s}$BNԔ!͸ |Sl.LסΡ3ش.2ԳE9r%^\ZG>6,PO0M[ϗ @/ f٣"VٱA }Rȡ -Ϊېa21$q s3k' 9C`fS22\"\0M{R7Y{z68pJQ5\swi%,194f`A[5mJ8=T[ѹ-:YYϏ\XO"R=[eSx{(g{ۏni}͑!C bGnb>)Z#/ST' ~[JQR$, >`'\pv\SJDi-q&ӈě1@q|)Qx֤VJA*&cXf Lq I>h2Y&rZ 9lK\A)_2T{SN|ط WkALHg(17؜*ml@cZ+l6s`Yu|Dbwܥq.U:+pHX4@jY{v5"[.Z{R (G;'4:Vb bCqs o. КZK' l'xW3:ɺ瘖9B,WT\/!t%fyԝ:3]^Z\kwSAD`?\& *)6ݺ Z<σnX4GBY"CUyЛ7M7z3>b35Ј8hp+Cxm+L=sN)W& X.#T3r1MUH+ ֥T.ta|܄G)\a}u$\EkB{ʴg)IK:!3Nlg`m#\~}Jri,bqoc EuihkBw2AYkQ Ӵ-kW"!z@=_$5E?Ct}EրmQOUu|z:1w֞qUݢ:aѫhp5ppFUk-]TG:=z'OWeFȤv(PS`k:iUE~,b]V /`<9e+X02(l-C;|Ƅ dxZ40&zxO׫͢2pilM0v \ n3h緐AzZ1J LF({7dn%˲%#b f(yYz$4Ux}wiݯڣ$ EĖ0HAR5ϑy#˳f[Z .Bv)`hb-,jX3wMH-epӜZxl:C0yտACH3:޽o ŗU4/z~F^˃)sc羌L̗noD&f7u&h-7X,{X`t~;!^k-wc_q*BBh΢U, $bcݤ(^ 0%LxV<pTqG*.(~6|k{~?k`ʷ[owMv:jX1}]XXـm5R%Up~`BLD/ty+Z]סiD,(ߙZGu㵶pTQ7 l,(ndE(AqS ٭sX?[rH5ʷ&TF?Wͱ-581&$n\+B]c{}[=mbc3̝(^3 u\uO$y2lX¶]r/☲3WP9(0MߧnJ#;?EgD4==@7Gڦp &PYF+AWnOr7ѹBvS뛻M9e r`0Y|udqM oʂCJw |P )1noVqB ~ BZ#j< S>/70 E:]v|a[g1`2 9s 0C1&11:"m= {E> 2{*O!G:ћJ[a n,tFbpA`4 u?St0JfbzW Qd裾D^iM`ksMۤ"/%vvIt70]:J8qT* 2)Zq{!N*8thyx oƛOȞ>ͺ8[125h!%M;YZyF::[ '#`"VȍKN~&5]]yjrv>1h:(rj [=&i-xQvFg˟maOCF#0Z"4%%wE<s"/3R(W^w蚖˫X,+tƄ8A3["A0mz9=|)?e`o=-x <:ȁ6>5^ Z1S=_#$nG5wLTk7P\hUrUǮǾb\eǮYvYk.[MPđP{{8N6L̦3%vG Տ)]cc g%uaUrrTB$+U,石kK'S <ހt:Д:(0pJ Zߗ1لYdPi!F[ RJCVj!aQ^ d*B(|89:Mup,Wk؇z-⸿}M4OZ#7$;YU'WHIA Z69] Ovjˊ=QZ2uN)7~W}5GH3Ʉ۔q](C9"MF7.gJwުm gt%KZ:Lgpv(kEH|(0pQÂlMB_9lP`ib:\c7G mw}t~`g2O*" D"w *5t枕P̉C»4| !#c:>[g"f-9 1X"4FAד}2Z# ~E}KF#+ c"z%? :zIjV ޅzX H ZRUD>阈a7ҙzkn߽(AKuO wXΌr}$G5d-"ԳlcVAQCñ:(#u$dE|B HFDaPn]JDA(GCQIgE#w8~z6';ۼ(Tf|a^t!&v ;l5 *_ظEi9 7'/o tVV)*%j8 K"n:iR0Q ź ngK#b"ŕUo|#Nn@r8kp{#ܐIܖ,|Φ9/S 3#s}IoO츶4 Yyc h G*Sˬ7# U=뒈li(G-w3QHRdxfI$ Bm>y͛Ȳ,0.+̼+L!J⺀`ޏ̲rTSne}Ns``ϝ|')F~*HRu5-͉oogήm<!2P/>2mk# Ex\vu \: 5o@pS(Cdy.\vb0FuPC>?=LK@S}qR[~z 9llE |iu8yyVt|Ycql)'TSaMma~sYY`@N.9e30-QMnoW_ہe*.~(p~g Q܌R+F th,2qk &>[yϑ3:Plc=DVEΆFhh|K<͂7y1;q/7~p"ٕt@go/(ov\H!:ۀ?&'0(>`W?xpMwsPdU˽ Y* {(GXm f䐳&/ q/%}ľWckeEw8F!ҚDk "{#tUPTb hjwc:yg+e/q |<ޥz&^"> ^ 9^LOvx7YP]_|p_~?XmuG o{&YY"3˽,yb=1fŔJK2*:>IDAT"R8r |"B/m&IP7!N;]"=(tD &^sYݟp 56/0!{/1w/^|C9ΏD`.&-|cu=l\ |+r/}` pn>xE]3 K!w` ۮsXS\M$K*%Fpa@{q(p}[F;3Eq%LӲU&v9!M۱.븩9 8,iɮE9  n_|ÿ.ǟ]P&лC$ hUkF /vrË^߿_~֭OҬ~w?8w`?=εAt yɇl]+[|{QtsS7-db3ŌtuiNĭg d;[Alf YW%4gEf@P.*K̴ \/QfeDSz& KhI%5YuP<ݒ2TZTt:Q:´et?YV1ix{"dȢdk:?_9ƺ=8b=Ooh?rbIn]F_^2g==蛀?x-E,"/g@8&6v8ןf0uiNlK! ֋ mՈ2:P,bKf `hAӶg"gĖ<tXpEFC3#KEP."INyY  _?&JD8˰1CUUȊy%2q}પ1W@Y[Wjm42Rg󰐾C;fP+ji!O>tx_#vρ3hWw6[[l/e=oLxmLȧ)3KSUTZA>/b]gE߾OpY}*-,=%`o_nˎ&:c:yX:BIk㥕Pȸmg`Bg+gJ(`h>qSsƥm5|X+3ptU v/<=:SY,% cD. <[Z9sN2FnW:=FNq ͑{);rS}(?|=?~;(w= ҿu>a9M#;HDd]բrO݇sˈ~Zkdejo .,jvG㝳ro؀" d|B:1p <}5fß]D1,k\gؾLoYtPթ31R!(+9+`B'c?  d.lqX /̢p&(ZSȂ ,O( k? i2e}u0 ĩs`٦7,5l,53XH_^ZypzuGlLg('CNL;dc_BVluedz.Q"y$b"xk-A+Esk}ee"8"ċm#GF2D3mK@=Ϳ~s|:K}sB961 /;܀CLvXdrZ?0\1/~իfce[_O%m6>1' Bl-k0IP-+7{UJYc;,>:Og+867~'aRړi}E/\2ȾҤuH ~`Dsa]>x c,6&Pg@`z7u)eH hIf ,wPO| hK,ni IOx';~'ڟZ]plel[yvEUlo']R=}᧱țez|).-|}pvÀ剮./>>|SaY>|k+]W ,.D_WB-eQ*f dYȱeχ%jze VE\@E]P:C^9hMDS/e:[5+-П9, n{h90˙X[pF=mzX՚7`{X1YDH6L6DdPnab?vY]nM\Q.2iZ n|i[G~ pqT;w ƭsN,R¸Y(8y|;paCǞ[k0 1W) w]Ҋ}ō( !ʖ!➫)ᒄS"$ᮏS 07:ǻv cYp,g>vÄP`8<W{m#+" OӆCN#4\|(PV.2>qj*Xo&- IGdpmm悠aC 8r3];# Y77` q}P "c\tH|cc'iwKC}H\r\ΩNx!zRQl LeS8D "?u*o:;_LJ[)i  P^cqǸ =D~8c\ ޑpuס<ϕ.]dՐy=0O3A6*}W8kZ, .J)d:rR砈6@.#ԕ>I^H}qE\|kŲ^Y.q2-lNkpel y}4z]՛bBR`{8;_`` OUGOшD&:M>=mG*98ce(@߃|_PMi.^xtLFmݞ˲lBɇh 7nQ ֔F)خC[G+m;tu|4ʢb=e,Kpρo1F.i WaB3 eC3Fs՜ Z ZODts۝Ż/J>=o9bh5gQ"lIbPrRnS>/J߳ n~?K +U ػ:f++&ua =/x9>ɭ6_nrs\7|Ʌmv,P&/y1WmLE;J<瞕ͻqq/_tt0toʽ DYrxQXe"#_C".ux_(1s0x/2-g8#ݿ |rd#ϋDg~)_-SL`#X;Kg7?_!Dlڻ_x  N~^6X]yC:MRi Ng!,c\C|R֙vqn,@ ?`*Ȋ .^Dy(NGR%677f=OP_-%[էh 6P [+1 ÿ98 X <Ӹw?wq8d +yy>'S?E |?}'kDDؘL14-˲ӉЀ£)R 3 c9_y$K_%΂qc:uouiWs4-6)p w)pp}#E xŗh|am]?B+w= RYE`!NzP`q& \&[~9>+8W-/Uǽ\h!(1?ѵ,i,N9_w?(vEYj3s\̪~% _,8iu>,G` sbљ69RG u4-WKybqkK* .PӴXO11ܚ h{S 6lz3@ .'!`̵}҈@4eS0Gxދ9źv XוGՔW b^{d=2x]E/$~F^9i=s}{jU{Ył{IJ)ND)pGw>aG%Lt~ؼ| `2뻰 tlޣ@]U1Ȱ 8y]eG#"i[aJ3d:Qr!ucIT@r2 /B=O1,]w]¹Sή-<x) s[erweV9kʾ:Ntz@6OyYZLG;@h՜]ENrfؗ3 DZ)1}_| ssܶaXn|XXD|k+7`g}9C&Ul>SR9mBsw^7Eο<<3R) i^D@P+Y\hLc09m=' K`wOWo*mLg3np 5?sl^e5`>~t\xO\o}#}jW>i97(,_q7E=H\3 JL-*{bRld۴w=xsĹsNKO0'v{5_p_NJ)cp.ta<a2(KqeS4p1Ap@|fL!9ۥoY#/K*>Z1(wܻc~TK?\^~oh ~׀p~t`v%+h&;L8+? ܊.[W./l x/q}ܼ |׳'j)K;a+ }lj-;Yh7aň , {{n1:7iBY/̉h4BQ9fG`6um;(@ &"ޝE'ЪD7DUj`g3WnW~_sX|=/c`+&[s x`NQyϹ@CGww&>s=g]5?{Q6`!>{aRڛDab8@W+XhpsR#+0cvc7penmnv0\:9pkȠ e"eU}k]կZgEYb<aD|?s;:x<ϱpyj|F3'JfS8nZ9N&;=D'q֓&efP`ԯ0_`]8`+`]s\Ϳ?ɂ x]_'X >uOgX`gzB(z&1.^ӊwL>U"E.J)s׮]}޶_h;c¹Ģ3!!ʲs00_,ؓAE.puc]INpW7(FCEh농b)lE)!d<'~k6%'kobQ@?m}wITª4AWq0w4ba+py?v\C?prbu7k(5{藛o|Uk{gEQ@);DFPeh4t:CtDʭ:d_\3ȽCl+C(UcEy:6bJU x; >-@]2#n\:zY㾏~.^ /$OBO¹OtDu3>z ~zOWM-fw67G0bYݣ,K? u]{1]B5\0h{ZuP*~Z7WԫY<,m}bzXhg(GKդ6{.E(˒Bۧ^ s_>}*=9>[oxkӴ_-76&PJa4bPX.fh J&к_f:鳘@j`ab'A"vHfPr&.^ԠKh8v[< yQ+WC6&>Zc2`8b6c6dBk05է{8 NoꬭmƲxJĀ<$^. ץ8`w!^6 ~y?_b_F^i}{}eQbowӽe|>DuhKRSýB8NBVLO7;M]z̗Ć`k [+%m=Q`{kk(`۴8Nap PcU7#>=M|jf=x΃kȲ]WgXC 2RtΟ?< OB/v/K?p9*h}f XtOu^ v,p9<p…xŻ6ݸx, x  D1,?yv 7? |rQUg\=wjct<ƫj~ZRkF($AGK+u.N$/k12^e_ 6tVeh)@h-D[ ct[&e5ZQ9/P-:1>C<` E4"I2H)f+z6c5 }*MG)!g3* ٬vIv,"u0U<CU v+Er פ^lK 5M At]3+'vzq\tFDcqȖ? >Sj)\;AH;^7Tfa# M;a++yxfӵaξ*oVTWU/D|hn5z+iQb[;j& ,ϧ].vcpO,ֆdfTD@6*m *aD[Ȫs)Cߴ )C7]GCƎ'A4 ` +Tm~Q@P֗7mxpp:jb((9  ilK2lrL{!塽⧪9v 9u0.Z2?C} h8TW/60t[Vn4[p/ HLTayC tɤH%eG?4jIU񸳮Q&D9hޡL+AkAu dj/T&H(FO"Pi94M9t[;P6r1(lR"{.Dx6=בu U3vTj2X>^on6Pxa IJ?NO¿L^qx$MdW?ljk=Feh4M't1,D?\*ݨ=_nPEoBeuUvIw%CA2Rٷ ^"R91I$:iiށ $x1TTW.MJ$8p|Ut%MrEڔ}CmD‘ZL=e GFu=k5fou{7\7CG&CF&eu`;Z- DH.MsI'[|C)/}q}8jUdy{RS;1c'>PTO6r1 f(ʺm1oɤpC8]B=7h?XЁ~Cg_ zM='_Ϟ7əL{>pPU=TM(ͯ\ ݟBIPK\6I2] 㰶whmGnW(#2I%%p/"x AH0X @gGH=^_g7e3`h d迁WPi3 ^-N VFEd~&/МVݴCp~g,$ w; _7D]hCu}RfP9>oRd6W$?= jE׽h^Kaɽa~rAkL >Gzs|kϾY4MUUc&I0?%B>m1ύN'[qx'']l~W<O vƃ>#Wo&-Gp֏'p<\sܑH|g+1x~aTfm~bx)t[Ǡet"o²?B{6B{F7=usz94Lh^i.ͯ\ ﷳ`8X,yWn0nrom)gQʝ%Suߩf75rrk W 0L? hox o;PbyS %B>dokyi WBU0i lY4`_zc#Sg;q<h0d_|-T[Iμ8 $!ޝͳضv}e`6c΋NB QI.7';sѼ~rM;I^JRkbA¡Yeͯ\7`rC.mgr;0M[2 o< \ٜ-f=kicV|'E 1ZI~}/g!4 S'XŹ? _oodY= e[-о6w^~-y**ϺkTkupM:p:WWF6mő.\{J(gQˁʮTtC*fWW{d#?] h 1pN#Jc&9j&T0h[ {4z"d'p *-,͞x'Ik#_ !dxZ^<3Bhx; GvM;qNw†w1m~O" V> O5ST3x~Jٷ{d, 9F'f|3gH}Ğ~ﱧ>'loyo#s,anϲ3[᜛`7ֵxd 5eéWGj\QLżh GSP"c!r *Xz?|N`~Sqx)ueUr eo¹׫ư {milx3U3o+NXĶx.It4< m1xu0oTmH_hX~>wMpN¾Pw(S0_G81/XVϺd.#-5^ RƆ0s.qjܦj/q ܶO);)vm=#= Y˪'UG ǝ_ lֽ3ׯTlq&¬Ky0XumFXnn ,T"mȖlie k׹wt) i}}Ե \ L|]{)%Î}p|Bo9ͯl#\FJl_$`?+46xͳuP]p#H6 x;L=>e#j-HlWleJhg}_PxՠOh 7/QTW^~Dnc_k," iŶ h%Bm1dJ}PkNTK"v;}f6Ìp)`zoEOECu=|r8u<n%YB.{Ozk|g^[=E.Lۢ$&QriuZJ. k7BS`b-@({5pPZUV> .8gFΐT|y;9lY3*D*Y+""HM>IDEןH99̫"DR}>pCɳr"֒߷m][nί~!DEĈ8OC>/ҸUdţ"WMoO{_"HcH9HI#Eye^1dc3!"ljC"qd ;Te |~:.w\kvfhcr "d6ޟ"C%>B9r? t.")"} V|wi"2SDA7-"ψWDi ƦXDU1Poȕl %ZY "?F;DvQGTrf0P""rMDȱl 6,"ELY%"D~?`L:tEXtSoftwareAdobe ImageReadyqe<IENDB`glue/man/glue_collapse.Rd0000644000176200001440000000212615170237027015073 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.} } \value{ Always returns a length-1 glue object, as created by \code{\link[=as_glue]{as_glue()}}. } \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 ") } glue/man/glue.Rd0000644000176200001440000001160515170242707013214 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. For \code{glue_data()}, elements in \code{...} override the values in \code{.x}.} \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}{[\code{function}]\cr A function taking two arguments, \code{text} and \code{envir}, where \code{text} is the unparsed string inside the glue block and \code{envir} is the execution environment. A \code{.transformer} lets you modify a glue block before, during, or after evaluation, allowing you to create your own custom \code{glue()}-like functions. See \code{vignette("transformers")} for examples.} \item{.trim}{[\code{logical(1)}: \sQuote{TRUE}]\cr Whether to trim the input template with \code{\link[=trim]{trim()}} or not.} } \value{ A glue object, as created by \code{\link[=as_glue]{as_glue()}}. } \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 with the pipe head(iris, 3) |> glue_data("This {Species} has a petal length of {Petal.Length}") # 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/as_glue.Rd0000644000176200001440000000130615170237027013673 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.} } \value{ A character vector with S3 class \code{"glue"}. } \description{ A glue object is a character vector with S3 class \code{"glue"}. The \code{"glue"} class implements a print method that shows the literal contents (rather than the string implementation) and a \code{+} method, so that you can concatenate with the addition operator. } \examples{ x <- as_glue(c("abc", "\"\\\\\\\\", "\n")) x x <- 1 y <- 3 glue("x + y") + " = {x + y}" } glue/man/glue_col.Rd0000644000176200001440000000704615170237027014054 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. For \code{glue_data()}, elements in \code{...} override the values in \code{.x}.} \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.} } \value{ A glue object, as created by \code{\link[=as_glue]{as_glue()}}. } \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'. \if{html}{\out{
}}\preformatted{\{blue foo bar\} }\if{html}{\out{
}} If you want an expression to be evaluated, simply place that in a normal brace expression (these can be nested). \if{html}{\out{
}}\preformatted{\{blue 1 + 1 = \{1 + 1\}\} }\if{html}{\out{
}} 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)) withAutoprint(\{ # 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/glue_sql.Rd0000644000176200001440000001667415170237027014105 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, .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = DBI::SQL("NULL"), .null = character(), .comment = "#", .literal = FALSE, .trim = TRUE ) glue_data_sql( .x, ..., .con, .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = DBI::SQL("NULL"), .null = character(), .comment = "#", .literal = FALSE, .trim = TRUE ) } \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. For \code{glue_data()}, elements in \code{...} override the values in \code{.x}.} \item{.con}{[\code{DBIConnection}]: A DBI connection object obtained from \code{\link[DBI:dbConnect]{DBI::dbConnect()}}.} \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)}: \code{DBI::SQL("NULL")}]\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{.trim}{[\code{logical(1)}: \sQuote{TRUE}]\cr Whether to trim the input template with \code{\link[=trim]{trim()}} or not.} \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. 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://solutions.posit.co/connections/db/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, or if there are no values, produce \code{NULL}. This is useful for (e.g.) the \href{https://www.w3schools.com/sql/sql_in.asp}{SQL IN Operator}. } \examples{ \dontshow{if (requireNamespace("DBI", quietly = TRUE) && requireNamespace("RSQLite", quietly = TRUE)) withAutoprint(\{ # 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(iris_db, "sepal_length"), DBI::Id(iris_db, "sepal_width"), DBI::Id(nicknames_db, "nickname") ) iris_species <- DBI::Id(iris_db, "species") nicknames_species <- DBI::Id(nicknames_db, "species") query <- glue_sql(" SELECT {`cols`*} FROM {`iris_db`} JOIN {`nicknames_db`} ON {`iris_species`}={`nicknames_species`}", .con = con ) query DBI::dbGetQuery(con, query, n = 5) DBI::dbDisconnect(con) \dontshow{\}) # examplesIf} } \seealso{ \code{\link[=glue_sql_collapse]{glue_sql_collapse()}} to collapse \code{\link[DBI:SQL]{DBI::SQL()}} objects. } glue/man/identity_transformer.Rd0000644000176200001440000000113615170237027016530 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 = parent.frame()) } \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/DESCRIPTION0000644000176200001440000000334515170340345012723 0ustar liggesusersPackage: glue Title: Interpreted String Literals Version: 1.8.1 Authors@R: c( person("Jim", "Hester", role = "aut", comment = c(ORCID = "0000-0002-2739-7082")), person("Jennifer", "Bryan", , "jenny@posit.co", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6983-2759")), person("Posit Software, PBC", role = c("cph", "fnd"), comment = c(ROR = "03wc8by49")) ) 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://glue.tidyverse.org/, https://github.com/tidyverse/glue BugReports: https://github.com/tidyverse/glue/issues Depends: R (>= 4.1) Imports: methods Suggests: crayon, DBI (>= 1.2.0), dplyr, knitr, rlang, rmarkdown, RSQLite, testthat (>= 3.2.0), vctrs (>= 0.3.0), waldo (>= 0.5.3), withr VignetteBuilder: knitr ByteCompile: true Config/Needs/website: bench, forcats, ggbeeswarm, ggplot2, R.utils, rprintf, tidyr, tidyverse/tidytemplate Config/testthat/edition: 3 Config/usethis/last-upkeep: 2026-04-16 Encoding: UTF-8 RoxygenNote: 7.3.3 NeedsCompilation: yes Packaged: 2026-04-16 22:53:02 UTC; jenny Author: Jim Hester [aut] (ORCID: ), Jennifer Bryan [aut, cre] (ORCID: ), Posit Software, PBC [cph, fnd] (ROR: ) Maintainer: Jennifer Bryan Repository: CRAN Date/Publication: 2026-04-17 05:11:01 UTC