From 3249ffcb400c3a86582a27b5726a1f94c47a3c26 Mon Sep 17 00:00:00 2001 From: shrektan Date: Sat, 17 Nov 2018 01:30:52 +0800 Subject: [PATCH 01/11] register a new serializer rOjbect --- DESCRIPTION | 1 + NAMESPACE | 1 + R/serializer-r-object.R | 15 +++++++++++++++ man/serializers.Rd | 6 +++++- tests/testthat/test-serializer-r-object.R | 11 +++++++++++ 5 files changed, 33 insertions(+), 1 deletion(-) create mode 100644 R/serializer-r-object.R create mode 100644 tests/testthat/test-serializer-r-object.R diff --git a/DESCRIPTION b/DESCRIPTION index fcce0d1f8..d799c10b9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -62,6 +62,7 @@ Collate: 'serializer-content-type.R' 'serializer-html.R' 'serializer-htmlwidget.R' + 'serializer-r-object.R' 'serializer-xml.R' 'serializer.R' 'session-cookie.R' diff --git a/NAMESPACE b/NAMESPACE index 756c37a7e..86b5bb8bf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,6 +20,7 @@ export(serializer_content_type) export(serializer_html) export(serializer_htmlwidget) export(serializer_json) +export(serializer_r_object) export(serializer_unboxed_json) export(sessionCookie) import(R6) diff --git a/R/serializer-r-object.R b/R/serializer-r-object.R new file mode 100644 index 000000000..82f0b2e6d --- /dev/null +++ b/R/serializer-r-object.R @@ -0,0 +1,15 @@ +#' @rdname serializers +#' @export +serializer_r_object <- function(){ + function(val, req, res, errorHandler){ + tryCatch({ + res$setHeader("Content-Type", "application/octet-stream") + res$body <- base::serialize(val, NULL, ascii = FALSE) + return(res$toResponse()) + }, error = function(e){ + errorHandler(req, res, e) + }) + } +} + +.globals$serializers[["rObject"]] <- serializer_r_object diff --git a/man/serializers.Rd b/man/serializers.Rd index 9c17ff83f..73d3accf3 100644 --- a/man/serializers.Rd +++ b/man/serializers.Rd @@ -1,12 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/serializer-json.R, R/serializer-content-type.R, -% R/serializer-html.R, R/serializer-htmlwidget.R, R/serializer.R +% R/serializer-html.R, R/serializer-htmlwidget.R, R/serializer-r-object.R, +% R/serializer.R \name{serializer_json} \alias{serializer_json} \alias{serializer_unboxed_json} \alias{serializer_content_type} \alias{serializer_html} \alias{serializer_htmlwidget} +\alias{serializer_r_object} \alias{serializers} \title{Plumber Serializers} \usage{ @@ -19,6 +21,8 @@ serializer_content_type(type) serializer_html() serializer_htmlwidget() + +serializer_r_object() } \arguments{ \item{type}{The value to provide for the \code{Content-Type} HTTP header.} diff --git a/tests/testthat/test-serializer-r-object.R b/tests/testthat/test-serializer-r-object.R new file mode 100644 index 000000000..7680b6771 --- /dev/null +++ b/tests/testthat/test-serializer-r-object.R @@ -0,0 +1,11 @@ +context("rObject serializer") + +test_that("rObject serializes properly", { + v <- iris[0,] + attr(v, "origin") <- iris + val <- serializer_r_object()(v, list(), PlumberResponse$new(), stop) + expect_equal(val$status, 200L) + expect_equal(val$headers$`Content-Type`, "application/octet-stream") + expect_equal(val$body, serialize(v, NULL, ascii = FALSE)) + expect_equal(unserialize(val$body), v) +}) From ff7cdd32a2541fe340e2aab1a5ee5de9c0801350 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Fri, 22 Feb 2019 15:46:46 -0500 Subject: [PATCH 02/11] rename serializer-r-object.R -> serializer-rds.R --- R/{serializer-r-object.R => serializer-rds.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename R/{serializer-r-object.R => serializer-rds.R} (100%) diff --git a/R/serializer-r-object.R b/R/serializer-rds.R similarity index 100% rename from R/serializer-r-object.R rename to R/serializer-rds.R From 3ba62362ecaf949fb428ff7c955237093ca24e85 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Fri, 22 Feb 2019 15:56:06 -0500 Subject: [PATCH 03/11] add params `version` and `ascii` to serlizer_rds --- R/serializer-rds.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/serializer-rds.R b/R/serializer-rds.R index 82f0b2e6d..d3cba237b 100644 --- a/R/serializer-rds.R +++ b/R/serializer-rds.R @@ -1,10 +1,11 @@ #' @rdname serializers +#' @inheritParams base::serialize #' @export -serializer_r_object <- function(){ - function(val, req, res, errorHandler){ +serializer_rds <- function(version = "2", ascii = FALSE, ...) { + function(val, req, res, errorHandler) { tryCatch({ res$setHeader("Content-Type", "application/octet-stream") - res$body <- base::serialize(val, NULL, ascii = FALSE) + res$body <- base::serialize(val, NULL, ascii = ascii, ...) return(res$toResponse()) }, error = function(e){ errorHandler(req, res, e) From e219962d4e43bfb1cc9952e77df8a954081f8c75 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Fri, 22 Feb 2019 15:56:24 -0500 Subject: [PATCH 04/11] add serializer_rds3 --- R/serializer-rds.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/serializer-rds.R b/R/serializer-rds.R index d3cba237b..6554f63ad 100644 --- a/R/serializer-rds.R +++ b/R/serializer-rds.R @@ -14,3 +14,10 @@ serializer_rds <- function(version = "2", ascii = FALSE, ...) { } .globals$serializers[["rObject"]] <- serializer_r_object + +#' @rdname serializers +#' @inheritParams base::serialize +#' @export +serializer_rds3 <- function(version = "3", ascii = FALSE, ...) { + serializer_rds(version = version, ascii = ascii, ...) +} From 1baa9e40d4f7c5a8a2d45496d0348abaa088cef9 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Fri, 22 Feb 2019 15:56:49 -0500 Subject: [PATCH 05/11] consistently include globals.R and document --- DESCRIPTION | 2 +- NAMESPACE | 3 ++- R/serializer-content-type.R | 3 ++- R/serializer-html.R | 1 + R/serializer-htmlwidget.R | 3 ++- R/serializer-json.R | 5 ++--- R/serializer-rds.R | 5 ++++- man/serializers.Rd | 18 +++++++++++++++--- 8 files changed, 29 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a7ac921b3..07a9eb387 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -66,7 +66,7 @@ Collate: 'serializer-content-type.R' 'serializer-html.R' 'serializer-htmlwidget.R' - 'serializer-r-object.R' + 'serializer-rds.R' 'serializer-xml.R' 'serializer.R' 'session-cookie.R' diff --git a/NAMESPACE b/NAMESPACE index 83df4caec..1fa9e1c65 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,7 +20,8 @@ export(serializer_content_type) export(serializer_html) export(serializer_htmlwidget) export(serializer_json) -export(serializer_r_object) +export(serializer_rds) +export(serializer_rds3) export(serializer_unboxed_json) export(sessionCookie) import(R6) diff --git a/R/serializer-content-type.R b/R/serializer-content-type.R index c7f6f6e0a..08c96e1fd 100644 --- a/R/serializer-content-type.R +++ b/R/serializer-content-type.R @@ -1,7 +1,7 @@ #' @rdname serializers #' @param type The value to provide for the `Content-Type` HTTP header. #' @export -serializer_content_type <- function(type){ +serializer_content_type <- function(type) { if (missing(type)){ stop("You must provide the custom content type to the serializer_content_type") } @@ -17,4 +17,5 @@ serializer_content_type <- function(type){ } } +#' @include globals.R .globals$serializers[["contentType"]] <- serializer_content_type diff --git a/R/serializer-html.R b/R/serializer-html.R index f8a56fb19..3086cef17 100644 --- a/R/serializer-html.R +++ b/R/serializer-html.R @@ -13,4 +13,5 @@ serializer_html <- function() { } } +#' @include globals.R .globals$serializers[["html"]] <- serializer_html diff --git a/R/serializer-htmlwidget.R b/R/serializer-htmlwidget.R index 6c7521cd5..cbe8d06e8 100644 --- a/R/serializer-htmlwidget.R +++ b/R/serializer-htmlwidget.R @@ -1,4 +1,3 @@ -#' @include globals.R #' @rdname serializers #' @export serializer_htmlwidget <- function(...) { @@ -35,4 +34,6 @@ serializer_htmlwidget <- function(...) { } } + +#' @include globals.R .globals$serializers[["htmlwidget"]] <- serializer_htmlwidget diff --git a/R/serializer-json.R b/R/serializer-json.R index 6c10d9f7e..0c3b64b5f 100644 --- a/R/serializer-json.R +++ b/R/serializer-json.R @@ -1,4 +1,3 @@ -#' @include globals.R #' @rdname serializers #' @param ... extra arguments supplied to respective internal serialization function. #' @export @@ -16,9 +15,7 @@ serializer_json <- function(...) { }) } } -.globals$serializers[["json"]] <- serializer_json -#' @include globals.R #' @rdname serializers #' @inheritParams jsonlite::toJSON #' @export @@ -26,4 +23,6 @@ serializer_unboxed_json <- function(auto_unbox = TRUE, ...) { serializer_json(auto_unbox = auto_unbox, ...) } +#' @include globals.R +.globals$serializers[["json"]] <- serializer_json .globals$serializers[["unboxedJSON"]] <- serializer_unboxed_json diff --git a/R/serializer-rds.R b/R/serializer-rds.R index 6554f63ad..6916d6709 100644 --- a/R/serializer-rds.R +++ b/R/serializer-rds.R @@ -13,7 +13,6 @@ serializer_rds <- function(version = "2", ascii = FALSE, ...) { } } -.globals$serializers[["rObject"]] <- serializer_r_object #' @rdname serializers #' @inheritParams base::serialize @@ -21,3 +20,7 @@ serializer_rds <- function(version = "2", ascii = FALSE, ...) { serializer_rds3 <- function(version = "3", ascii = FALSE, ...) { serializer_rds(version = version, ascii = ascii, ...) } + +#' @include globals.R +.globals$serializers[["rds"]] <- serializer_rds +.globals$serializers[["rds3"]] <- serializer_rds3 diff --git a/man/serializers.Rd b/man/serializers.Rd index e4456ceac..7e8447a3a 100644 --- a/man/serializers.Rd +++ b/man/serializers.Rd @@ -1,6 +1,6 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/serializer-json.R, R/serializer-content-type.R, -% R/serializer-html.R, R/serializer-htmlwidget.R, R/serializer-r-object.R, +% R/serializer-html.R, R/serializer-htmlwidget.R, R/serializer-rds.R, % R/serializer.R \name{serializer_json} \alias{serializer_json} @@ -8,7 +8,8 @@ \alias{serializer_content_type} \alias{serializer_html} \alias{serializer_htmlwidget} -\alias{serializer_r_object} +\alias{serializer_rds} +\alias{serializer_rds3} \alias{serializers} \title{Plumber Serializers} \usage{ @@ -22,7 +23,9 @@ serializer_html() serializer_htmlwidget(...) -serializer_r_object() +serializer_rds(version = "2", ascii = FALSE, ...) + +serializer_rds3(version = "3", ascii = FALSE, ...) } \arguments{ \item{...}{extra arguments supplied to respective internal serialization function.} @@ -31,6 +34,15 @@ serializer_r_object() An exception is that objects of class \code{AsIs} (i.e. wrapped in \code{I()}) are not automatically unboxed. This is a way to mark single values as length-1 arrays.} \item{type}{The value to provide for the \code{Content-Type} HTTP header.} + +\item{version}{the workspace format version to use. \code{NULL} + specifies the current default version (2), which has been the default + since \R 1.4.0. The only other supported value is 3, introduced in + \R 3.5.0.} + +\item{ascii}{a logical. If \code{TRUE} or \code{NA}, an ASCII + representation is written; otherwise (default) a binary one. + See also the comments in the help for \code{\link{save}}.} } \description{ Serializers are used in Plumber to transform the R object produced by a From cd7c38ee89c8948580da32cfb80cd77eea748e3d Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Fri, 22 Feb 2019 16:07:54 -0500 Subject: [PATCH 06/11] add check to prevent serializers v3 in early R versions --- R/serializer-rds.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/R/serializer-rds.R b/R/serializer-rds.R index 6916d6709..74ef7af39 100644 --- a/R/serializer-rds.R +++ b/R/serializer-rds.R @@ -2,6 +2,14 @@ #' @inheritParams base::serialize #' @export serializer_rds <- function(version = "2", ascii = FALSE, ...) { + if (identical(version, "3")) { + if (package_version(R.version) < "3.5") { + stop( + "R versions before 3.5 do not know how to serialize with `version = \"3\"`", + "\n Current R version: ", as.character(package_version(R.version)) + ) + } + } function(val, req, res, errorHandler) { tryCatch({ res$setHeader("Content-Type", "application/octet-stream") From 6fe333b8033467c1f9ce48e7ec12b95647023355 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Fri, 22 Feb 2019 16:08:05 -0500 Subject: [PATCH 07/11] pass version to serializer --- R/serializer-rds.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/serializer-rds.R b/R/serializer-rds.R index 74ef7af39..603120cc4 100644 --- a/R/serializer-rds.R +++ b/R/serializer-rds.R @@ -13,7 +13,7 @@ serializer_rds <- function(version = "2", ascii = FALSE, ...) { function(val, req, res, errorHandler) { tryCatch({ res$setHeader("Content-Type", "application/octet-stream") - res$body <- base::serialize(val, NULL, ascii = ascii, ...) + res$body <- base::serialize(val, NULL, ascii = ascii, version = version, ...) return(res$toResponse()) }, error = function(e){ errorHandler(req, res, e) From 0576d01ab168f69c98fd12dbe1aac9c6cbf4f43b Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Fri, 22 Feb 2019 16:09:30 -0500 Subject: [PATCH 08/11] rename test file --- .../{test-serializer-r-object.R => test-serializer-rds.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename tests/testthat/{test-serializer-r-object.R => test-serializer-rds.R} (100%) diff --git a/tests/testthat/test-serializer-r-object.R b/tests/testthat/test-serializer-rds.R similarity index 100% rename from tests/testthat/test-serializer-r-object.R rename to tests/testthat/test-serializer-rds.R From 83c8faaf1766f20d1a164182cdc72b222b2bfaed Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Fri, 22 Feb 2019 16:11:54 -0500 Subject: [PATCH 09/11] update serializer rds test for check v2 and v3 --- tests/testthat/test-serializer-rds.R | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-serializer-rds.R b/tests/testthat/test-serializer-rds.R index 7680b6771..1b74e3a48 100644 --- a/tests/testthat/test-serializer-rds.R +++ b/tests/testthat/test-serializer-rds.R @@ -1,11 +1,26 @@ -context("rObject serializer") +context("rds serializer") -test_that("rObject serializes properly", { +test_that("rds serializes properly", { v <- iris[0,] attr(v, "origin") <- iris - val <- serializer_r_object()(v, list(), PlumberResponse$new(), stop) + val <- serializer_rds()(v, list(), PlumberResponse$new(), stop) expect_equal(val$status, 200L) expect_equal(val$headers$`Content-Type`, "application/octet-stream") expect_equal(val$body, serialize(v, NULL, ascii = FALSE)) expect_equal(unserialize(val$body), v) }) + + +test_that("rds3 serializes properly", { + + testthat::skip_if(package_version(R.version) < "3.5") + + v <- iris[0,] + attr(v, "origin") <- iris + # version 3 added in R 3.5 + val <- serializer_rds3()(v, list(), PlumberResponse$new(), stop) + expect_equal(val$status, 200L) + expect_equal(val$headers$`Content-Type`, "application/octet-stream") + expect_equal(val$body, serialize(v, NULL, ascii = FALSE, version = "3")) + expect_equal(unserialize(val$body), v) +}) From 9f27af5c94ab08665c5f173586d8a9a2ea36477e Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Wed, 13 Mar 2019 15:24:18 -0400 Subject: [PATCH 10/11] remove rds3 --- NAMESPACE | 1 - R/serializer-rds.R | 8 -------- man/serializers.Rd | 3 --- 3 files changed, 12 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 1fa9e1c65..617f9bc07 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,7 +21,6 @@ export(serializer_html) export(serializer_htmlwidget) export(serializer_json) export(serializer_rds) -export(serializer_rds3) export(serializer_unboxed_json) export(sessionCookie) import(R6) diff --git a/R/serializer-rds.R b/R/serializer-rds.R index 603120cc4..8e005161a 100644 --- a/R/serializer-rds.R +++ b/R/serializer-rds.R @@ -22,13 +22,5 @@ serializer_rds <- function(version = "2", ascii = FALSE, ...) { } -#' @rdname serializers -#' @inheritParams base::serialize -#' @export -serializer_rds3 <- function(version = "3", ascii = FALSE, ...) { - serializer_rds(version = version, ascii = ascii, ...) -} - #' @include globals.R .globals$serializers[["rds"]] <- serializer_rds -.globals$serializers[["rds3"]] <- serializer_rds3 diff --git a/man/serializers.Rd b/man/serializers.Rd index 7e8447a3a..8721dbf31 100644 --- a/man/serializers.Rd +++ b/man/serializers.Rd @@ -9,7 +9,6 @@ \alias{serializer_html} \alias{serializer_htmlwidget} \alias{serializer_rds} -\alias{serializer_rds3} \alias{serializers} \title{Plumber Serializers} \usage{ @@ -24,8 +23,6 @@ serializer_html() serializer_htmlwidget(...) serializer_rds(version = "2", ascii = FALSE, ...) - -serializer_rds3(version = "3", ascii = FALSE, ...) } \arguments{ \item{...}{extra arguments supplied to respective internal serialization function.} From d25e14c53430d7dd98fc74e4ed0a9cbdaf1aa293 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Mon, 18 Mar 2019 15:46:15 -0400 Subject: [PATCH 11/11] remove rds3 test --- tests/testthat/test-serializer-rds.R | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/tests/testthat/test-serializer-rds.R b/tests/testthat/test-serializer-rds.R index 1b74e3a48..9274c42ec 100644 --- a/tests/testthat/test-serializer-rds.R +++ b/tests/testthat/test-serializer-rds.R @@ -9,18 +9,3 @@ test_that("rds serializes properly", { expect_equal(val$body, serialize(v, NULL, ascii = FALSE)) expect_equal(unserialize(val$body), v) }) - - -test_that("rds3 serializes properly", { - - testthat::skip_if(package_version(R.version) < "3.5") - - v <- iris[0,] - attr(v, "origin") <- iris - # version 3 added in R 3.5 - val <- serializer_rds3()(v, list(), PlumberResponse$new(), stop) - expect_equal(val$status, 200L) - expect_equal(val$headers$`Content-Type`, "application/octet-stream") - expect_equal(val$body, serialize(v, NULL, ascii = FALSE, version = "3")) - expect_equal(unserialize(val$body), v) -})