xml_child() function to make selection easier

Fixes #23

NAMESPACE

@@ -107,6 +107,7 @@ export(xml_add_child)
 export(xml_add_sibling)
 export(xml_attr)
 export(xml_attrs)
+export(xml_child)
 export(xml_children)
 export(xml_contents)
 export(xml_find_all)

NEWS.md

@@ -3,6 +3,9 @@
 * `read_xml()` and `read_html()` methods added for `httr::response()` objects.
   (@jimhester, #63, #93)
 
+* `xml_child()` function to make selecting children a little easier
+  (@jimhester, #23, #94)
+
 * `xml_find_one()` has been deprecated in favor of `xml_find_first()`
   (@jimhester, #58, #92)
 

R/xml_children.R

@@ -4,11 +4,15 @@
 #' all nodes. \code{xml_length} returns the number of children.
 #' \code{xml_parent} returns the parent node, \code{xml_parents}
 #' returns all parents up to the root. \code{xml_siblings} returns all nodes
-#' at the same level.
+#' at the same level. \code{xml_child} makes it easy to specify a specific
+#' child to return.
 #'
 #' @inheritParams xml_name
 #' @param only_elements For \code{xml_length}, should it count all children,
 #'   or just children that are elements (the default)?
+#' @param search For \code{xml_child}, either the child number to return (by
+#'   position), or the name of the child node to return. If there are multiple
+#'   child nodes with the same name, the first will be returned
 #' @return A node or nodeset (possibly empty). Results are always de-duplicated.
 #' @export
 #' @examples
@@ -28,10 +32,31 @@
 #'
 #' xml_length(x)
 #' xml_length(x, only_elements = FALSE)
+#'
+#' # xml_child makes it easier to select specific children
+#' xml_child(x)
+#' xml_child(x, 2)
+#' xml_child(x, "baz")
 xml_children <- function(x) {
   nodeset_apply(x, node_children)
 }
 
+#' @export
+#' @rdname xml_children
+xml_child <- function(x, search = 1, ns = xml_ns(x)) {
+  if (length(search) != 1) {
+    stop("`search` must be of length 1", call. = FALSE)
+  }
+
+  if (is.numeric(search)) {
+    xml_children(x)[[search]]
+  } else if (is.character(search)) {
+    xml_find_first(x, xpath = paste0("./", search), ns = ns)
+  } else {
+    stop("`search` must be `numeric` or `character`", call. = FALSE)
+  }
+}
+
 #' @export
 #' @rdname xml_children
 xml_contents <- function(x) {

tests/testthat/test-xml_children.R

@@ -0,0 +1,24 @@
+context("xml_children")
+
+x <- read_xml("<foo> <bar><boo /></bar> <baz/> </foo>")
+
+test_that("xml_child() returns the proper child", {
+  expect_equal(xml_child(x), xml_children(x)[[1L]])
+
+  expect_equal(xml_child(x, 2), xml_children(x)[[2L]])
+})
+
+test_that("xml_child() returns child by name", {
+  expect_equal(xml_child(x, "baz"), xml_find_first(x, "./baz"))
+})
+
+test_that("xml_child() errors if more than one search is given", {
+  expect_error(xml_child(x, 1:2), "`search` must be of length 1")
+})
+
+test_that("xml_child() errors if search is not numeric or character", {
+  expect_error(xml_child(x, TRUE), "`search` must be `numeric` or `character`")
+  expect_error(xml_child(x, as.factor("test")), "`search` must be `numeric` or `character`")
+  expect_error(xml_child(x, raw(1)), "`search` must be `numeric` or `character`")
+  expect_error(xml_child(x, list(1)), "`search` must be `numeric` or `character`")
+})