Use cli messaging

R/as_xml_document.R

@@ -40,7 +40,7 @@ as_xml_document.response <- read_xml.response
 #' @export
 as_xml_document.list <- function(x, ...) {
   if (length(x) > 1) {
-    abort("Root nodes must be of length 1")
+    cli::cli_abort("Root nodes must be of length 1.")
   }
 
 

R/paths.R

@@ -55,7 +55,7 @@ zipfile <- function(path, open = "r") {
   file <- files$Name[[1]]
 
   if (nrow(files) > 1) {
-    message("Multiple files in zip: reading '", file, "'")
+    cli::cli_inform("Multiple files in zip: reading {.file {file}}")
   }
 
   unz(path, file, open = open)

R/utils.R

@@ -42,7 +42,7 @@ s_quote <- function(x) paste0("'", x, "'")
 # Similar to match.arg, but returns character() with NULL or empty input and
 # errors if any of the inputs are not found (fixing
 # https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16659)
-parse_options <- function(arg, options) {
+parse_options <- function(arg, options, error_call = caller_env()) {
   if (is.numeric(arg)) {
     return(as.integer(arg))
   }
@@ -54,15 +54,13 @@ parse_options <- function(arg, options) {
   # set duplicates.ok = TRUE so any duplicates are counted differently than
   # non-matches, then take only unique results
   i <- pmatch(arg, names(options), duplicates.ok = TRUE)
-  if (any(is.na(i))) {
-    stop(
-      sprintf(
-        "`options` %s is not a valid option, should be one of %s",
-        s_quote(arg[is.na(i)][1L]),
-        paste(s_quote(names(options)), collapse = ", ")
-      ),
-      call. = FALSE
-    )
+  if (anyNA(i)) {
+    cli::cli_abort(c(
+      x = "{.arg options} {.val {arg[is.na(i)][1L]}} is not a valid option.",
+      i = "Valid options are one of {.or {.val {names(options)}}}.",
+      i = "See {.help [read_html](xml2::read_html)} for all options."
+    ),
+    call = error_call)
   }
   sum(options[unique(i)])
 }

R/xml_missing.R

@@ -28,7 +28,7 @@ as.character.xml_missing <- function(x, ...) {
 `[.xml_missing` <- function(x, i, ...) x
 
 #' @export
-`[[.xml_missing` <- function(x, i, ...) if (i == 1L) x else abort("subscript out of bounds")
+`[[.xml_missing` <- function(x, i, ...) if (i == 1L) x else cli::cli_abort("subscript out of bounds")
 
 #' @export
 is.na.xml_missing <- function(x) {

R/xml_serialize.R

@@ -72,7 +72,7 @@ xml_unserialize <- function(connection, ...) {
     }
     res <- read_xml_int(unclass(object), ...)
   } else {
-    abort("Not a serialized xml2 object")
+    cli::cli_abort("Not a serialized xml2 object.")
   }
   res
 }

R/xml_write.R

@@ -30,7 +30,7 @@ write_xml <- function(x, file, ...) {
 
 #' @export
 write_xml.xml_missing <- function(x, file, ...) {
-  abort("Missing data cannot be written")
+  cli::cli_abort("Missing data cannot be written.")
 }
 
 #' @rdname write_xml
@@ -56,7 +56,7 @@ write_xml.xml_document <- function(x, file, ..., options = "format", encoding =
 #' @export
 write_xml.xml_nodeset <- function(x, file, ..., options = "format", encoding = "UTF-8") {
   if (length(x) != 1) {
-    abort("Can only save length 1 node sets")
+    cli::cli_abort("Can only save length 1 node sets.")
   }
 
   options <- parse_options(options, xml_save_options())
@@ -104,7 +104,7 @@ write_html <- function(x, file, ...) {
 
 #' @export
 write_html.xml_missing <- function(x, file, ...) {
-  abort("Missing data cannot be written")
+  cli::cli_abort("Missing data cannot be written.")
 }
 
 #' @rdname write_xml

tests/testthat/_snaps/xml_parse.md

@@ -2,6 +2,16 @@
 
     `x` must be a single string, not an empty character vector.
 
+# parse_options errors when given an invalid option
+
+    Code
+      read_html(test_path("lego.html.bz2"), options = "INVALID")
+    Condition
+      Error in `read_html()`:
+      x `options` "INVALID" is not a valid option.
+      i Valid options are one of "RECOVER", "NOENT", "DTDLOAD", "DTDATTR", "DTDVALID", "NOERROR", "NOWARNING", "PEDANTIC", "NOBLANKS", "SAX1", "XINCLUDE", "NONET", "NODICT", "NSCLEAN", "NOCDATA", "NOXINCNODE", "COMPACT", "OLD10", ..., "IGNORE_ENC", or "BIG_LINES".
+      i See read_html (`?xml2::read_html()`) for all options.
+
 # read_xml and read_html fail with > 1 input
 
     `x` must be a single string, not a character vector.

tests/testthat/test-xml_parse.R

@@ -26,12 +26,11 @@ test_that("read_html correctly parses malformed document", {
 test_that("parse_options errors when given an invalid option", {
   expect_error(
     parse_options("INVALID", xml_parse_options()),
-    "`options` 'INVALID' is not a valid option"
+    '`options` "INVALID" is not a valid option'
   )
 
-  expect_error(
-    read_html(test_path("lego.html.bz2"), options = "INVALID"),
-    "`options` 'INVALID' is not a valid option"
+  expect_snapshot(error = TRUE,
+    read_html(test_path("lego.html.bz2"), options = "INVALID")
   )
 
   # Empty inputs returned as 0