Export function-applier. (#25)

DESCRIPTION

@@ -20,7 +20,8 @@ Imports:
     jsonlite,
     purrr,
     rlang,
-    stbl
+    stbl,
+    vctrs
 Suggests: 
     covr,
     testthat (>= 3.0.0)

NAMESPACE

@@ -7,6 +7,7 @@ S3method(resp_parse,httr2_response)
 S3method(resp_parse,list)
 export(call_api)
 export(compact_nested_list)
+export(do_if_defined)
 export(req_perform_opinionated)
 export(req_prepare)
 export(resp_parse)

R/aaa_shared.R

@@ -24,6 +24,8 @@
 #' @param response_parser A function to parse the server response (`resp`).
 #'   Defaults to [httr2::resp_body_json()], since JSON responses are common. Set
 #'   this to `NULL` to return the raw response from [httr2::req_perform()].
+#' @param response_parser_args An optional list of arguments to pass to the
+#'   `response_parser` function (in addition to `resp`).
 #' @param security_fn A function to use to authenticate the request. By default
 #'   (`NULL`), no authentication is performed.
 #' @param security_args An optional list of arguments to the `security_fn`

R/call.R

@@ -8,13 +8,6 @@
 #'
 #' @inheritParams .shared-parameters
 #' @inheritParams req_perform_opinionated
-#' @param response_parser_args An optional list of arguments to pass to the
-#'   `response_parser` function (in addition to `resp`).
-#' @param next_req An optional function that takes the previous response
-#'   (`resp`) to generate the next request in a call to
-#'   [httr2::req_perform_iterative()]. This function can usually be generated
-#'   using one of the iteration helpers described in
-#'   [httr2::iterate_with_offset()].
 #'
 #' @return The response from the API, parsed by the `response_parser`.
 #' @export
@@ -41,7 +34,7 @@ call_api <- function(base_url,
     method = method,
     user_agent = user_agent
   )
-  req <- .req_security_apply(req, security_fn, security_args)
+  req <- do_if_defined(req, security_fn, !!!security_args)
   resp <- req_perform_opinionated(
     req,
     next_req = next_req,
@@ -55,12 +48,3 @@ call_api <- function(base_url,
   )
   return(resp)
 }
-
-.req_security_apply <- function(req, security_fn, security_args) {
-  if (length(security_fn)) {
-    req <- rlang::inject(
-      security_fn(req, !!!security_args)
-    )
-  }
-  return(req)
-}

R/perform.R

@@ -7,6 +7,11 @@
 #' @inheritParams .shared-parameters
 #' @inheritParams httr2::req_perform_iterative
 #' @inheritParams rlang::args_dots_empty
+#' @param next_req An optional function that takes the previous response
+#'   (`resp`) to generate the next request in a call to
+#'   [httr2::req_perform_iterative()]. This function can usually be generated
+#'   using one of the iteration helpers described in
+#'   [httr2::iterate_with_offset()].
 #' @param max_reqs The maximum number of separate requests to perform. Passed to
 #'   the max_reqs argument of [httr2::req_perform_iterative()] when `next_req`
 #'   is supplied. The default `2` should likely be changed to `Inf` after you

R/req.R

@@ -23,7 +23,7 @@ req_prepare <- function(base_url,
   req <- .req_query_flatten(req, query)
   req <- .req_body_auto(req, body, mime_type)
   req <- .req_method_apply(req, method)
-  req <- .req_user_agent_apply(req, user_agent)
+  req <- httr2::req_user_agent(req, user_agent)
   return(req)
 }
 
@@ -46,10 +46,3 @@ req_prepare <- function(base_url,
   }
   return(httr2::req_method(req, method))
 }
-
-.req_user_agent_apply <- function(req, user_agent) {
-  if (length(user_agent)) {
-    req <- httr2::req_user_agent(req, user_agent)
-  }
-  return(req)
-}

R/resp.R

@@ -48,22 +48,33 @@ resp_parse.default <- function(resp,
 resp_parse.httr2_response <- function(resp,
                                       ...,
                                       response_parser = httr2::resp_body_json) {
-  if (length(response_parser)) {
-    # Higher-level calls can include !!!'ed arguments.
-    dots <- rlang::list2(...)
-    return(rlang::inject(response_parser(resp, !!!dots)))
-  }
-  return(resp)
+  do_if_defined(resp, response_parser, ...)
 }
 
 #' @export
 resp_parse.list <- function(resp,
                             ...,
                             response_parser = httr2::resp_body_json) {
-  httr2::resps_data(
+  resp_parsed <- .resp_parse_impl(resp, response_parser, ...)
+  .resp_combine(resp_parsed)
+}
+
+.resp_parse_impl <- function(resp, response_parser, ...) {
+  # httr2::resps_data concatenates raw vectors, which is almost certainly not
+  # what users would want. For example, images get combined to be on top of one
+  # another.
+  lapply(
     httr2::resps_successes(resp),
-    resp_data = function(resp) {
-      resp_parse(resp, response_parser = response_parser, ...)
-    }
+    resp_parse,
+    response_parser = response_parser,
+    ...
   )
 }
+
+.resp_combine <- function(resp_parsed) {
+  purrr::discard(resp_parsed, is.null)
+  if (inherits(resp_parsed[[1]], "raw")) {
+    return(resp_parsed)
+  }
+  vctrs::list_unchop(resp_parsed)
+}

R/utils.R

@@ -62,3 +62,44 @@ url_path_append <- function(url, ...) {
   path <- gsub("/+", "/", path)
   return(sub("/$", "", path))
 }
+
+#' Use a provided function
+#'
+#' When constructing API calls programmatically, you may encounter situations
+#' where an upstream task should indicate which function to apply. For example,
+#' one endpoint might use a special security function that isn't used by other
+#' endpoints. This function exists to make coding such situations easier.
+#'
+#' @param x An object to potentially modify, such as an [httr2::request()]
+#'   object.
+#' @param fn A function to apply to `x`. If `fn` is `NULL`, `x` is returned
+#'   unchanged.
+#' @param ... Additional arguments to pass to `fn`.
+#'
+#' @return The object, potentially modified.
+#' @export
+#'
+#' @examples
+#' build_api_req <- function(endpoint, security_fn = NULL, ...) {
+#'   req <- httr2::request("https://example.com")
+#'   req <- httr2::req_url_path_append(req, endpoint)
+#'   do_if_defined(req, security_fn, ...)
+#' }
+#'
+#' # Most endpoints of this API do not require authentication.
+#' unsecure_req <- build_api_req("unsecure_endpoint")
+#' unsecure_req$headers
+#'
+#' # But one endpoint requires
+#' secure_req <- build_api_req(
+#'   "secure_endpoint", httr2::req_auth_bearer_token, "secret-token"
+#' )
+#' secure_req$headers$Authorization
+do_if_defined <- function(x, fn = NULL, ...) {
+  if (is.function(fn)) {
+    # Higher-level calls can include !!!'ed arguments.
+    dots <- rlang::list2(...)
+    x <- rlang::inject(fn(x, !!!dots))
+  }
+  return(x)
+}

tests/testthat/test-resp.R

@@ -62,3 +62,18 @@ test_that("resp_parse parses lists of httr2_responses", {
   test_result <- resp_parse(mock_response, response_parser = parser)
   expect_identical(test_result, 1:6)
 })
+
+test_that("resp_parse works for raw results", {
+  # reqs <- list(
+  #   httr2::request("https://httr2.r-lib.org/logo.png"),
+  #   httr2::request("https://docs.ropensci.org/magick/logo.png")
+  # )
+  # resps <- httr2::req_perform_sequential(reqs)
+  # saveRDS(resps, testthat::test_path("fixtures", "raw_resps.rds"))
+  resps <- readRDS(testthat::test_path("fixtures", "raw_resps.rds"))
+  test_result <- resp_parse(
+    resps,
+    response_parser = httr2::resp_body_raw
+  )
+  expect_equal(length(test_result), length(resps))
+})