Add support for relative urls (#610)

Add `base_url` parameter to `url_parse()` and implement new `req_url_relative()`.

Fixes #449

NAMESPACE

@@ -95,6 +95,7 @@ export(req_url)
 export(req_url_path)
 export(req_url_path_append)
 export(req_url_query)
+export(req_url_relative)
 export(req_user_agent)
 export(req_verbose)
 export(request)

NEWS.md

@@ -1,5 +1,7 @@
 # httr2 (development version)
 
+* New `req_url_relative()` for constructing relative urls (#449).
+* `url_parse()` gains `base_url` argument so you can also use it to parse relative URLs (#449).
 * `url_parse()` now uses `curl::curl_parse_url()` which is much faster and more correct (#577).
 * `req_retry()` now defaults to `max_tries = 2` with a message.
   Set to `max_tries = 1` to disable retries.

R/req-url.R

@@ -31,6 +31,11 @@
 #' req |>
 #'   req_url("http://google.com")
 #'
+#' # Use a relative url
+#' req <- request("http://example.com/a/b/c")
+#' req |> req_url_relative("..")
+#' req |> req_url_relative("/d/e/f")
+#'
 #' # Use .multi to control what happens with vector parameters:
 #' req |> req_url_query(id = 100:105, .multi = "comma")
 #' req |> req_url_query(id = 100:105, .multi = "explode")
@@ -47,6 +52,15 @@ req_url <- function(req, url) {
   req
 }
 
+#' @export
+#' @rdname req_url
+req_url_relative <- function(req, url) {
+  check_request(req)
+
+  new_url <- url_parse(url, base_url = req$url)
+  req_url(req, url_build(new_url))
+}
+
 #' @export
 #' @rdname req_url
 #' @param .multi Controls what happens when an element of `...` is a vector

R/url.R

@@ -6,6 +6,7 @@
 #'
 #' @param url For `url_parse()` a string to parse into a URL;
 #'   for `url_build()` a URL to turn back into a string.
+#' @param base_url Use this as a parent, if `url` is a relative URL.
 #' @returns
 #' * `url_build()` returns a string.
 #' * `url_parse()` returns a URL: a S3 list with class `httr2_url`
@@ -18,15 +19,20 @@
 #' url_parse("http://google.com:80/?a=1&b=2")
 #' url_parse("http://[email protected]:80/path;test?a=1&b=2#40")
 #'
+#' # You can parse a relative URL if you also provide a base url
+#' url_parse("foo", "http://google.com/bar/")
+#' url_parse("..", "http://google.com/bar/")
+#'
 #' url <- url_parse("http://google.com/")
 #' url$port <- 80
 #' url$hostname <- "example.com"
 #' url$query <- list(a = 1, b = 2, c = 3)
 #' url_build(url)
-url_parse <- function(url) {
+url_parse <- function(url, base_url = NULL) {
   check_string(url)
+  check_string(base_url, allow_null = TRUE)
 
-  curl <- curl::curl_parse_url(url)
+  curl <- curl::curl_parse_url(url, baseurl = base_url)
 
   parsed <- list(
     scheme = curl$scheme,

tests/testthat/test-req-url.R

@@ -96,6 +96,12 @@ test_that("can opt-out of query escaping", {
   expect_equal(req_url_query(req, a = I(","))$url, "http://example.com/?a=,")
 })
 
+test_that("can construct relative urls", {
+  req <- request("http://example.com/a/b/c.html")
+  expect_equal(req_url_relative(req, ".")$url, "http://example.com/a/b/")
+  expect_equal(req_url_relative(req, "..")$url, "http://example.com/a/")
+  expect_equal(req_url_relative(req, "/d/e/f")$url, "http://example.com/d/e/f")
+})
 # explode -----------------------------------------------------------------
 
 test_that("explode handles expected inputs", {

tests/testthat/test-url.R

@@ -21,6 +21,14 @@ test_that("can round trip urls", {
   expect_equal(map(urls, ~ url_build(url_parse(.x))), urls)
 })
 
+test_that("can parse relative urls", {
+  base <- "http://example.com/a/b/c/"
+  expect_equal(url_parse("d", base)$path, "/a/b/c/d")
+  expect_equal(url_parse("..", base)$path, "/a/b/")
+
+  expect_equal(url_parse("//archive.org", base)$scheme, "http")
+})
+
 test_that("can print all url details", {
   expect_snapshot(
     url_parse("http://user:[email protected]:80/path?a=1&b=2&c={1{2}3}#frag")