Merge pull request #108 from ambiorix-web/107-fix-serialiser

fix serialiser

R/response.R

@@ -189,13 +189,13 @@ Response <- R6::R6Class(
     #' @param body Body of the response.
     #' @param headers HTTP headers to set.
     #' @param status Status of the response, if `NULL` uses `self$status`.
-    #' @param ... Additional arguments passed to the serialiser.
+    #' @param ... Additional named arguments passed to the serialiser.
     json = function(body, headers = NULL, status = NULL, ...){
       self$header_content_json()
       deprecated_headers(headers)
       deprecated_status(status)
       headers <- private$.get_headers(headers)
-      response(serialise(body), headers = headers, status = private$.get_status(status))
+      response(serialise(body, ...), headers = headers, status = private$.get_status(status))
     },
     #' @details Sends a comma separated value file
     #' @param data Data to convert to CSV.

R/serialise.R

@@ -1,39 +1,83 @@
 #' Serialise
-#' 
+#'
 #' Serialise data to JSON.
-#' 
+#'
 #' @param data Data to serialise.
-#' @param ... Options to pass to [yyjsonr::write_json_str].
-#' 
-#' @noRd 
+#' @param ... Named options to pass to [yyjsonr::write_json_str].
+#'
+#' @noRd
 #' @keywords internal
-default_serialiser <- function(data, ...){
-  yyjsonr::write_json_str(data, ...)
+default_serialiser <- function(data, ...) {
+  dots <- list(...)
+
+  # `yyjsonr::write_json_str()` accepts both `opts` & `...` but
+  # `...` should override `opts`.
+  # ensure that happens and use `opts` only:
+  opts <- dots$opts
+  if (is.null(opts)) {
+    opts <- list()
+  }
+
+  dots$opts <- NULL
+  opts[names(dots)] <- dots
+
+  if (is.null(opts$auto_unbox)) {
+    opts$auto_unbox <- TRUE
+  }
+
+  yyjsonr::write_json_str(data, opts = opts)
 }
 
 #' Retrieve Serialiser
-#' 
+#'
 #' Retrieve the serialiser to use, either the default or that defined by user.
-#' 
-#' @noRd 
+#'
+#' @noRd
 #' @keywords internal
-get_serialise <- function(){
+get_serialise <- function() {
   getOption("AMBIORIX_SERIALISER", default_serialiser)
 }
 
-#' Serialise to JSON
-#' 
-#' Serialise an object to JSON.
-#' Default serialiser can be change by setting the
-#' `AMBIORIX_SERIALISER` option to the desired function.
-#' 
+#' Serialise an Object to JSON
+#'
+#' @details
+#' Ambiorix uses [yyjsonr::write_json_str()] by default for serialization.
+#'
+#' ### Custom Serialiser
+#'
+#' To override the default, set the `AMBIORIX_SERIALISER` option to a function that accepts:
+#' - `data`: Object to serialise.
+#' - `...`: Additional arguments passed to the function.
+#'
+#' For example:
+#'
+#' ```r
+#' my_serialiser <- function(data, ...) {
+#'  jsonlite::toJSON(x = data, ...)
+#' }
+#'
+#' options(AMBIORIX_SERIALISER = my_serialiser)
+#' ```
+#'
 #' @param data Data to serialise.
 #' @param ... Passed to serialiser.
-#' 
-#' @examples 
-#' \dontrun{serialise(cars)}
-#' 
+#'
+#' @examples
+#' if (interactive()) {
+#'   # a list:
+#'   response <- list(code = 200L, msg = "hello, world!")
+#'
+#'   serialise(response)
+#'   #> {"code":200,"msg":"hello, world"}
+#'
+#'   serialise(response, auto_unbox = FALSE)
+#'   #> {"code":[200],"msg":["hello, world"]}
+#'
+#'   # data.frame:
+#'   serialise(cars)
+#' }
+#'
 #' @export
-serialise <- function(data, ...){
+serialise <- function(data, ...) {
   get_serialise()(data, ...)
 }

tests/testthat/test-response.R

@@ -42,7 +42,7 @@ test_that("Response", {
   resp <- res$send(
     htmltools::p("hello")
   )
-  expect_equal(resp$body, "<p>hello</p>")
+  expect_equal(resp$body, htmltools::HTML("<p>hello</p>"))
 
   # factor
   resp <- res$send(as.factor("hello"))

tests/testthat/test-serialise.R

@@ -1,9 +1,42 @@
 test_that("serialise", {
-  json <- default_serialiser(list(x = 1))
+  obj <- list(a = 1, b = "hello, world!")
+
   expect_equal(
-    json,
-    yyjsonr::write_json_str(
-      list(x = 1)
+    default_serialiser(obj),
+    yyjsonr::write_json_str(obj, auto_unbox = TRUE)
+  )
+
+  expect_equal(
+    default_serialiser(obj, auto_unbox = FALSE),
+    yyjsonr::write_json_str(obj)
+  )
+
+  expect_equal(
+    default_serialiser(obj, opts = list(auto_unbox = FALSE)),
+    yyjsonr::write_json_str(obj)
+  )
+})
+
+test_that("custom serialiser works", {
+  global_serialiser <- getOption("AMBIORIX_SERIALISER")
+  on.exit(options(AMBIORIX_SERIALISER = global_serialiser))
+
+  my_serialiser <- function(data, ...) {
+    list(
+      data = data,
+      serialised = jsonlite::toJSON(x = data, ...)
+    )
+  }
+
+  options(AMBIORIX_SERIALISER = my_serialiser)
+
+  obj <- list(a = 1, b = "hello, world!")
+
+  expect_equal(
+    my_serialiser(obj),
+    list(
+      data = obj,
+      serialised = jsonlite::toJSON(obj)
     )
   )
 })