Allow vector values in fields

Closes #130. Fixes #127.

NEWS.md

@@ -1,5 +1,9 @@
 # rvest (development version)
 
+* `form_set()` can now accept character vectors allowing you to select
+  multiple checkboxes in a set or select multiple values from a multi-`<select>`
+  (#127, with help from @juba).
+
 * Objects within a `html_form()` now have class `rvest_field`, instead of a
   variety of classes that were lacking the `rvest_` prefix.
 

R/form-submit.R

@@ -14,6 +14,9 @@
 #' @param form An [html_form()].
 #' @param ... <[`dynamic-dots`][rlang::dyn-dots]> Name-value pairs giving
 #'   fields to modify.
+#'
+#'   Provide a character vector to set multiple checkboxes in a set or
+#'   select multiple values from a multi-select.
 #' @return `set_values()` returns an updated form object;
 #'   `submit_form()` returns the parsed HTML response (or an error if the
 #'   HTTP request fails).
@@ -70,13 +73,13 @@ form_submit <- function(form, session, submit = NULL, ...) {
   if (request$method == "POST") {
     request_POST(session,
       url = request$url,
-      body = as.list(request$values),
+      body = request$values,
       encode = request$enctype
     )
   } else {
     request_GET(session,
       url = request$url,
-      query = as.list(request$values)
+      query = request$values
     )
   }
 }
@@ -120,11 +123,17 @@ submission_build_values <- function(form, submit = NULL) {
   fields <- form$fields
   submit <- submission_find_submit(fields, submit)
   entry_list <- c(Filter(Negate(is_button), fields), list(submit))
-  entry_list <- Filter(is_entry, entry_list)
+  entry_list <- Filter(function(x) !is.null(x$name), entry_list)
+
+  if (length(entry_list) == 0) {
+    return(list())
+  }
 
-  values <- map_chr(entry_list, "[[", "value")
-  names(values) <- map_chr(entry_list, "[[", "name")
-  values
+  values <- lapply(entry_list, function(x) as.character(x$value))
+  names <- map_chr(entry_list, "[[", "name")
+
+  out <- set_names(unlist(values, use.names = FALSE), rep(names, lengths(values)))
+  as.list(out)
 }
 
 submission_find_submit <- function(fields, idx) {
@@ -157,11 +166,6 @@ submission_find_submit <- function(fields, idx) {
   }
 }
 
-# https://html.spec.whatwg.org/multipage/form-control-infrastructure.html#constructing-the-form-data-set
-is_entry <- function(x) {
-  length(x$value) == 1 && !is.null(x$name)
-}
-
 is_button <- function(x) {
   tolower(x$type) %in% c("submit", "image", "button")
 }

R/utils.R

@@ -20,10 +20,10 @@ pluck <- function(x, i, type) {
 }
 
 map_chr <- function(.x, .f, ...) {
-  vapply(.x, .f, ..., FUN.VALUE = character(1))
+  vapply(.x, .f, ..., FUN.VALUE = character(1), USE.NAMES = FALSE)
 }
 map_lgl <- function(.x, .f, ...) {
-  vapply(.x, .f, ..., FUN.VALUE = logical(1))
+  vapply(.x, .f, ..., FUN.VALUE = logical(1), USE.NAMES = FALSE)
 }
 
 str_trunc <- function(x, width) {

tests/testthat/test-form-submit.R

@@ -51,9 +51,10 @@ test_that("works as expected in simple case", {
   sub <- submission_build(form, "clickMe", "http://here.com")
   expect_equal(sub$method, "POST")
   expect_equal(sub$url, "http://here.com/test-path")
-  expect_equal(sub$values, c(x = "1"))
+  expect_equal(sub$values, list(x = "1"))
 })
 
+
 test_that("useful feedback on invalid forms", {
   html <- minimal_html("test", "<form></form>")
   form <- html_form(html)[[1]]
@@ -64,6 +65,22 @@ test_that("useful feedback on invalid forms", {
   expect_snapshot(x <- submission_build(form, NULL, base_url = "http://"))
 })
 
+test_that("can handle multiple values", {
+  html <- minimal_html("test", '
+    <form method="post" action="/">
+    <input type="text" name="x">
+    <input type="text" name="y">
+    </form>
+  ')
+  form <- html_form(html)[[1]]
+  form <- form_set(form, x = c("1", "2", "3"), y = character())
+
+  expect_equal(
+    submission_build_values(form),
+    list(x = "1", x = "2", x = "3")
+  )
+})
+
 test_that("handles multiple buttons", {
   html <- minimal_html("test", '
     <form action="/">
@@ -75,10 +92,10 @@ test_that("handles multiple buttons", {
 
   # Messages when picking automatically
   expect_snapshot(vals <- submission_build_values(form, NULL))
-  expect_equal(vals, c(one = "1"))
+  expect_equal(vals, list(one = "1"))
 
-  expect_equal(submission_build_values(form, "two"), c(two = "2"))
-  expect_equal(submission_build_values(form, 2L), c(two = "2"))
+  expect_equal(submission_build_values(form, "two"), list(two = "2"))
+  expect_equal(submission_build_values(form, 2L), list(two = "2"))
 
   # Useful failure messages
   expect_snapshot(submission_build_values(form, 3L), error = TRUE)
@@ -96,7 +113,7 @@ test_that("handles no buttons", {
 
   expect_equal(
     submission_build_values(form),
-    c(x = "1")
+    list(x = "1")
   )
 })
 
@@ -129,4 +146,3 @@ test_that("can submit using three primary techniques", {
     show_response(form_submit(form, session))
   })
 })
-