Merge pull request #180 from sharlagelfand/simplify-vector

Add `simplify_vector` parameter to `get_request()` and `post_request()` for improved JSON structure handling

Author: rolfsimoes

R/collections-query.R

@@ -70,8 +70,8 @@ before_request.collections <- function(q) {
 }
 
 #' @export
-after_response.collections <- function(q, res) {
-  content <- content_response_json(res)
+after_response.collections <- function(q, res, simplify_vector = TRUE) {
+  content <- content_response_json(res, simplify_vector)
   doc_collections(content)
 }
 
@@ -82,7 +82,7 @@ before_request.collection_id <- function(q) {
 }
 
 #' @export
-after_response.collection_id <- function(q, res) {
-  content <- content_response_json(res)
+after_response.collection_id <- function(q, res, simplify_vector = TRUE) {
+  content <- content_response_json(res, simplify_vector)
   doc_collection(content)
 }

R/conformance-query.R

@@ -37,7 +37,7 @@ before_request.conformance <- function(q) {
 }
 
 #' @export
-after_response.conformance <- function(q, res) {
-  content <- content_response_json(res)
+after_response.conformance <- function(q, res, simplify_vector = TRUE) {
+  content <- content_response_json(res, simplify_vector)
   doc_conformance(content)
 }

R/extensions.R

@@ -81,11 +81,14 @@
 #' section bellow that can help the extension development.
 #'
 #'
-#' @param q       a `rstac_query` object expressing a STAC query
+#' @param q                a `rstac_query` object expressing a STAC query
 #' criteria.
 #'
-#' @param res     a `httr` `response` object.
-#' @param params  a `list` with params to add in request.
+#' @param res              a `httr` `response` object.
+#' @param simplify_vector  a `logical` describing whether length-one nested
+#' lists should be simplified into vectors. Defaults to TRUE. Can also be set
+#' for an entire session via e.g. \code{options(rstac.simplify_vector = FALSE)}.
+#' @param params           a `list` with params to add in request.
 #'
 #' @return
 #' A `rstac_query` object for `before_request()` and
@@ -108,7 +111,7 @@ before_request <- function(q) {
 #' @title Extension development functions
 #'
 #' @rdname extensions
-after_response <- function(q, res) {
+after_response <- function(q, res, simplify_vector = TRUE) {
   UseMethod("after_response", q)
 }
 
@@ -124,21 +127,22 @@ parse_params <- function(q, params) {
 #' response is in accordance with the allowed status codes and content-types.
 #' It returns the parsed content response.
 #'
-#' @param res     a `httr` `response` object.
+#' @param res           a `httr` `response` object.
 #'
 #' @param status_codes  a `character` vector with successful
 #' status codes.
 #'
 #' @param content_types a `character` vector with all acceptable
 #' responses' content type.
 #'
-#' @param key_message  a `character` vector with the JSON keys to show the
+#' @param key_message   a `character` vector with the JSON keys to show the
 #' requested API message.
 #'
 #' @return
 #' The `content_response()` function returns a `list` data structure
 #' representing the JSON file received in HTTP response
-content_response <- function(res, status_codes, content_types, key_message) {
+content_response <- function(res, status_codes, content_types, key_message,
+                             simplify_vector = TRUE) {
   # convert any json extension
   returned_content_type <- httr::http_type(res)
   if (!grepl(content_types, returned_content_type)) {
@@ -256,11 +260,12 @@ set_query_endpoint <- function(q, endpoint, params = NULL) {
   q
 }
 
-content_response_json <- function(res) {
+content_response_json <- function(res, simplify_vector = TRUE) {
   content_response(
     res = res,
     status_codes = "200",
     content_types = "application/.*json",
-    key_message = c("message", "description", "detail")
+    key_message = c("message", "description", "detail"),
+    simplify_vector = simplify_vector
   )
 }

R/items-query.R

@@ -130,8 +130,8 @@ before_request.items <- function(q) {
 }
 
 #' @export
-after_response.items <- function(q, res) {
-  content <- content_response_json(res)
+after_response.items <- function(q, res, simplify_vector = TRUE) {
+  content <- content_response_json(res, simplify_vector)
   doc_items(content, query = q)
 }
 
@@ -143,7 +143,7 @@ before_request.item_id <- function(q) {
 }
 
 #' @export
-after_response.item_id <- function(q, res) {
-  content <- content_response_json(res)
+after_response.item_id <- function(q, res, simplify_vector = TRUE) {
+  content <- content_response_json(res, simplify_vector)
   doc_item(content)
 }

R/queryables-query.R

@@ -48,7 +48,7 @@ before_request.queryables <- function(q) {
 }
 
 #' @export
-after_response.queryables <- function(q, res) {
-  content <- content_response_json(res)
+after_response.queryables <- function(q, res, simplify_vector = TRUE) {
+  content <- content_response_json(res, simplify_vector)
   doc_queryables(content)
 }

R/request.R

@@ -8,16 +8,20 @@
 #' The `post_request` is function that makes HTTP POST
 #' requests to STAC web services, retrieves, and parse the data.
 #'
-#' @param q         a `rstac_query` object expressing a STAC query
+#' @param q                a `rstac_query` object expressing a STAC query
 #' criteria.
 #'
-#' @param encode    a `character` informing the request body
+#' @param encode           a `character` informing the request body
 #' Content-Type. Accepted types are `'json'` (`'application/json'`),
 #' `'form'` (`'application/x-www-form-urlencoded'`),
 #' and `'multipart'` (`'multipart/form-data'`). Defaults to
 #' `'json'`.
 #'
-#' @param ...       config parameters to be passed to [GET][httr::GET] or
+#' @param simplify_vector  a `logical` describing whether length-one nested
+#' lists should be simplified into vectors. Defaults to TRUE. Can also be set
+#' for an entire session via e.g. \code{options(rstac.simplify_vector = FALSE)}.
+#'
+#' @param ...              config parameters to be passed to [GET][httr::GET] or
 #' [POST][httr::POST] methods, such as [add_headers][httr::add_headers] or
 #' [set_cookies][httr::set_cookies].
 #'
@@ -41,7 +45,9 @@
 #'      post_request()
 #' }
 #' @export
-get_request <- function(q, ...) {
+get_request <- function(q, simplify_vector = NULL, ...) {
+  simplify_vector <- simplify_vector_argument(simplify_vector)
+
   check_query(q)
   q$verb <- "GET"
   q$encode <- NULL
@@ -54,12 +60,14 @@ get_request <- function(q, ...) {
     error_msg = "Error while requesting"
   )
   # process content and return
-  after_response(q, res = res)
+  after_response(q, res = res, simplify_vector = simplify_vector)
 }
 
 #' @rdname request
 #' @export
-post_request <- function(q, ..., encode = c("json", "multipart", "form")) {
+post_request <- function(q, simplify_vector = NULL, ..., encode = c("json", "multipart", "form")) {
+  simplify_vector <- simplify_vector_argument(simplify_vector)
+
   check_query(q)
   # check request settings
   encode <- encode[[1]]
@@ -76,5 +84,9 @@ post_request <- function(q, ..., encode = c("json", "multipart", "form")) {
     error_msg = "Error while requesting"
   )
   # process content and return
-  after_response(q, res = res)
+  after_response(q, res = res, simplify_vector = simplify_vector)
+}
+
+simplify_vector_argument <- function(simplify_vector = NULL) {
+  ifelse(!is.null(simplify_vector), simplify_vector, getOption("rstac.simplify_vector", default = TRUE))
 }

R/stac-query.R

@@ -57,7 +57,7 @@ before_request.stac <- function(q) {
 }
 
 #' @export
-after_response.stac <- function(q, res) {
-  content <- content_response_json(res)
+after_response.stac <- function(q, res, simplify_vector = TRUE) {
+  content <- content_response_json(res, simplify_vector)
   doc_catalog(content)
 }