From 43f1d145998150b59464e1f511913059e07cabed Mon Sep 17 00:00:00 2001
From: Jon Harmon <jonthegeek@gmail.com>
Date: Mon, 20 Jan 2025 07:36:17 -0600
Subject: [PATCH] New `req_tidy_policy()` function to define policies for
 `resp_tidy()`. (#45)

Closes #44.
---
 NAMESPACE                              |  1 +
 R/req_modify.R                         |  2 +-
 R/req_perform_opinionated.R            |  5 +++
 R/req_policy.R                         | 30 ++++++++++++++++
 R/req_tidy_policy.R                    | 28 +++++++++++++++
 R/resp_tidy.R                          |  7 ++--
 R/utils.R                              | 27 +++++++-------
 man/do_if_fn_defined.Rd                |  8 ++++-
 man/dot-do_if_args_defined.Rd          | 13 ++++---
 man/dot-req_apply_retry_default.Rd     | 23 ++++++++++++
 man/dot-req_policy.Rd                  | 28 +++++++++++++++
 man/req_tidy_policy.Rd                 | 39 ++++++++++++++++++++
 man/resp_tidy.Rd                       |  3 +-
 tests/testthat/test-req_auth_api_key.R |  7 ++++
 tests/testthat/test-req_policy.R       | 49 ++++++++++++++++++++++++++
 tests/testthat/test-req_tidy_policy.R  | 35 ++++++++++++++++++
 tests/testthat/test-resp_tidy.R        | 12 +++----
 tests/testthat/test-resp_tidy_json.R   |  4 +--
 18 files changed, 286 insertions(+), 35 deletions(-)
 create mode 100644 R/req_policy.R
 create mode 100644 R/req_tidy_policy.R
 create mode 100644 man/dot-req_apply_retry_default.Rd
 create mode 100644 man/dot-req_policy.Rd
 create mode 100644 man/req_tidy_policy.Rd
 create mode 100644 tests/testthat/test-req_policy.R
 create mode 100644 tests/testthat/test-req_tidy_policy.R

diff --git a/NAMESPACE b/NAMESPACE
index c25d3db..0ef0a40 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -19,6 +19,7 @@ export(req_modify)
 export(req_perform_opinionated)
 export(req_pkg_user_agent)
 export(req_prepare)
+export(req_tidy_policy)
 export(resp_body_auto)
 export(resp_body_csv)
 export(resp_body_separate)
diff --git a/R/req_modify.R b/R/req_modify.R
index d7aba76..a163b8b 100644
--- a/R/req_modify.R
+++ b/R/req_modify.R
@@ -39,7 +39,7 @@ req_modify <- function(req,
 
 .req_path_append_impl <- function(req, path) {
   path <- rlang::inject(glue::glue(!!!path, .sep = "/"))
-  path <- url_normalize(path)
+  path <- .path_merge(path)
   req <- httr2::req_url_path_append(req, path)
 }
 
diff --git a/R/req_perform_opinionated.R b/R/req_perform_opinionated.R
index 97409db..c015149 100644
--- a/R/req_perform_opinionated.R
+++ b/R/req_perform_opinionated.R
@@ -42,6 +42,11 @@ req_perform_opinionated <- function(req,
   return(resps)
 }
 
+#' Add a retry policy if none is defined
+#'
+#' @inheritParams req_perform_opinionated
+#' @inherit req_perform_opinionated return
+#' @keywords internal
 .req_apply_retry_default <- function(req, max_tries_per_req) {
   if (
     any(c("retry_max_wait", "retry_max_tries") %in% names(req$policies)) ||
diff --git a/R/req_policy.R b/R/req_policy.R
new file mode 100644
index 0000000..8e10132
--- /dev/null
+++ b/R/req_policy.R
@@ -0,0 +1,30 @@
+#' Apply policies to a request
+#'
+#' This function is based on the unexported `req_policies()` function from
+#' httr2. It is used to apply policies to a request object. I don't currently
+#' export this function, but that may change in the future.
+#'
+#' @inheritParams .shared-params
+#' @param ...
+#'
+#' @inherit .shared-request return
+#' @keywords internal
+.req_policy <- function(req, ..., call = rlang::caller_env()) {
+  dots <- rlang::list2(...)
+  if (!length(dots)) {
+    return(req)
+  }
+  if (!rlang::is_named(dots)) {
+    .nectar_abort(
+      "All components of {.arg ...} must be named.",
+      "bad_policy",
+      call = call
+    )
+  }
+  req$policies <- req$policies[!names(req$policies) %in% names(dots)]
+  req$policies <- c(req$policies, Filter(length, dots))
+  if (!length(req$policies)) {
+    names(req$policies) <- NULL
+  }
+  return(req)
+}
diff --git a/R/req_tidy_policy.R b/R/req_tidy_policy.R
new file mode 100644
index 0000000..75b77cc
--- /dev/null
+++ b/R/req_tidy_policy.R
@@ -0,0 +1,28 @@
+#' Define a tidy policy for a request
+#'
+#' API responses generally follow a structured format. Use this function to
+#' define a policy that will be used by [resp_tidy()] to extract the relevant
+#' portion of a response and wrangle it into a desired format.
+#'
+#' @inheritParams .shared-params
+#' @param tidy_fn A function that will be invoked by [resp_tidy()] to tidy the
+#'   response.
+#' @param tidy_args A list of additional arguments to pass to `tidy_fn`.
+#'
+#' @inherit .shared-request return
+#' @export
+#'
+#' @examples
+#' req <- httr2::request("https://example.com")
+#' req_tidy_policy(req, httr2::resp_body_json, list(simplifyVector = TRUE))
+req_tidy_policy <- function(req,
+                            tidy_fn = resp_body_auto,
+                            tidy_args = list(),
+                            call = rlang::caller_env()) {
+  tidy_fn <- rlang::as_function(tidy_fn, call = call)
+  .req_policy(
+    req,
+    resp_tidy = list(tidy_fn = tidy_fn, tidy_args = tidy_args),
+    call = call
+  )
+}
diff --git a/R/resp_tidy.R b/R/resp_tidy.R
index b884b5b..ec7bdf6 100644
--- a/R/resp_tidy.R
+++ b/R/resp_tidy.R
@@ -5,8 +5,7 @@
 #' API responses generally follow a structured format. Use this function to
 #' extract the relevant portion of a response, and wrangle it into a desired
 #' format. This function is most useful when the response was fetched with a
-#' request that includes a tidying policy (more information about this coming
-#' soon).
+#' request that includes a tidying policy defined via [req_tidy_policy()].
 #'
 #' @inheritParams .shared-params
 #'
@@ -34,9 +33,9 @@ resp_tidy.httr2_response <- function(resps) {
   if (length(req$policies$resp_tidy)) {
     return(
       rlang::exec(
-        req$policies$resp_tidy$fn,
+        req$policies$resp_tidy$tidy_fn,
         resps,
-        !!!req$policies$resp_tidy$args
+        !!!req$policies$resp_tidy$tidy_args
       )
     )
   }
diff --git a/R/utils.R b/R/utils.R
index 616decf..1fa24e1 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -99,6 +99,7 @@ url_normalize <- function(url) {
 #' one endpoint might use a special auth function that isn't used by other
 #' endpoints. This function exists to make coding such situations easier.
 #'
+#' @inheritParams .shared-params
 #' @param x An object to potentially modify, such as a [httr2::request()]
 #'   object.
 #' @param fn A function to apply to `x`. If `fn` is `NULL`, `x` is returned
@@ -124,8 +125,9 @@ url_normalize <- function(url) {
 #'   "secure_endpoint", httr2::req_auth_bearer_token, "secret-token"
 #' )
 #' secure_req$headers$Authorization
-do_if_fn_defined <- function(x, fn = NULL, ...) {
-  if (is.function(fn)) {
+do_if_fn_defined <- function(x, fn = NULL, ..., call = rlang::caller_env()) {
+  if (length(fn)) {
+    fn <- rlang::as_function(fn, call = call)
     # Higher-level calls can include !!!'ed arguments.
     dots <- rlang::list2(...)
     x <- rlang::inject(fn(x, !!!dots))
@@ -135,21 +137,16 @@ do_if_fn_defined <- function(x, fn = NULL, ...) {
 
 #' Use a function if args are provided
 #'
-#' @param x An object to potentially modify, such as a [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`.
+#' @inheritParams .shared-params
+#' @inheritParams do_if_fn_defined
 #'
-#' @return The object, potentially modified.
+#' @inherit do_if_fn_defined return
 #' @keywords internal
-.do_if_args_defined <- function(x, fn = NULL, ...) {
-  if (is.function(fn)) {
-    dots <- rlang::list2(...)
-    dots <- purrr::discard(dots, is.null)
-    if (length(dots)) {
-      x <- rlang::inject(fn(x, !!!dots))
-    }
+.do_if_args_defined <- function(x, fn = NULL, ..., call = rlang::caller_env()) {
+  dots <- rlang::list2(...)
+  dots <- purrr::discard(dots, is.null)
+  if (length(dots)) {
+    return(do_if_fn_defined(x, fn, !!!dots, call = call))
   }
   return(x)
 }
diff --git a/man/do_if_fn_defined.Rd b/man/do_if_fn_defined.Rd
index bacfa70..5dbf6ce 100644
--- a/man/do_if_fn_defined.Rd
+++ b/man/do_if_fn_defined.Rd
@@ -4,7 +4,7 @@
 \alias{do_if_fn_defined}
 \title{Use a provided function}
 \usage{
-do_if_fn_defined(x, fn = NULL, ...)
+do_if_fn_defined(x, fn = NULL, ..., call = rlang::caller_env())
 }
 \arguments{
 \item{x}{An object to potentially modify, such as a \code{\link[httr2:request]{httr2::request()}}
@@ -14,6 +14,12 @@ object.}
 unchanged.}
 
 \item{...}{Additional arguments to pass to \code{fn}.}
+
+\item{call}{(\code{environment}) The environment from which a function was called,
+e.g. \code{\link[rlang:stack]{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.}
 }
 \value{
 The object, potentially modified.
diff --git a/man/dot-do_if_args_defined.Rd b/man/dot-do_if_args_defined.Rd
index 10131b3..b065ca1 100644
--- a/man/dot-do_if_args_defined.Rd
+++ b/man/dot-do_if_args_defined.Rd
@@ -4,16 +4,21 @@
 \alias{.do_if_args_defined}
 \title{Use a function if args are provided}
 \usage{
-.do_if_args_defined(x, fn = NULL, ...)
+.do_if_args_defined(x, fn = NULL, ..., call = rlang::caller_env())
 }
 \arguments{
-\item{x}{An object to potentially modify, such as a \code{\link[httr2:request]{httr2::request()}}
-object.}
+\item{x}{(multiple types) The object to update.}
 
 \item{fn}{A function to apply to \code{x}. If \code{fn} is \code{NULL}, \code{x} is returned
 unchanged.}
 
-\item{...}{Additional arguments to pass to \code{fn}.}
+\item{...}{These dots are for future extensions and must be empty.}
+
+\item{call}{(\code{environment}) The environment from which a function was called,
+e.g. \code{\link[rlang:stack]{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.}
 }
 \value{
 The object, potentially modified.
diff --git a/man/dot-req_apply_retry_default.Rd b/man/dot-req_apply_retry_default.Rd
new file mode 100644
index 0000000..ac5d34f
--- /dev/null
+++ b/man/dot-req_apply_retry_default.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/req_perform_opinionated.R
+\name{.req_apply_retry_default}
+\alias{.req_apply_retry_default}
+\title{Add a retry policy if none is defined}
+\usage{
+.req_apply_retry_default(req, max_tries_per_req)
+}
+\arguments{
+\item{req}{The first \link[httr2]{request} to perform.}
+
+\item{max_tries_per_req}{The maximum number of times to attempt each
+individual request. Passed to the \code{max_tries} argument of
+\code{\link[httr2:req_retry]{httr2::req_retry()}}.}
+}
+\value{
+A list of \code{\link[httr2:response]{httr2::response()}} objects, one for each request
+performed. The list has additional class \code{nectar_responses}.
+}
+\description{
+Add a retry policy if none is defined
+}
+\keyword{internal}
diff --git a/man/dot-req_policy.Rd b/man/dot-req_policy.Rd
new file mode 100644
index 0000000..f487b56
--- /dev/null
+++ b/man/dot-req_policy.Rd
@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/req_policy.R
+\name{.req_policy}
+\alias{.req_policy}
+\title{Apply policies to a request}
+\usage{
+.req_policy(req, ..., call = rlang::caller_env())
+}
+\arguments{
+\item{req}{(\code{httr2_request}) A \code{\link[httr2:request]{httr2::request()}} object.}
+
+\item{...}{}
+
+\item{call}{(\code{environment}) The environment from which a function was called,
+e.g. \code{\link[rlang:stack]{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.}
+}
+\value{
+A \code{\link[httr2:request]{httr2::request()}} object.
+}
+\description{
+This function is based on the unexported \code{req_policies()} function from
+httr2. It is used to apply policies to a request object. I don't currently
+export this function, but that may change in the future.
+}
+\keyword{internal}
diff --git a/man/req_tidy_policy.Rd b/man/req_tidy_policy.Rd
new file mode 100644
index 0000000..88c8948
--- /dev/null
+++ b/man/req_tidy_policy.Rd
@@ -0,0 +1,39 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/req_tidy_policy.R
+\name{req_tidy_policy}
+\alias{req_tidy_policy}
+\title{Define a tidy policy for a request}
+\usage{
+req_tidy_policy(
+  req,
+  tidy_fn = resp_body_auto,
+  tidy_args = list(),
+  call = rlang::caller_env()
+)
+}
+\arguments{
+\item{req}{(\code{httr2_request}) A \code{\link[httr2:request]{httr2::request()}} object.}
+
+\item{tidy_fn}{A function that will be invoked by \code{\link[=resp_tidy]{resp_tidy()}} to tidy the
+response.}
+
+\item{tidy_args}{A list of additional arguments to pass to \code{tidy_fn}.}
+
+\item{call}{(\code{environment}) The environment from which a function was called,
+e.g. \code{\link[rlang:stack]{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.}
+}
+\value{
+A \code{\link[httr2:request]{httr2::request()}} object.
+}
+\description{
+API responses generally follow a structured format. Use this function to
+define a policy that will be used by \code{\link[=resp_tidy]{resp_tidy()}} to extract the relevant
+portion of a response and wrangle it into a desired format.
+}
+\examples{
+req <- httr2::request("https://example.com")
+req_tidy_policy(req, httr2::resp_body_json, list(simplifyVector = TRUE))
+}
diff --git a/man/resp_tidy.Rd b/man/resp_tidy.Rd
index 276f899..6c045d0 100644
--- a/man/resp_tidy.Rd
+++ b/man/resp_tidy.Rd
@@ -21,8 +21,7 @@ default, the response is processed with \code{\link[=resp_body_auto]{resp_body_a
 API responses generally follow a structured format. Use this function to
 extract the relevant portion of a response, and wrangle it into a desired
 format. This function is most useful when the response was fetched with a
-request that includes a tidying policy (more information about this coming
-soon).
+request that includes a tidying policy defined via \code{\link[=req_tidy_policy]{req_tidy_policy()}}.
 }
 \seealso{
 \code{\link[=resp_tidy_json]{resp_tidy_json()}} for an opinionated response parser for JSON
diff --git a/tests/testthat/test-req_auth_api_key.R b/tests/testthat/test-req_auth_api_key.R
index 3fdaa4e..e164927 100644
--- a/tests/testthat/test-req_auth_api_key.R
+++ b/tests/testthat/test-req_auth_api_key.R
@@ -36,6 +36,13 @@ test_that("req_auth_api_key works for query", {
     api_key = "my_key",
     location = "query"
   )
+  # As of 2025-01-20, httr2 on macos did not insert the "/", but all other OSs
+  # did. Normalizing manually here.
+  test_result$url <- stringr::str_replace(
+    test_result$url,
+    stringr::fixed("/?parm"),
+    stringr::fixed("?parm")
+  )
   expect_identical(
     test_result$url,
     "https://example.com?parm=my_key"
diff --git a/tests/testthat/test-req_policy.R b/tests/testthat/test-req_policy.R
new file mode 100644
index 0000000..496eeec
--- /dev/null
+++ b/tests/testthat/test-req_policy.R
@@ -0,0 +1,49 @@
+test_that(".req_policy returns reqs unchanged when no policies added", {
+  req <- httr2::request("https://example.com")
+  expect_identical(
+    .req_policy(req),
+    req
+  )
+})
+
+test_that(".req_policy errors informatively for unnamed policies", {
+  req <- httr2::request("https://example.com")
+  expect_error(
+    .req_policy(req, list(my_policy = "whatever")),
+    "must be named",
+    class = "nectar_error-bad_policy"
+  )
+})
+
+test_that(".req_policy applies a policy", {
+  req <- httr2::request("https://example.com")
+  new_policy <- list(a = 1, b = "thing")
+  test_result <- .req_policy(req, new_policy = new_policy)
+  expect_identical(
+    test_result$policies,
+    list(new_policy = new_policy)
+  )
+})
+
+test_that(".req_policy adds to existing policies", {
+  req <- httr2::request("https://example.com")
+  new_policy <- list(a = 1, b = "thing")
+  new_policy2 <- list(a = 2, b = "thing2")
+  req <- .req_policy(req, new_policy = new_policy)
+  test_result <- .req_policy(req, new_policy2 = new_policy2)
+  expect_identical(
+    test_result$policies,
+    list(new_policy = new_policy, new_policy2 = new_policy2)
+  )
+})
+
+test_that(".req_policy removes emptied policies", {
+  req <- httr2::request("https://example.com")
+  new_policy <- list(a = 1, b = "thing")
+  req <- .req_policy(req, new_policy = new_policy)
+  test_result <- .req_policy(req, new_policy = NULL)
+  expect_identical(
+    test_result$policies,
+    list()
+  )
+})
diff --git a/tests/testthat/test-req_tidy_policy.R b/tests/testthat/test-req_tidy_policy.R
new file mode 100644
index 0000000..337c3c9
--- /dev/null
+++ b/tests/testthat/test-req_tidy_policy.R
@@ -0,0 +1,35 @@
+test_that("req_tidy_policy errors informatively for bad fn", {
+  expect_error(
+    req_tidy_policy(
+      httr2::request("https://example.com"),
+      tidy_fn = "not a function"
+    ),
+    "was not found"
+  )
+})
+
+test_that("req_tidy_policy applies resp_body_auto by default", {
+  req <- req_tidy_policy(httr2::request("https://example.com"))
+  expect_identical(
+    req$policies$resp_tidy,
+    list(
+      tidy_fn = resp_body_auto,
+      tidy_args = list()
+    )
+  )
+})
+
+test_that("req_tidy_policy applies the specified policy", {
+  req <- req_tidy_policy(
+    httr2::request("https://example.com"),
+    tidy_fn = httr2::resp_body_json,
+    tidy_args = list(simplifyVector = TRUE)
+  )
+  expect_identical(
+    req$policies$resp_tidy,
+    list(
+      tidy_fn = httr2::resp_body_json,
+      tidy_args = list(simplifyVector = TRUE)
+    )
+  )
+})
diff --git a/tests/testthat/test-resp_tidy.R b/tests/testthat/test-resp_tidy.R
index 5d27ca7..786dc8d 100644
--- a/tests/testthat/test-resp_tidy.R
+++ b/tests/testthat/test-resp_tidy.R
@@ -37,7 +37,7 @@ test_that("resp_tidy parses httr2_response objects with resp_tidy policy", {
   mock_response$request <- list(
     policies = list(
       resp_tidy = list(
-        fn = function(resp) {
+        tidy_fn = function(resp) {
           unlist(httr2::resp_body_json(resp))
         }
       )
@@ -47,15 +47,15 @@ test_that("resp_tidy parses httr2_response objects with resp_tidy policy", {
   expect_identical(test_result, 1:3)
 })
 
-test_that("resp_tidy uses policies$resp_tidy$args", {
+test_that("resp_tidy uses policies$resp_tidy$tidy_args", {
   mock_response <- httr2::response_json(body = 1:3)
   mock_response$request <- list(
     policies = list(
       resp_tidy = list(
-        fn = function(resp, additional) {
+        tidy_fn = function(resp, additional) {
           c(unlist(httr2::resp_body_json(resp)), additional)
         },
-        args = list(additional = 4:6)
+        tidy_args = list(additional = 4:6)
       )
     )
   )
@@ -67,7 +67,7 @@ test_that("resp_tidy parses and combines nectar_responses objects", {
   request_obj <- list(
     policies = list(
       resp_tidy = list(
-        fn = function(resp) {
+        tidy_fn = function(resp) {
           unlist(httr2::resp_body_json(resp))
         }
       )
@@ -89,7 +89,7 @@ test_that("resp_tidy parses and combines lists of httr2_response objects", {
   request_obj <- list(
     policies = list(
       resp_tidy = list(
-        fn = function(resp) {
+        tidy_fn = function(resp) {
           unlist(httr2::resp_body_json(resp))
         }
       )
diff --git a/tests/testthat/test-resp_tidy_json.R b/tests/testthat/test-resp_tidy_json.R
index 6a87055..0112fdd 100644
--- a/tests/testthat/test-resp_tidy_json.R
+++ b/tests/testthat/test-resp_tidy_json.R
@@ -70,8 +70,8 @@ test_that("resp_tidy_json works with resp_tidy", {
   mock_response$request <- list(
     policies = list(
       resp_tidy = list(
-        fn = resp_tidy_json,
-        args = list(
+        tidy_fn = resp_tidy_json,
+        tidy_args = list(
           spec = tibblify::tspec_df(
             lc = tibblify::tib_chr("a"),
             uc = tibblify::tib_chr("b"),