New resp_tidy() function to extract data from responses.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: nectar
 Title: A Framework for Web API Packages
-Version: 0.0.0.9003
+Version: 0.0.0.9004
 Authors@R: c(
     person("Jon", "Harmon", , "jonthegeek@gmail.com", role = c("aut", "cre", "cph"),
            comment = c(ORCID = "0000-0003-4781-4346")),
@@ -30,7 +30,9 @@ Imports:
 Suggests: 
     covr,
     stringi,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    tibble,
+    tibblify
 Remotes:
     jonthegeek/stbl
 Config/testthat/edition: 3

NAMESPACE

@@ -5,6 +5,10 @@ S3method(.add_body,multipart)
 S3method(resp_parse,default)
 S3method(resp_parse,httr2_response)
 S3method(resp_parse,list)
+S3method(resp_tidy,default)
+S3method(resp_tidy,httr2_response)
+S3method(resp_tidy,list)
+S3method(resp_tidy,nectar_responses)
 export(call_api)
 export(compact_nested_list)
 export(do_if_fn_defined)
@@ -15,7 +19,13 @@ export(req_modify)
 export(req_perform_opinionated)
 export(req_pkg_user_agent)
 export(req_prepare)
+export(resp_body_auto)
+export(resp_body_csv)
+export(resp_body_separate)
+export(resp_body_tsv)
 export(resp_parse)
+export(resp_tidy)
+export(resp_tidy_json)
 export(stabilize_string)
 export(url_normalize)
 export(url_path_append)

R/aaa-shared.R

@@ -20,11 +20,14 @@
 #' @param body (multiple types) An object to use as the body of the request. If
 #'   any component of the body is a path, pass it through [fs::path()] or
 #'   otherwise give it the class "fs_path" to indicate that it is a path.
-#' @param call  (`environment`) The environment from which a function was
-#'   called, e.g. [rlang::caller_env()] (the default). The environment will be
-#'   mentioned in error messages as the source of the error. This argument is
-#'   particularly useful for functions that are intended to be called as
-#'   utilities inside other functions.
+#' @param call (`environment`) The environment from which a function was called,
+#'   e.g. [rlang::caller_env()] (the default). The environment will be mentioned
+#'   in error messages as the source of the error. This argument is particularly
+#'   useful for functions that are intended to be called as utilities inside
+#'   other functions.
+#' @param check_type (`length-1 logical`) Whether to check that the response has
+#'   the expected content type. Set to `FALSE` if the response is not
+#'   specifically tagged as the proper type.
 #' @param existing_user_agent (`length-1 character`, optional) An existing user
 #'   agent, such as the value of `req$options$useragent` in a [httr2::request()]
 #'   object.
@@ -48,9 +51,14 @@
 #'   `.multi` argument to pass to [httr2::req_url_query()] to control how
 #'   elements containing multiple values are handled.
 #' @param req (`httr2_request`) A [httr2::request()] object.
-#' @param resp (`httr2_response` or `list`) A single [httr2::response()] object
-#'   (as returned by [httr2::req_perform()]) or a list of such objects (as
-#'   returned by [httr2::req_perform_iterative()]).
+#' @param resp (`httr2_response`) A single [httr2::response()] object (as
+#'   returned by [httr2::req_perform()]).
+#' @param resps (`httr2_response`, `nectar_responses`, or `list`) A single
+#'   [httr2::response()] object (as returned by [httr2::req_perform()]) or a
+#'   list of such objects (as returned by [req_perform_opinionated()] or
+#'   [httr2::req_perform_iterative()]).
+#' @param resp_body_fn A function to extract the body of the response. Default:
+#'   [resp_body_auto()].
 #' @param response_parser (`function`) 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

R/call_api.R

@@ -29,7 +29,7 @@ call_api <- function(base_url,
                      method = NULL,
                      auth_fn = NULL,
                      auth_args = list(),
-                     response_parser = httr2::resp_body_json,
+                     response_parser = resp_tidy,
                      response_parser_args = list(),
                      next_req = NULL,
                      max_reqs = Inf,
@@ -47,16 +47,16 @@ call_api <- function(base_url,
     auth_fn = auth_fn,
     auth_args = auth_args
   )
-  resp <- req_perform_opinionated(
+  resps <- req_perform_opinionated(
     req,
     next_req = next_req,
     max_reqs = max_reqs,
     max_tries_per_req = max_tries_per_req
   )
-  resp <- resp_parse(
-    resp,
+  result <- resp_parse(
+    resps,
     response_parser = response_parser,
     !!!response_parser_args
   )
-  return(resp)
+  return(result)
 }

R/iterate_with_json_cursor.R

@@ -4,18 +4,23 @@
 #' for the common situation where the response body is json, and the cursor can
 #' be "empty" in various ways. Even within a single API, some endpoints might
 #' return a `NULL` `next_cursor` to indicate that there are no more pages of
-#' results, while other endpoints might return `""`. This function normalized
+#' results, while other endpoints might return `""`. This function normalizes
 #' all such results to `NULL`.
 #'
 #' @param param_name (`length-1 character`) The name of the `cursor` parameter
 #'   in the request.
 #' @param next_cursor_path (`character`) A vector indicating the path to the
-#'   `next_cursor` element in the body of the response.
+#'   `next_cursor` element in the body of the response. For example, for the
+#'   [Slack API](https://api.slack.com/apis/pagination), this value is
+#'   `c("response_metadata", "next_cursor")`, while for the [Crossref Unified
+#'   Resource API](https://api.crossref.org/swagger-ui/index.html), this value
+#'   is `"next-cursor"`.
 #'
 #' @returns A function that takes the response and the previous request, and
 #'   returns the next request if there are more results.
 #' @export
-iterate_with_json_cursor <- function(param_name, next_cursor_path) {
+iterate_with_json_cursor <- function(param_name = "cursor",
+                                     next_cursor_path) {
   httr2::iterate_with_cursor(
     param_name = param_name,
     resp_param_value = .next_cursor_finder(
@@ -28,13 +33,13 @@ iterate_with_json_cursor <- function(param_name, next_cursor_path) {
 #' Cursor finder factory
 #'
 #' @inheritParams iterate_with_json_cursor
-#' @param resp_body_fn A function to extract the body of the response, such as
-#'   [httr2::resp_body_json()].
+#' @inheritParams .shared-params
 #'
 #' @returns A function that returns the next cursor, or `NULL` if the next
 #'   cursor is `NULL` (or otherwise length-0) or `""`.
 #' @keywords internal
-.next_cursor_finder <- function(next_cursor_path, resp_body_fn) {
+.next_cursor_finder <- function(next_cursor_path,
+                                resp_body_fn = resp_body_auto) {
   force(next_cursor_path)
   function(resp) {
     cursor <- purrr::pluck(resp_body_fn(resp), !!!next_cursor_path)

R/req_perform_opinionated.R

@@ -20,7 +20,7 @@
 #'   [httr2::req_retry()].
 #'
 #' @return A list of [httr2::response()] objects, one for each request
-#'   performed.
+#'   performed. The list has additional class `nectar_responses`.
 #' @export
 req_perform_opinionated <- function(req,
                                     ...,
@@ -30,13 +30,16 @@ req_perform_opinionated <- function(req,
   rlang::check_dots_empty()
   req <- .req_apply_retry_default(req, max_tries_per_req)
   if (is.null(next_req)) {
-    return(list(req_perform(req)))
+    resps <- list(req_perform(req))
+  } else {
+    resps <- req_perform_iterative(
+      req,
+      next_req = next_req,
+      max_reqs = max_reqs
+    )
   }
-  req_perform_iterative(
-    req,
-    next_req = next_req,
-    max_reqs = max_reqs
-  )
+  class(resps) <- c("nectar_responses", class(resps))
+  return(resps)
 }
 
 .req_apply_retry_default <- function(req, max_tries_per_req) {

R/resp_body_auto.R

@@ -0,0 +1,44 @@
+#' Automatically choose a body parser
+#'
+#' Use the `Content-Type` header (extracted using [httr2::resp_content_type()])
+#' of a response to automatically choose and apply a body parser, such as
+#' [httr2::resp_body_json()] or [resp_body_csv()].
+#'
+#' @inheritParams .shared-params
+#'
+#' @returns The parsed response body.
+#' @export
+resp_body_auto <- function(resp) {
+  content_type <- httr2::resp_content_type(resp)
+  switch(
+    content_type,
+    "application/json" = httr2::resp_body_json(resp),
+    "application/xml" = httr2::resp_body_xml(resp),
+    "text/xml" = httr2::resp_body_xml(resp),
+    "application/xhtml+xml" = httr2::resp_body_html(resp),
+    "text/html" = httr2::resp_body_html(resp),
+    "text/csv" = resp_body_csv(resp),
+    "text/tab-separated-values" = resp_body_tsv(resp),
+    "image/svg+xml" = httr2::resp_body_string(resp),
+    .resp_body_auto_other(resp)
+  )
+}
+
+#' Automatically choose more body parsers
+#'
+#' This helper function exists to find somewhat variable content types and
+#' attempt to send them to the proper body parser.
+#'
+#' @inheritParams .shared-params
+#' @inherit resp_body_auto return
+#' @keywords internal
+.resp_body_auto_other <- function(resp) {
+  content_type <- httr2::resp_content_type(resp)
+  if (grepl("application/(.*)\\+json", content_type)) {
+    return(httr2::resp_body_json(resp))
+  }
+  if (grepl("text/(.*)", content_type)) {
+    return(httr2::resp_body_string(resp))
+  }
+  return(httr2::resp_body_raw(resp))
+}

R/resp_body_csv.R

@@ -0,0 +1,30 @@
+#' Extract tabular data from response body
+#'
+#' Extract tabular data in comma-separated or tab-separated format from a
+#' response body.
+#'
+#' @inheritParams .shared-params
+#'
+#' @returns The parsed response body as a data frame.
+#' @export
+resp_body_csv <- function(resp, check_type = TRUE) {
+  httr2::resp_check_content_type(
+    resp,
+    valid_types = "text/csv",
+    valid_suffix = "csv",
+    check_type = check_type
+  )
+  utils::read.csv(text = httr2::resp_body_string(resp))
+}
+
+#' @rdname resp_body_csv
+#' @export
+resp_body_tsv <- function(resp, check_type = TRUE) {
+  httr2::resp_check_content_type(
+    resp,
+    valid_types = "text/tab-separated-values",
+    valid_suffix = "tsv",
+    check_type = check_type
+  )
+  utils::read.delim(text = httr2::resp_body_string(resp))
+}

R/resp_body_separate.R

@@ -0,0 +1,10 @@
+#' Extract response body into list
+#'
+#' @inheritParams .shared-params
+#'
+#' @returns The parsed response body wrapped in a [list()]. This is useful for
+#'   things like raw vectors that you wish to parse with [httr2::resps_data()].
+#' @export
+resp_body_separate <- function(resp, resp_body_fn = resp_body_auto) {
+  list(resp_body_fn(resp))
+}

R/resp_parse.R

@@ -1,75 +1,82 @@
 #' Parse one or more responses
 #'
-#' `httr2` provides two methods for performing requests: [httr2::req_perform()],
-#' which returns a single [httr2::response()] object, and
-#' [httr2::req_perform_iterative()], which returns a list of [httr2::response()]
-#' objects. This function automatically determines whether a single response or
-#' multiple responses have been returned, and parses the responses
-#' appropriately.
+#' @description `r lifecycle::badge("questioning")`
+#'
+#'   If you have implemented the full `nectar` framework, use [resp_tidy()]
+#'   directly to parse your responses. We may continue to support
+#'   `resp_parse()`, but it is most useful as a bridge to the full framework.
+#'
+#'   `httr2` provides two methods for performing requests:
+#'   [httr2::req_perform()], which returns a single [httr2::response()] object,
+#'   and [httr2::req_perform_iterative()], which returns a list of
+#'   [httr2::response()] objects. This function automatically determines whether
+#'   a single response or multiple responses have been returned, and parses the
+#'   responses appropriately.
 #'
 #' @inheritParams .shared-params
 #' @param ... Additional arguments passed on to the `response_parser` function
-#'   (in addition to `resp`).
+#'   (in addition to `resps`).
 #'
-#' @return The response parsed by the `response_parser`. If `resp` was a list,
+#' @return The response parsed by the `response_parser`. If `resps` was a list,
 #'   the parsed responses are concatenated when possible. Unlike
 #'   [httr2::resps_data], this function does not concatenate raw vector
 #'   responses.
 #' @export
-resp_parse <- function(resp, ...) {
+resp_parse <- function(resps, ...) {
   UseMethod("resp_parse")
 }
 
 #' @inheritParams .shared-params
 #' @export
 #' @rdname resp_parse
-resp_parse.default <- function(resp,
+resp_parse.default <- function(resps,
                                ...,
-                               arg = rlang::caller_arg(resp),
+                               arg = rlang::caller_arg(resps),
                                call = rlang::caller_env()) {
-  cli_abort(
+  .nectar_abort(
     c(
       "{.arg {arg}} must be a {.cls list} or a {.cls httr2_response}.",
-      x = "{.arg {arg}} is {.obj_type_friendly {resp}}."
+      x = "{.arg {arg}} is {.obj_type_friendly {resps}}."
     ),
-    class = "nectar_error_unsupported_response_class",
+    error_class = "unsupported_response_class",
     call = call
   )
 }
 
 #' @inheritParams .shared-params
 #' @export
 #' @rdname resp_parse
-resp_parse.httr2_response <- function(resp,
+resp_parse.httr2_response <- function(resps,
                                       ...,
-                                      response_parser = httr2::resp_body_json) {
-  do_if_fn_defined(resp, response_parser, ...)
+                                      response_parser = resp_tidy) {
+  do_if_fn_defined(resps, response_parser, ...)
 }
 
 #' @export
-resp_parse.list <- function(resp,
+resp_parse.list <- function(resps,
                             ...,
-                            response_parser = httr2::resp_body_json) {
-  resp_parsed <- .resp_parse_impl(resp, response_parser, ...)
-  .resp_combine(resp_parsed)
+                            response_parser = resp_tidy) {
+  resps_parsed <- .resp_parse_impl(resps, response_parser, ...)
+  .resps_combine(resps_parsed)
 }
 
-.resp_parse_impl <- function(resp, response_parser, ...) {
+.resp_parse_impl <- function(resps, 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),
+    httr2::resps_successes(resps),
     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)
+.resps_combine <- function(resps_parsed) {
+  purrr::discard(resps_parsed, is.null)
+  if (inherits(resps_parsed[[1]], "raw")) {
+    # This is tested, but covr doesn't believe it.
+    return(resps_parsed) # nocov
   }
-  vctrs::list_unchop(resp_parsed)
+  vctrs::list_unchop(resps_parsed)
 }