Make it easier to generate repeated query parameters

NEWS.md

@@ -1,5 +1,11 @@
 # httr2 (development version)
 
+* `req_url_query()` gains a `.multi` parameter that controls what happens when
+  you supply multiple values in a vector. The default will continue to error 
+  but you can use `.multi = "comma"` to separate with commas, `"pipe"` to 
+  separate with `|`, and `"explode"` to generate one parameter for each 
+  value (e.g. `?a=1&a=2`) (#350).
+
 * The httr2 examples now only run on R 4.2 and later so that we can use
   the base pipe and lambda syntax (#345).
 

R/req-url.R

@@ -9,10 +9,9 @@
 #' @inheritParams req_perform
 #' @param url New URL; completely replaces existing.
 #' @param ... For `req_url_query()`: <[`dynamic-dots`][rlang::dyn-dots]>
-#'   Name-value pairs that provide query parameters. Each value must be either
-#'   a length-1 atomic vector (which is automatically escaped) or `NULL` (which
-#'   is silently dropped). If you want to opt out of escaping, wrap strings in
-#'   `I()`.
+#'   Name-value pairs that define query parameters. Each value must be either
+#'   an atomic vector or `NULL` (which removes the corresponding parameters).
+#'   If you want to opt out of escaping, wrap strings in `I()`.
 #'
 #'   For `req_url_path()` and `req_url_path_append()`: A sequence of path
 #'   components that will be combined with `/`.
@@ -32,6 +31,10 @@
 #' req |>
 #'   req_url("http://google.com")
 #'
+#' # 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")
+#'
 #' # If you have query parameters in a list, use !!!
 #' params <- list(a = "1", b = "2")
 #' req |>
@@ -46,15 +49,80 @@ req_url <- function(req, url) {
 
 #' @export
 #' @rdname req_url
-req_url_query <- function(.req, ...) {
+#' @param .multi Controls what happens when an element of `...` is a vector
+#'   containing multiple values:
+#'
+#'   * `"error"`, the default, throws an error.
+#'   * `"comma"`, separates values with a `,`, e.g. `?x=1,2`.
+#'   * `"pipe"`, separates values with a `|`, e.g. `?x=1|2`.
+#'   * `"explode"`, turns each element into its own parameter, e.g. `?x=1&x=2`.
+#'
+#'   If none of these functions work, you can alternatively supply a function
+#'   that takes a character vector and returns a string.
+req_url_query <- function(.req,
+                          ...,
+                          .multi = c("error", "comma", "pipe", "explode")) {
   check_request(.req)
+  if (is.function(.multi)) {
+    multi <- .multi
+  } else {
+    multi <- arg_match(.multi)
+  }
 
-  url <- url_parse(.req$url)
-  url$query <- modify_list(url$query, ...)
+  dots <- list2(...)
+
+  type_ok <- map_lgl(dots, function(x) is_atomic(x) || is.null(x))
+  if (any(!type_ok)) {
+    cli::cli_abort(
+      "All elements of {.code ...} must be either an atomic vector or NULL."
+    )
+  }
 
+  n <- lengths(dots)
+  if (any(n > 1)) {
+    if (is.function(multi)) {
+      dots[n > 1] <- lapply(dots[n > 1], format_query_param)
+      dots[n > 1] <- lapply(dots[n > 1], multi)
+      dots[n > 1] <- lapply(dots[n > 1], I)
+    } else if (multi == "comma") {
+      dots[n > 1] <- lapply(dots[n > 1], format_query_param)
+      dots[n > 1] <- lapply(dots[n > 1], paste0, collapse = ",")
+      dots[n > 1] <- lapply(dots[n > 1], I)
+    } else if (multi == "pipe") {
+      dots[n > 1] <- lapply(dots[n > 1], format_query_param)
+      dots[n > 1] <- lapply(dots[n > 1], paste0, collapse = "|")
+      dots[n > 1] <- lapply(dots[n > 1], I)
+    } else if (multi == "explode") {
+      dots <- explode(dots)
+    } else if (multi == "error") {
+      cli::cli_abort(c(
+        "All vector elements of {.code ...} must be length 1.",
+        i = "Use {.arg .multi} to choose a strategy for handling vectors."
+      ))
+    }
+  }
+  # Force query generation to bubble up errors
+  query_build(dots)
+
+  url <- url_parse(.req$url)
+  url$query <- modify_list(url$query, !!!dots)
   req_url(.req, url_build(url))
 }
 
+explode <- function(x) {
+  expanded <- map(x, function(x) {
+    if (is.null(x)) {
+      list(NULL)
+    } else {
+      map(seq_along(x), function(i) x[i])
+    }
+  })
+  stats::setNames(
+    unlist(expanded, recursive = FALSE, use.names = FALSE),
+    rep(names(x), lengths(expanded))
+  )
+}
+
 #' @export
 #' @rdname req_url
 req_url_path <- function(req, ...) {

R/url.R

@@ -186,19 +186,20 @@ query_build <- function(x, error_call = caller_env()) {
     )
   }
 
-  is_double <- map_lgl(x, is.double)
-  x[is_double] <- map_chr(x[is_double], format, scientific = FALSE)
-
   names <- curl::curl_escape(names(x))
-  values <- map_chr(x, url_escape)
+  values <- map_chr(x, format_query_param, error_call = error_call)
 
   paste0(names, "=", values, collapse = "&")
 }
 
-url_escape <- function(x) {
+
+format_query_param <- function(x, error_call = caller_env()) {
   if (inherits(x, "AsIs")) {
-    x
-  } else {
-    curl::curl_escape(x)
+    x <- unclass(x)
+    check_string(x, call = error_call, arg = I("Escaped query value"))
+    return(x)
   }
+
+  x <- format(x, scientific = FALSE)
+  curl::curl_escape(x)
 }

tests/testthat/_snaps/req-url.md

@@ -1,16 +1,28 @@
-# query components must be length 1
+# can handle multi query params
 
     Code
-      req <- request("http://example.com/")
-      req %>% req_url_query(a = mean)
+      req_url_query_multi("error")
+    Condition
+      Error in `req_url_query()`:
+      ! All vector elements of `...` must be length 1.
+      i Use `.multi` to choose a strategy for handling vectors.
+
+# errors are forwarded correctly
+
+    Code
+      req %>% req_url_query(a = I(1))
+    Condition
+      Error in `req_url_query()`:
+      ! Escaped query value must be a single string, not the number 1.
+    Code
+      req %>% req_url_query(a = 1:2)
     Condition
-      Error in `url_build()`:
-      ! Query parameters must be length 1 atomic vectors.
-      * Problems: "a".
+      Error in `req_url_query()`:
+      ! All vector elements of `...` must be length 1.
+      i Use `.multi` to choose a strategy for handling vectors.
     Code
-      req %>% req_url_query(a = letters)
+      req %>% req_url_query(a = mean)
     Condition
-      Error in `url_build()`:
-      ! Query parameters must be length 1 atomic vectors.
-      * Problems: "a".
+      Error in `req_url_query()`:
+      ! All elements of `...` must be either an atomic vector or NULL.
 

tests/testthat/_snaps/url.md

@@ -38,3 +38,11 @@
       ! Query parameters must be length 1 atomic vectors.
       * Problems: "x" and "y".
 
+# can't opt out of escaping non strings
+
+    Code
+      format_query_param(I(1))
+    Condition
+      Error:
+      ! Escaped query value must be a single string, not the number 1.
+

tests/testthat/test-req-url.R

@@ -52,6 +52,31 @@ test_that("can set query params", {
   expect_equal(req_url_query(req, !!!list(a = 1, a = 2))$url, "http://example.com/?a=1&a=2")
 })
 
+test_that("can handle multi query params", {
+  req <- request("http://example.com/")
+
+  req_url_query_multi <- function(multi) {
+    req_url_query(req, a = 1:2, .multi = multi)$url
+  }
+
+  expect_snapshot(req_url_query_multi("error"), error = TRUE)
+
+  expect_equal(req_url_query_multi("explode"), "http://example.com/?a=1&a=2")
+  expect_equal(req_url_query_multi("comma"), "http://example.com/?a=1,2")
+  expect_equal(req_url_query_multi("pipe"), "http://example.com/?a=1|2")
+  expect_equal(req_url_query_multi(function(x) "X"), "http://example.com/?a=X")
+})
+
+test_that("errors are forwarded correctly", {
+  req <- request("http://example.com/")
+  expect_snapshot(error = TRUE, {
+    req %>% req_url_query(a = I(1))
+    req %>% req_url_query(a = 1:2)
+    req %>% req_url_query(a = mean)
+  })
+
+})
+
 test_that("empty query doesn't affect url", {
   req <- request("http://example.com/")
   expect_equal(req_url_query(req)$url, "http://example.com/")
@@ -71,10 +96,11 @@ test_that("can opt-out of query escaping", {
   expect_equal(req_url_query(req, a = I(","))$url, "http://example.com/?a=,")
 })
 
-test_that("query components must be length 1", {
-  expect_snapshot(error = TRUE, {
-    req <- request("http://example.com/")
-    req %>% req_url_query(a = mean)
-    req %>% req_url_query(a = letters)
-  })
+# explode -----------------------------------------------------------------
+
+test_that("explode handles expected inputs", {
+  expect_equal(
+    explode(list(a = NULL, b = 1, c = 2:3)),
+    list(a = NULL, b = 1, c = 2, c = 3)
+  )
 })

tests/testthat/test-url.R

@@ -64,17 +64,33 @@ test_that("empty queries become NULL", {
   expect_equal(query_parse(""), NULL)
 })
 
-test_that("doubles never use scientific notation", {
-  expect_equal(query_build(list(x = 1e9)), "x=1000000000")
-})
-
-test_that("can opt out of escaping", {
-  expect_equal(query_build(list(x = I(","))), "x=,")
-})
-
 test_that("validates inputs", {
   expect_snapshot(error = TRUE, {
     query_build(1:3)
     query_build(list(x = 1:2, y = 1:3))
   })
 })
+
+# format_query_param ------------------------------------------------------
+
+test_that("handles all atomic vectors", {
+  expect_equal(format_query_param(NA), "NA")
+  expect_equal(format_query_param(TRUE), "TRUE")
+  expect_equal(format_query_param(1L), "1")
+  expect_equal(format_query_param(1.3), "1.3")
+  expect_equal(format_query_param("x"), "x")
+  expect_equal(format_query_param(" "), "%20")
+})
+
+
+test_that("doubles don't use scientific notation", {
+  expect_equal(format_query_param(1e9), "1000000000")
+})
+
+test_that("can opt out of escaping", {
+  expect_equal(format_query_param(I(",")), ",")
+})
+
+test_that("can't opt out of escaping non strings", {
+  expect_snapshot(format_query_param(I(1)), error = TRUE)
+})