diff --git a/DESCRIPTION b/DESCRIPTION index 817d1058..b7223dcc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -49,7 +49,9 @@ Suggests: future, rstudioapi, spelling, - mockery (>= 0.4.2) + mockery (>= 0.4.2), + geojsonsf, + sf RoxygenNote: 7.1.1 Collate: 'async.R' diff --git a/NAMESPACE b/NAMESPACE index fa6fd847..d12ec054 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ export(options_plumber) export(parser_csv) export(parser_feather) export(parser_form) +export(parser_geojson) export(parser_json) export(parser_multi) export(parser_none) @@ -76,6 +77,7 @@ export(serializer_csv) export(serializer_device) export(serializer_feather) export(serializer_format) +export(serializer_geojson) export(serializer_headers) export(serializer_html) export(serializer_htmlwidget) diff --git a/NEWS.md b/NEWS.md index 316b2cd8..27ddfb76 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,9 @@ ## Breaking changes ## New features + +* Introduces new Geojson serializer and parser. Geojson objects are parsed into `sf` objects and `sf` or `sfc` objects will be serialized into geojson. (@josiahparry, #830) + ## Bug fixes * OpenAPI response type detection had a scoping issue. Use serializer defined `Content-Type` header instead. (@meztez, #789) diff --git a/R/parse-body.R b/R/parse-body.R index f9281da3..d734badc 100644 --- a/R/parse-body.R +++ b/R/parse-body.R @@ -386,6 +386,16 @@ parser_json <- function(...) { }) } +#' @describeIn parsers GeoJSON parser. See [geojsonsf::geojson_sf()] for more details. +#' @export +parser_geojson <- function(...) { + if (!requireNamespace("geojsonsf", quietly = TRUE)) { + stop("`geojsonsf` must be installed for `parser_geojson` to work") + } + parser_text(function(val) { + geojsonsf::geojson_sf(val, ...) + }) +} #' @describeIn parsers Helper parser to parse plain text #' @param parse_fn function to further decode a text string into an object @@ -564,6 +574,7 @@ register_parsers_onLoad <- function() { # yaml types: https://stackoverflow.com/a/38000954/591574 register_parser("yaml", parser_yaml, fixed = c("text/vnd.yaml", "application/yaml", "application/x-yaml", "text/yaml", "text/x-yaml")) register_parser("none", parser_none, regex = "*") + register_parser("geojson", parser_geojson, fixed = c("application/geo+json", "application/vdn.geo+json")) parser_all <- function() { stop("This function should never be called. It should be handled by `make_parser('all')`") diff --git a/R/serializer.R b/R/serializer.R index 5ac4ac8a..4a6b81b8 100644 --- a/R/serializer.R +++ b/R/serializer.R @@ -231,6 +231,18 @@ serializer_unboxed_json <- function(auto_unbox = TRUE, ..., type = "application/ serializer_json(auto_unbox = auto_unbox, ..., type = type) } +#' @describeIn serializers GeoJSON serializer. See also [geojsonsf::sf_geojson()] and [[geojsonsf::sfc_geojson()]]. +#' @export +serializer_geojson <- function(..., type = "application/geo+json") { + if (!requireNamespace("geojsonsf", quietly = TRUE)) { + stop("`geojsonsf` must be installed for `serializer_geojson` to work") + } + serializer_content_type(type, function(val) { + if (inherits(val, "sfc")) return(geojsonsf::sfc_geojson(val, ...)) + if (inherits(val, "sf")) return(geojsonsf::sf_geojson(val, ...)) + stop("Did not receive an `sf` or `sfc` object. ") + }) +} @@ -603,6 +615,7 @@ add_serializers_onLoad <- function() { register_serializer("tsv", serializer_tsv) register_serializer("feather", serializer_feather) register_serializer("yaml", serializer_yaml) + register_serializer("geojson", serializer_geojson) # text register_serializer("text", serializer_text) diff --git a/man/parsers.Rd b/man/parsers.Rd index a6b9850e..d4be32d6 100644 --- a/man/parsers.Rd +++ b/man/parsers.Rd @@ -3,6 +3,7 @@ \name{parser_form} \alias{parser_form} \alias{parser_json} +\alias{parser_geojson} \alias{parser_text} \alias{parser_yaml} \alias{parser_csv} @@ -19,6 +20,8 @@ parser_form() parser_json(...) +parser_geojson(...) + parser_text(parse_fn = identity) parser_yaml(...) @@ -68,6 +71,8 @@ See \code{\link[=registered_parsers]{registered_parsers()}} for a list of regist \item \code{parser_json}: JSON parser. See \code{\link[jsonlite:read_json]{jsonlite::parse_json()}} for more details. (Defaults to using \code{simplifyVectors = TRUE}) +\item \code{parser_geojson}: GeoJSON parser. See \code{\link[geojsonsf:geojson_sf]{geojsonsf::geojson_sf()}} for more details. + \item \code{parser_text}: Helper parser to parse plain text \item \code{parser_yaml}: YAML parser. See \code{\link[yaml:yaml.load]{yaml::yaml.load()}} for more details. diff --git a/man/serializers.Rd b/man/serializers.Rd index 1e432146..32499e21 100644 --- a/man/serializers.Rd +++ b/man/serializers.Rd @@ -8,6 +8,7 @@ \alias{serializer_html} \alias{serializer_json} \alias{serializer_unboxed_json} +\alias{serializer_geojson} \alias{serializer_rds} \alias{serializer_feather} \alias{serializer_yaml} @@ -40,6 +41,8 @@ serializer_json(..., type = "application/json") serializer_unboxed_json(auto_unbox = TRUE, ..., type = "application/json") +serializer_geojson(..., type = "application/geo+json") + serializer_rds(version = "2", ascii = FALSE, ..., type = "application/rds") serializer_feather(type = "application/feather") @@ -128,9 +131,11 @@ more details on Plumber serializers and how to customize their behavior. \item \code{serializer_unboxed_json}: JSON serializer with \code{auto_unbox} defaulting to \code{TRUE}. See also: \code{\link[jsonlite:fromJSON]{jsonlite::toJSON()}} +\item \code{serializer_geojson}: GeoJSON serializer. See also \code{\link[geojsonsf:sf_geojson]{geojsonsf::sf_geojson()}} and [\code{\link[geojsonsf:sfc_geojson]{geojsonsf::sfc_geojson()}}]. + \item \code{serializer_rds}: RDS serializer. See also: \code{\link[base:serialize]{base::serialize()}} -\item \code{serializer_feather}: feather serializer. See also: \code{\link[feather:read_feather]{feather::write_feather()}} +\item \code{serializer_feather}: feather serializer. See also: \code{\link[feather:write_feather]{feather::write_feather()}} \item \code{serializer_yaml}: YAML serializer. See also: \code{\link[yaml:as.yaml]{yaml::as.yaml()}} diff --git a/tests/testthat/test-parse-body.R b/tests/testthat/test-parse-body.R index f2054e8e..d1f89434 100644 --- a/tests/testthat/test-parse-body.R +++ b/tests/testthat/test-parse-body.R @@ -109,6 +109,40 @@ test_that("Test feather parser", { expect_equal(parsed, r_object) }) +test_that("Test geojson parser", { + skip_if_not_installed("geojsonsf") + skip_if_not_installed("sf") + + # Test sf object w/ fields + geojson <- '{"type":"FeatureCollection","features":[{"type":"Feature","properties":{"a":3},"geometry":{"type":"Point","coordinates":[1,2]}},{"type":"Feature","properties":{"a":4},"geometry":{"type":"Point","coordinates":[3,4]}}]}' + parsed <- parse_body(geojson, "application/geo+json", make_parser("geojson")) + expect_equal(parsed, geojsonsf::geojson_sf(geojson)) + + # Test sfc + geojson <- '[ + { "type":"Point","coordinates":[0,0]}, + {"type":"LineString","coordinates":[[0,0],[1,1]]} + ]' + parsed <- parse_body(geojson, "application/geo+json", make_parser("geojson")) + expect_equal(parsed, geojsonsf::geojson_sf(geojson)) + + # Test simple sf object + geojson <- '{ "type" : "Point", "coordinates" : [0, 0] }' + parsed <- parse_body(geojson, "application/geo+json", make_parser("geojson")) + expect_equal(parsed, geojsonsf::geojson_sf(geojson)) + + # Test geojson file + tmp <- tempfile() + on.exit({ + file.remove(tmp) + }, add = TRUE) + + writeLines(geojson, tmp) + val <- readBin(tmp, "raw", 1000) + parsed <- parse_body(val, "application/geo+json", make_parser("geojson")) + expect_equal(parsed, geojsonsf::geojson_sf(geojson)) + +}) test_that("Test multipart output is reduced for argument matching", { bin_file <- test_path("files/multipart-file-names.bin") diff --git a/tests/testthat/test-serializer-geojson.R b/tests/testthat/test-serializer-geojson.R new file mode 100644 index 00000000..6ac6eaad --- /dev/null +++ b/tests/testthat/test-serializer-geojson.R @@ -0,0 +1,35 @@ +test_that("GeoJSON serializes properly", { + skip_if_not_installed("geojsonsf") + skip_if_not_installed("sf") + + # Objects taken from ?st_sf() examples. + sfc <- sf::st_sfc(sf::st_point(1:2), sf::st_point(3:4)) + sf <- sf::st_sf(a = 3:4, sfc) + + # Test sfc + val <- serializer_geojson()(sfc, data.frame(), PlumberResponse$new(), stop) + expect_equal(val$status, 200L) + expect_equal(val$headers$`Content-Type`, "application/geo+json") + expect_equal(val$body, geojsonsf::sfc_geojson(sfc)) + + # Test sf + val <- serializer_geojson()(sf, data.frame(), PlumberResponse$new(), stop) + expect_equal(val$status, 200L) + expect_equal(val$headers$`Content-Type`, "application/geo+json") + expect_equal(val$body, geojsonsf::sf_geojson(sf)) + +}) + +test_that("Errors call error handler", { + skip_if_not_installed("geojsonsf") + skip_if_not_installed("sf") + + errors <- 0 + errHandler <- function(req, res, err){ + errors <<- errors + 1 + } + + expect_equal(errors, 0) + serializer_geojson()(parse(text="h$534i} {!"), data.frame(), PlumberResponse$new(), errorHandler = errHandler) + expect_equal(errors, 1) +})