Add a new literal option

Fixes #235
tidyverse · Nov 19, 2021 · dad1580 · dad1580
1 parent 07ddf6e
commit dad1580
Show file tree

Hide file tree

Showing 6 changed files with 43 additions and 11 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,7 @@
 # glue (development version)
 
+* `glue()` gains a new `.literal` argument, to parse the text as literal text without trying to parse comments, quotes or backticks. (#235)
+
 # glue 1.5.0
 
 ## Breaking changes

diff --git a/R/glue.R b/R/glue.R
@@ -28,6 +28,9 @@
 #'   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 If `True` treat the text
+#'   as literal text, do not try to parse single or double quotes, backticks or
+#'   comments.
 #' @param .trim \[`logical(1)`: \sQuote{TRUE}]\cr Whether to trim the input
 #'   template with [trim()] or not.
 #' @seealso <https://www.python.org/dev/peps/pep-0498/> and
@@ -79,7 +82,7 @@
 #' @export
 glue_data <- function(.x, ..., .sep = "", .envir = parent.frame(),
   .open = "{", .close = "}", .na = "NA", .null = character(),
-  .comment = "#", .transformer = identity_transformer, .trim = TRUE) {
+  .comment = "#", .literal = FALSE, .transformer = identity_transformer, .trim = TRUE) {
 
   if (is.null(.envir)) {
     .envir <- emptyenv()
@@ -170,7 +173,7 @@ glue_data <- function(.x, ..., .sep = "", .envir = parent.frame(),
   }
 
   # Parse any glue strings
-  res <- .Call(glue_, unnamed_args, f, .open, .close, .comment)
+  res <- .Call(glue_, unnamed_args, f, .open, .close, .comment, .literal)
 
   res <- drop_null(res)
 
@@ -195,8 +198,8 @@ glue_data <- function(.x, ..., .sep = "", .envir = parent.frame(),
 
 #' @export
 #' @rdname glue
-glue <- function(..., .sep = "", .envir = parent.frame(), .open = "{", .close = "}", .na = "NA", .null = character(), .comment = "#", .transformer = identity_transformer, .trim = TRUE) {
-  glue_data(.x = NULL, ..., .sep = .sep, .envir = .envir, .open = .open, .close = .close, .na = .na, .null = .null, .comment = .comment, .transformer = .transformer, .trim = .trim)
+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

diff --git a/man/glue.Rd b/man/glue.Rd
diff --git a/src/glue.c b/src/glue.c
@@ -21,7 +21,13 @@ SEXP resize(SEXP out, R_xlen_t n) {
   return Rf_xlengthgets(out, n);
 }
 
-SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg, SEXP comment_arg) {
+SEXP glue_(
+    SEXP x,
+    SEXP f,
+    SEXP open_arg,
+    SEXP close_arg,
+    SEXP comment_arg,
+    SEXP literal_arg) {
   typedef enum {
     text,
     escape,
@@ -48,6 +54,8 @@ SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg, SEXP comment_arg) {
     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);
@@ -128,18 +136,24 @@ SEXP glue_(SEXP x, SEXP f, SEXP open_arg, SEXP close_arg, SEXP comment_arg) {
         --delim_level;
         i += close_len - 1;
       } else {
-        if (xx[i] == comment_char) {
+        if (!literal && xx[i] == comment_char) {
           state = comment;
         } else {
           switch (xx[i]) {
           case '\'':
-            state = single_quote;
+            if (!literal) {
+              state = single_quote;
+            }
             break;
           case '"':
-            state = double_quote;
+            if (!literal) {
+              state = double_quote;
+            }
             break;
           case '`':
-            state = backtick;
+            if (!literal) {
+              state = backtick;
+            }
             break;
           };
         }

diff --git a/src/init.c b/src/init.c
@@ -4,11 +4,11 @@
 #include <stdlib.h> // for NULL
 
 /* .Call calls */
-extern SEXP glue_(SEXP, SEXP, SEXP, SEXP, SEXP);
+extern SEXP glue_(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP trim_(SEXP);
 
 static const R_CallMethodDef CallEntries[] = {
-    {"glue_", (DL_FUNC)&glue_, 5},
+    {"glue_", (DL_FUNC)&glue_, 6},
     {"trim_", (DL_FUNC)&trim_, 1},
     {NULL, NULL, 0}};
 

diff --git a/tests/testthat/test-glue.R b/tests/testthat/test-glue.R
@@ -540,3 +540,10 @@ test_that("glue can use different comment characters (#193)", {
     "foo#"
   )
 })
+
+test_that("glue can parse text as literal text", {
+  expect_equal(
+    glue(.comment = "", "{'fo`o\"#}", .literal = TRUE, .transformer = function(x, ...) x),
+    "'fo`o\"#"
+  )
+})