Finalise req_url() functions

* Store url as a string
* Replace _set suffix with url_ prefix
* Test and document

NAMESPACE

@@ -6,6 +6,10 @@ export("%>%")
 export(req)
 export(req_fetch)
 export(req_stream)
+export(req_url)
+export(req_url_path)
+export(req_url_path_append)
+export(req_url_query)
 export(resp_body_json)
 export(resp_body_raw)
 export(resp_body_string)

R/req-fetch.R

@@ -13,14 +13,13 @@
 #' req("https://google.com") %>%
 #'   req_fetch()
 req_fetch <- function(req, path = NULL, handle = NULL) {
-  url <- req_url_get(req)
   handle <- handle %||% req_handle(req)
 
   if (!is.null(path)) {
-    res <- curl::curl_fetch_disk(url, path, handle)
+    res <- curl::curl_fetch_disk(req$url, path, handle)
     body <- new_path(path)
   } else {
-    res <- curl::curl_fetch_memory(url, handle)
+    res <- curl::curl_fetch_memory(req$url, handle)
     body <- res$content
   }
 
@@ -55,14 +54,13 @@ req_fetch <- function(req, path = NULL, handle = NULL) {
 #' req("http://httpbin.org/stream-bytes/100000") %>%
 #'   req_stream(show_bytes, buffer_kb = 32)
 req_stream <- function(req, callback, timeout_sec = Inf, buffer_kb = 64) {
-  url <- req_url_get(req)
   handle <- req_handle(req)
   callback <- as_function(callback)
 
   stopifnot(is.numeric(timeout_sec), timeout_sec > 0)
   stop_time <- Sys.time() + timeout_sec
 
-  stream <- curl::curl(url, handle = handle)
+  stream <- curl::curl(req$url, handle = handle)
   open(stream, "rb")
   withr::defer(close(stream))
 

R/req-url.R

@@ -1,27 +1,60 @@
-
-req_query_set <- function(req, ...) {
-  query <- list2(...)
-  req$url$query <- utils::modifyList(req$url$query, query)
+#' Modify the request URL
+#'
+#' @description
+#' * `req_url()` replaces the entire url
+#' * `req_url_query()` modifies the components of the query
+#' * `req_url_path()` modifies the path
+#' * `req_url_path_append()` adds to the path
+#'
+#' @inheritParams req_fetch
+#' @param url New URL; completely replaces existing.
+#' @return A modified HTTP [req]uest.
+#' @export
+#' @examples
+#' req <- req("http://example.com")
+#'
+#' # Change url components
+#' req %>%
+#'   req_url_path_append("a") %>%
+#'   req_url_path_append("b") %>%
+#'   req_url_path_append("search.html") %>%
+#'   req_url_query(q = "the cool ice")
+#'
+#' # Change complete url
+#' req %>%
+#'   req_url("http://google.com")
+req_url <- function(req, url) {
+  if (inherits(url, "url")) {
+    # Temporary fudging
+    url <- httr::build_url(url)
+  }
+  req$url <- url
   req
 }
 
-
-req_url_get <- function(req) {
-  httr::build_url(req$url)
+#' @export
+#' @rdname req_url
+#' @param ... Name-value pairs that provide query parameters.
+req_url_query <- function(req, ...) {
+  url <- httr::parse_url(req$url)
+  url$query <- modify_list(url$query, ...)
+  req_url(req, url)
 }
 
+#' @export
+#' @rdname req_url
+#' @param path Path to replace or append to existing path.
+req_url_path <- function(req, path) {
+  url <- httr::parse_url(req$url)
+  url$path <- path
 
-req_url_set <- function(req, url) {
-  req$url <- httr::parse_url(url)
-  req
+  req_url(req, url)
 }
 
-req_path_set <- function(req, path) {
-  req$url$path <- path
-  req
-}
-
-req_path_append <- function(req, path) {
-  req$url$path <- paste0(req$url$path, "/", path)
-  req
+#' @export
+#' @rdname req_url
+req_url_path_append <- function(req, path) {
+  url <- httr::parse_url(req$url)
+  url$path <- paste0(url$path, "/", path)
+  req_url(req, url)
 }

R/req.R

@@ -20,7 +20,7 @@ req <- function(base_url) {
 #' @export
 print.httr2_request <- function(x, ...) {
   cli::cli_text("{.cls {class(x)}}")
-  cli::cli_text("{.field URL}: {req_url_get(x)}")
+  cli::cli_text("{.field URL}: {x$url}")
 
   bullets_with_header("Headers:", x$headers)
   bullets_with_header("Options:", x$options)
@@ -30,7 +30,9 @@ print.httr2_request <- function(x, ...) {
 }
 
 new_request <- function(url, headers = list(), body = list(), fields = list(), options = list()) {
-  url <- httr::parse_url(url)
+  if (!is_string(url)) {
+    abort("`url` must be a string")
+  }
 
   structure(
     list(

R/utils.R

@@ -6,3 +6,15 @@ bullets_with_header <- function(header, x) {
   cli::cli_text("{.strong {header}}")
   cli::cli_li("{.field {names(x)}}: {x}")
 }
+
+modify_list <- function(x, ...) {
+  dots <- list2(...)
+  if (length(dots) == 0) return(x)
+
+  if (!is_named(dots)) {
+    abort("All components of ... must be named")
+  }
+  x[names(dots)] <- dots
+  x
+}
+

tests/testthat/_snaps/req.md

@@ -4,7 +4,7 @@
       req("https://r-project.org")
     Message <cliMessage>
       <httr2_request>
-      URL: https://r-project.org/
+      URL: https://r-project.org
       Headers:
       * Accept: application/json, text/xml, application/xml, */*
       Options:

tests/testthat/_snaps/resp.md

@@ -4,7 +4,7 @@
       req_fetch(req("https://httpbin.org"))
     Message <cliMessage>
       <httr2_response>
-      URL: https://httpbin.org/
+      URL: https://httpbin.org
       Status: 200 OK
       Content-Type: text/html
       Body: In memory (9593 bytes)

tests/testthat/test-req-url.R

@@ -0,0 +1,14 @@
+test_that("can modify url in various ways", {
+  req <- req("http://example.com")
+
+  expect_equal(req_url(req, "http://foo.com:10")$url, "http://foo.com:10")
+
+  expect_equal(req_url_path(req, "index.html")$url, "http://example.com/index.html")
+  req2 <- req %>%
+    req_url_path_append("a") %>%
+    req_url_path_append("index.html")
+  expect_equal(req2$url, "http://example.com/a/index.html")
+
+  req2 <- req %>% req_url_query(a = 1, b = 2)
+  expect_equal(req2$url, "http://example.com/?a=1&b=2")
+})