Give (potential) crayon calls special treatment (#241)

* Give (potential) crayon calls special treatment

Fixes #196, fixes #138 (for the links)

* Add NEWS bullet

* Refactor tests; cover the crayon-not-attached scenario

NEWS.md

@@ -2,6 +2,8 @@
 
 The existing custom language engines for knitr, `glue` and `glue_sql`, are documented in a new vignette (#71).
 
+`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 1.5.0

R/color.R

@@ -26,6 +26,8 @@
 #'
 #'   glue_col("{blue 1 + 1 = {1 + 1}}")
 #'
+#'   glue_col("{blue 2 + 2 = {green {2 + 2}}}")
+#'
 #'   white_on_grey <- bgBlack $ white
 #'   glue_col("{white_on_grey
 #'     Roses are {red {colors()[[552]]}}
@@ -35,14 +37,12 @@
 #'     }")
 #' }
 glue_col <- function(..., .envir = parent.frame(), .na = "NA") {
-  loadNamespace("crayon")
   glue(..., .envir = .envir, .na = .na, .transformer = color_transformer)
 }
 
 #' @rdname glue_col
 #' @export
 glue_data_col <- function(.x, ..., .envir = parent.frame(), .na = "NA") {
-  loadNamespace("crayon")
   glue_data(.x, ..., .envir = .envir, .na = .na, .transformer = color_transformer)
 }
 
@@ -64,5 +64,16 @@ color_transformer <- function(code, envir) {
   fun <- captures[[1]]
   text <- captures[[2]]
   out <- glue(text, .envir = envir, .transformer = color_transformer)
-  (get(fun, envir = envir, mode = "function"))(out)
+
+  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)
+  }
 }

tests/testthat/test-color.R

@@ -1,50 +1,66 @@
-skip_if_not_installed("crayon")
-library(crayon)
-
-describe("glue_col", {
-  it("returns the string if no substations needed", {
-    expect_identical(glue_col("foo"), as_glue("foo"))
-  })
-  it("works the same as glue for parsable expressions", {
-    expect_identical(glue_col("1 + 1 = {1 + 1}"), glue("1 + 1 = {1 + 1}"))
-  })
-  it("applies crayon functions", {
-    expect_identical(glue_col("{blue foo}"), as_glue(blue("foo")))
-
-    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")))
-  })
-  it("works on multiline strings", {
-    expect_identical(
-      glue_col("
-   {red foo
+test_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(red("foo\nbar")))
-  })
-  it("works on nested colors", {
-    expect_identical(glue_col("{red This is a {green serious} problem}"),
-      as_glue(red("This is a " %+% green("serious") %+% " problem")))
-  })
-
-  it("errors if there is invalid syntax or fun is not found", {
-    expect_error(glue_col("{_}"), "unexpected input")
+        }"), as_glue(crayon::red("foo\nbar")))
+})
 
+test_that("glue_col() works on nested colors", {
+  skip_if_not_installed("crayon")
+  if( !"crayon" %in% (.packages())) {
+    withr::local_package("crayon")
+  }
+  expect_identical(
+    glue_col("{red This is a {green serious} problem}"),
+    as_glue(red("This is a " %+% green("serious") %+% " problem"))
+  )
+})
+
+test_that("glue_col() errors for invalid syntax or when color_fun can't be found", {
+    expect_error(glue_col("{_}"), "unexpected input")
     expect_error(glue_col("{foo _}"), "object 'foo' of mode 'function' was not found")
 
     foo <- 1
     expect_error(glue_col("{foo _}"), "object 'foo' of mode 'function' was not found")
 
     foo <- crayon::blue
     expect_identical(glue_col("{foo _}"), as_glue(foo("_")))
-  })
 })
 
-describe("glue_data_col", {
-  it("works as expected", {
-    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!"))
-  })
+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!")
+  )
 })