Cache the result of resp_body_json() (#351)

Part of #341.

Author: hadley

NEWS.md

@@ -1,5 +1,8 @@
 # httr2 (development version)
 
+* `resp_body_json()` and `resp_body_xml()` now caches the parsed values so 
+  that you can use them repeatedly without worrying about the performance cost.
+
 * `req_url_query()` gains a `.multi` parameter that controls what happens when
   you supply multiple values in a vector. The default will continue to error 
   but you can use `.multi = "comma"` to separate with commas, `"pipe"` to 

R/resp-body.R

@@ -10,7 +10,8 @@
 #'
 #' `resp_body_json()` and `resp_body_xml()` check that the content-type header
 #' is correct; if the server returns an incorrect type you can suppress the
-#' check with `check_type = FALSE`.
+#' check with `check_type = FALSE`. These two functions also cache the parsed
+#' object so the second and subsequent calls are low-cost.
 #'
 #' @param resp A response object.
 #' @returns
@@ -77,6 +78,11 @@ resp_body_string <- function(resp, encoding = NULL) {
 #' @rdname resp_body_raw
 #' @export
 resp_body_json <- function(resp, check_type = TRUE, simplifyVector = FALSE, ...) {
+  key <- body_cache_key("json", simplifyVector = simplifyVector, ...)
+  if (env_has(resp$cache, key)) {
+    return(resp$cache[[key]])
+  }
+
   check_response(resp)
   check_installed("jsonlite")
   resp_check_content_type(
@@ -87,7 +93,8 @@ resp_body_json <- function(resp, check_type = TRUE, simplifyVector = FALSE, ...)
   )
 
   text <- resp_body_string(resp, "UTF-8")
-  jsonlite::fromJSON(text, simplifyVector = simplifyVector, ...)
+  resp$cache[[key]] <- jsonlite::fromJSON(text, simplifyVector = simplifyVector, ...)
+  resp$cache[[key]]
 }
 
 #' @rdname resp_body_raw
@@ -107,6 +114,12 @@ resp_body_html <- function(resp, check_type = TRUE, ...) {
 #' @rdname resp_body_raw
 #' @export
 resp_body_xml <- function(resp, check_type = TRUE, ...) {
+  key <- body_cache_key("xml", ...)
+  if (env_has(resp$cache, key)) {
+    return(resp$cache[[key]])
+  }
+
+
   check_response(resp)
   check_installed("xml2")
   resp_check_content_type(
@@ -116,5 +129,11 @@ resp_body_xml <- function(resp, check_type = TRUE, ...) {
     check_type = check_type
   )
 
-  xml2::read_xml(resp$body, ...)
+  resp$cache[[key]] <- xml2::read_xml(resp$body, ...)
+  resp$cache[[key]]
+}
+
+body_cache_key <- function(prefix, ...) {
+  key <- hash(list(...))
+  paste0(prefix, "-", substr(key, 1, 10))
 }

R/resp.R

@@ -90,7 +90,8 @@ new_response <- function(method,
       url = url,
       status_code = status_code,
       headers = headers,
-      body = body
+      body = body,
+      cache = new_environment()
     ),
     class = "httr2_response"
   )

man/resp_body_raw.Rd

@@ -30,6 +30,33 @@ test_that("can retrieve parsed body", {
   expect_s3_class(resp_body_xml(resp), "xml_document")
 })
 
+test_that("resp_body_json stores parsed result", {
+  resp <- request_test("/json") %>% req_perform()
+  json1 <- resp_body_json(resp)
+  # check it's saved
+  expect_length(resp$cache, 1)
+
+  # check it's not recomputed
+  json2 <- resp_body_json(resp)
+  expect_true(is_reference(json2, json1))
+
+  # check the arguments matter
+  json3 <- resp_body_json(resp, simplifyVector = TRUE)
+  expect_false(is_reference(json3, json1))
+  expect_length(resp$cache, 2)
+})
+
+test_that("resp_body_xml stores parsed result", {
+  resp <- request_test("/xml") %>% req_perform()
+  xml1 <- resp_body_xml(resp)
+  # check it's saved
+  expect_length(resp$cache, 1)
+
+  # check it's not recomputed
+  xml2 <- resp_body_xml(resp)
+  expect_true(is_reference(xml2, xml1))
+})
+
 test_that("content types are checked", {
   expect_snapshot(error = TRUE, {
     request_test("/xml") %>% req_perform() %>% resp_body_json()