Avoid jsonlite::toJSON

To help embedding into pak. S4 functions are hard
to handle.

R/advanced_search.R

@@ -79,7 +79,7 @@ advanced_search <- function(..., json = NULL, format = c("short", "long"),
       paste0("(", names(terms), ":", terms, ")")
     )
 
-    qstr <- jsonlite::toJSON(list(
+    qstr <- tojson$write_str(list(
       query = list(
         query_string = list(
           query = jsonlite::unbox(paste0(q, collapse = " AND ")),

R/api.R

@@ -177,7 +177,7 @@ make_query <- function(query) {
     )
   )
 
-  jsonlite::toJSON(query_object, auto_unbox = TRUE, pretty = TRUE)
+  tojson$write_str(query_object)
 }
 
 do_query <- function(query, server, port, from, size) {

R/tojson.R

@@ -0,0 +1,107 @@
+tojson <- local({
+  map2 <- function(x, y, fn, ...) {
+    mapply(fn, x, y, ..., SIMPLIFY = FALSE)
+  }
+
+  jq <- function(x) {
+    encodeString(x, quote = "\"", justify = "none")
+  }
+
+  comma <- function(x, key = NULL) {
+    len <- length(x)
+    stopifnot(len >= 1)
+
+    if (!is.null(key)) {
+      nokey <- is.na(key) | key == ""
+      key[nokey] <- seq_along(x)[nokey]
+      x <- map2(jq(key), x, function(k, el) {
+        el[1] <- paste0(k, ": ", el[1])
+        el
+      })
+    }
+
+    # No commans needed for scalars
+    if (len == 1) return(x)
+
+    x2 <- lapply(x, function(el) {
+      el[length(el)] <- paste0(el[length(el)], ",")
+      el
+    })
+    x2[[len]] <- x[[len]]
+    x2
+  }
+
+  j_null <- function(x) {
+    "{}"
+  }
+
+  j_list <- function(x) {
+    if (length(x) == 0L) {
+      if (is.null(names(x))) "[]" else "{}"
+
+    } else if (is.null(names(x))) {
+      c("[", paste0("  ", unlist(comma(lapply(x, j)))), "]")
+
+    } else {
+      c("{", paste0("  ", unlist(comma(lapply(x, j), names(x)))), "}")
+    }
+  }
+
+  j_atomic <- function(x) {
+    if (! typeof(x) %in% c("logical", "integer", "double", "character")) {
+      stop("Cannot convert atomic ", typeof(x), " vectors to JSON.")
+    }
+    len <- length(x)
+
+    if (len == 0) {
+      return("[]")
+    }
+
+    if (is.character(x)) {
+      x <- jq(enc2utf8(x))
+    }
+
+    if (is.logical(x)) {
+      x <- tolower(x)
+    }
+
+    if (len == 1L) {
+      if (is.na(x) || x == "NA") "null" else paste0(x)
+
+    } else {
+      x[is.na(x) | x == "NA"] <- "null"
+      paste0("[", paste(comma(x), collapse = " "), "]")
+    }
+}
+
+  j <- function(x) {
+    if (is.null(x)) {
+      j_null(x)
+    } else if (is.list(x)) {
+      j_list(x)
+    } else if (is.atomic(x)) {
+      j_atomic(x)
+    } else {
+      stop("Cannot convert type ", typeof(x), " to JSON.")
+    }
+}
+
+  write_str <- function(x) {
+    paste0(j(x), collapse = "\n")
+  }
+
+  write_file <- function(x, file) {
+    writeLines(j(x), file)
+  }
+
+  write_lines <- function(x) {
+    j(x)
+  }
+
+  list(
+    .envir = environment(),
+    write_str = write_str,
+    write_file = write_file,
+    write_lines = write_lines
+  )
+})

tests/testthat/_snaps/tojson.md

@@ -0,0 +1,219 @@
+# write_str vectors
+
+    Code
+      tojson$write_str(NULL)
+    Output
+      [1] "{}"
+    Code
+      tojson$write_str(list())
+    Output
+      [1] "[]"
+    Code
+      tojson$write_str(integer())
+    Output
+      [1] "[]"
+    Code
+      tojson$write_str(double())
+    Output
+      [1] "[]"
+    Code
+      tojson$write_str(character())
+    Output
+      [1] "[]"
+    Code
+      tojson$write_str(logical())
+    Output
+      [1] "[]"
+
+---
+
+    Code
+      tojson$write_str(complex())
+    Condition
+      Error in `j_atomic()`:
+      ! Cannot convert atomic complex vectors to JSON.
+    Code
+      tojson$write_str(raw())
+    Condition
+      Error in `j_atomic()`:
+      ! Cannot convert atomic raw vectors to JSON.
+
+---
+
+    Code
+      tojson$write_str(list(1))
+    Output
+      [1] "[\n  1\n]"
+    Code
+      tojson$write_str(1L)
+    Output
+      [1] "1"
+    Code
+      tojson$write_str(1)
+    Output
+      [1] "1"
+    Code
+      tojson$write_str("foo")
+    Output
+      [1] "\"foo\""
+    Code
+      tojson$write_str(TRUE)
+    Output
+      [1] "true"
+
+---
+
+    Code
+      tojson$write_str(list(1, 2))
+    Output
+      [1] "[\n  1,\n  2\n]"
+    Code
+      tojson$write_str(1:2)
+    Output
+      [1] "[1, 2]"
+    Code
+      tojson$write_str(c(1, 2))
+    Output
+      [1] "[1, 2]"
+    Code
+      tojson$write_str(c("foo", "bar"))
+    Output
+      [1] "[\"foo\", \"bar\"]"
+    Code
+      tojson$write_str(c(TRUE, FALSE))
+    Output
+      [1] "[true, false]"
+
+---
+
+    Code
+      tojson$write_str(NA_integer_)
+    Output
+      [1] "null"
+    Code
+      tojson$write_str(NA_real_)
+    Output
+      [1] "null"
+    Code
+      tojson$write_str(NA_character_)
+    Output
+      [1] "null"
+    Code
+      tojson$write_str(NA)
+    Output
+      [1] "null"
+
+---
+
+    Code
+      tojson$write_str(c(1L, NA_integer_))
+    Output
+      [1] "[1, null]"
+    Code
+      tojson$write_str(c(1, NA_real_))
+    Output
+      [1] "[1, null]"
+    Code
+      tojson$write_str(c("foo", NA_character_))
+    Output
+      [1] "[\"foo\", null]"
+    Code
+      tojson$write_str(c(TRUE, NA))
+    Output
+      [1] "[true, null]"
+
+---
+
+    Code
+      tojson$write_str(c(a = 1L, b = 2L))
+    Output
+      [1] "[1, 2]"
+    Code
+      tojson$write_str(c(a = 1, b = 2))
+    Output
+      [1] "[1, 2]"
+    Code
+      tojson$write_str(c(a = "foo", b = "bar"))
+    Output
+      [1] "[\"foo\", \"bar\"]"
+    Code
+      tojson$write_str(c(a = TRUE, b = FALSE))
+    Output
+      [1] "[true, false]"
+
+# write_str character encoding and escaping
+
+    Code
+      cat(tojson$write_str("foo\"\\bar"))
+    Output
+      "foo\"\\bar"
+    Code
+      charToRaw(tojson$write_str(iconv(utf8, "UTF-8", "latin1")))
+    Output
+      [1] 22 47 c3 a1 62 6f 72 22
+
+# lists
+
+    Code
+      cat(tojson$write_str(list(list(1, 2, 3), list(4, 5, 6), list(7, 8, 9))))
+    Output
+      [
+        [
+          1,
+          2,
+          3
+        ],
+        [
+          4,
+          5,
+          6
+        ],
+        [
+          7,
+          8,
+          9
+        ]
+      ]
+
+---
+
+    Code
+      cat(tojson$write_str(list(a = 1, b = 2)))
+    Output
+      {
+        "a": 1,
+        "b": 2
+      }
+
+---
+
+    Code
+      cat(tojson$write_str(list(a = list(a1 = 1, a2 = 2), b = list(b1 = 3, b2 = 4))))
+    Output
+      {
+        "a": {
+          "a1": 1,
+          "a2": 2
+        },
+        "b": {
+          "b1": 3,
+          "b2": 4
+        }
+      }
+
+---
+
+    Code
+      cat(tojson$write_str(list(a = list(1, a2 = 2), list(b1 = 3, 4))))
+    Output
+      {
+        "a": {
+          "1": 1,
+          "a2": 2
+        },
+        "2": {
+          "b1": 3,
+          "2": 4
+        }
+      }
+