add support for json_verbatim

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: yyjsonr
 Type: Package
 Title: Fast 'JSON', 'NDJSON' and 'GeoJSON' Parser and Generator 
-Version: 0.1.20.9001
+Version: 0.1.20.9101
 Authors@R: c(
     person("Mike", "Cheng", role = c("aut", "cre", 'cph'), 
     email = "[email protected]"),

R/json-opts.R

@@ -290,6 +290,7 @@ opts_write_json <- function(
     num_specials      = c('null', 'string'),
     str_specials      = c('null', 'string'),
     fast_numerics     = FALSE,
+    json_verbatim     = FALSE,
     yyjson_write_flag = 0L) {
 
   structure(
@@ -303,6 +304,7 @@ opts_write_json <- function(
       str_specials      = match.arg(str_specials),
       num_specials      = match.arg(num_specials),
       fast_numerics     = isTRUE(fast_numerics),
+      json_verbatim     = isTRUE(json_verbatim),
       yyjson_write_flag = as.integer(yyjson_write_flag)
     ),
     class = "opts_write_json"

src/R-yyjson-serialize.c

@@ -37,6 +37,7 @@ serialize_options parse_serialize_options(SEXP serialize_opts_) {
     .num_specials      = NUM_SPECIALS_AS_NULL,
     .str_specials      = STR_SPECIALS_AS_NULL,
     .fast_numerics     = FALSE,
+    .json_verbatim     = FALSE,
     .yyjson_write_flag = 0,
   };
 
@@ -88,6 +89,8 @@ serialize_options parse_serialize_options(SEXP serialize_opts_) {
       opt.num_specials = strcmp(val, "string") == 0 ? NUM_SPECIALS_AS_STRING : NUM_SPECIALS_AS_NULL;
     } else if (strcmp(opt_name, "fast_numerics") == 0) {
       opt.fast_numerics = asLogical(val_);
+    } else if (strcmp(opt_name, "json_verbatim") == 0) {
+      opt.json_verbatim = asLogical(val_);
     } else {
       warning("Unknown option ignored: '%s'\n", opt_name);
     }
@@ -332,7 +335,14 @@ yyjson_mut_val *scalar_double_to_json_val(double rdbl, yyjson_mut_doc *doc, seri
 yyjson_mut_val *scalar_strsxp_to_json_val(SEXP str_, R_xlen_t idx, yyjson_mut_doc *doc, serialize_options *opt) {
 
   yyjson_mut_val *val;
+
+  // if "json"-classed and json_verbatim, write raw json:
+  if (Rf_inherits(str_, "json") && opt->json_verbatim) {
+    val = yyjson_mut_rawcpy(doc, CHAR(STRING_ELT(str_, idx)));
+    return val;
+  }
 
+  // otherwise write a json string:
   SEXP charsxp_ = STRING_ELT(str_, idx);
   if (charsxp_ == NA_STRING) {
     if (opt->str_specials == STR_SPECIALS_AS_STRING) {
@@ -343,7 +353,6 @@ yyjson_mut_val *scalar_strsxp_to_json_val(SEXP str_, R_xlen_t idx, yyjson_mut_do
   } else {
     val = yyjson_mut_strcpy(doc, CHAR(charsxp_));
   }
-
   return val;
 }
 

src/R-yyjson-serialize.h

@@ -76,6 +76,7 @@ typedef struct {
   unsigned int num_specials;
   unsigned int yyjson_write_flag;
   bool fast_numerics;
+  bool json_verbatim;
 } serialize_options;
 
 //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

tests/testthat/test-json-verbatim.R

@@ -0,0 +1,87 @@
+test_that("json_verbatim basic behavior", {
+    chr1 <- '[1,2,3]'
+    chr3 <- rep(chr1, 3)
+    json1 <- chr1; class(json1) <- "json"
+    json3 <- chr3; class(json3) <- "json"
+
+    expect_identical(
+        write_json_str(chr1, auto_unbox = FALSE, json_verbatim = FALSE),
+        '["[1,2,3]"]'
+    )
+    expect_identical(
+        write_json_str(chr1, auto_unbox = TRUE, json_verbatim = FALSE),
+        '"[1,2,3]"'
+    )
+    expect_identical(
+        write_json_str(chr1, auto_unbox = FALSE, json_verbatim = TRUE),
+        '["[1,2,3]"]'
+    )
+    expect_identical(
+        write_json_str(chr1, auto_unbox = TRUE, json_verbatim = TRUE),
+        '"[1,2,3]"'
+    )
+
+    expect_identical(
+        write_json_str(json1, auto_unbox = FALSE, json_verbatim = FALSE),
+        '["[1,2,3]"]'
+    )
+    expect_identical(
+        write_json_str(json1, auto_unbox = TRUE, json_verbatim = FALSE),
+        '"[1,2,3]"'
+    )
+    expect_identical(
+        write_json_str(json1, auto_unbox = FALSE, json_verbatim = TRUE),
+        '[[1,2,3]]'
+    )
+    expect_identical(
+        write_json_str(json1, auto_unbox = TRUE, json_verbatim = TRUE),
+        '[1,2,3]'
+    )
+
+    expect_identical(
+        write_json_str(chr3, auto_unbox = FALSE, json_verbatim = FALSE),
+        '["[1,2,3]","[1,2,3]","[1,2,3]"]'
+    )
+    expect_identical(
+        write_json_str(chr3, auto_unbox = TRUE, json_verbatim = FALSE),
+        '["[1,2,3]","[1,2,3]","[1,2,3]"]'
+    )
+    expect_identical(
+        write_json_str(chr3, auto_unbox = FALSE, json_verbatim = TRUE),
+        '["[1,2,3]","[1,2,3]","[1,2,3]"]'
+    )
+    expect_identical(
+        write_json_str(chr3, auto_unbox = TRUE, json_verbatim = TRUE),
+        '["[1,2,3]","[1,2,3]","[1,2,3]"]'
+    )
+
+    expect_identical(
+        write_json_str(json3, auto_unbox = FALSE, json_verbatim = FALSE),
+        '["[1,2,3]","[1,2,3]","[1,2,3]"]'
+    )
+    expect_identical(
+        write_json_str(json3, auto_unbox = TRUE, json_verbatim = FALSE),
+        '["[1,2,3]","[1,2,3]","[1,2,3]"]'
+    )
+    expect_identical(
+        write_json_str(json3, auto_unbox = FALSE, json_verbatim = TRUE),
+        '[[1,2,3],[1,2,3],[1,2,3]]'
+    )
+    expect_identical(
+        write_json_str(json3, auto_unbox = TRUE, json_verbatim = TRUE),
+        '[[1,2,3],[1,2,3],[1,2,3]]'
+    )    
+})
+
+test_that("json_verbatim failures", {
+    x <- list(
+        foo = "bar"
+    )
+    class(x$foo) <- "json"  ## this is a bad class assignment, since "bar" isn't quote-wrapped.
+
+    valid_json <- write_json_str(x, auto_unbox = TRUE, json_verbatim = FALSE)
+    invalid_json <- write_json_str(x, auto_unbox = TRUE, json_verbatim = TRUE)
+
+    expect_true(yyjsonr::validate_json_str(valid_json))
+    expect_false(yyjsonr::validate_json_str(invalid_json))
+})