Implement tagQuery()$matches(fn)

NEWS.md

@@ -1,6 +1,8 @@
 # htmltools 0.5.5.9000
 
+## New Features
 
+* Added new `tagQuery()` method `$matches(fn)`. For each of the selected `tagQuery()` tags, return `TRUE` if `fn(el)` returns `TRUE`. In addition to an R function with two arguments (the selected tag `x` and the index `i`), `fn` may also be a valid CSS selector. (#351)
 
 # htmltools 0.5.5
 

R/tag_query.R

@@ -633,15 +633,24 @@ tagQuery_ <- function(
         },
         #' ### Custom filter
         #'
-        #' * `$filter(fn)`: Filter the selected tags to those for which `fn(x,
-        #' i)` returns `TRUE`. In addition to an R function with two arguments
-        #' (the selected tag `x` and the index `i`), `fn` may also be a valid
-        #' CSS selector.
+        #' * `$filter(fn)`: Filter the selected tags to those for which
+        #'   `fn(x, i)` returns `TRUE`. In addition to an R function with two
+        #'   arguments (the selected tag `x` and the index `i`), `fn` may also
+        #'   be a valid CSS selector.
         filter = function(fn) {
-          newSelected <- tagQueryFindFilter(selected_, fn)
+          newSelected <- tagQueryFilter(selected_, fn)
           rebuild_()
           newTagQuery(newSelected)
         },
+        #' ### Matching
+        #'
+        #' * `$matches(fn)`: For each of the selected tags, return `TRUE` if
+        #'  `fn(el)` returns `TRUE`. In addition to an R function with two
+        #'   arguments (the selected tag `x` and the index `i`), `fn` may also
+        #'   be a valid CSS selector.
+        matches = function(fn) {
+          tagQueryMatches(selected_, fn)
+        },
         #' ### Length
         #'
         #' * `$length()`: Number of tags that have been selected.
@@ -953,6 +962,11 @@ walkIRev <- function(.x, .f, ...) {
   NULL
 }
 
+# Actually return the iterated results
+MapI <- function(.x, .f, ..., USE.NAMES = FALSE) {
+  Map(.x, seq_along(.x), f = .f, ..., USE.NAMES = USE.NAMES)
+}
+
 
 # Return function that will verify elements before performing `func(els, fn)`
 selectedWalkGen <- function(func) {
@@ -986,6 +1000,7 @@ tagQueryWalk <- selectedWalkGen(walk)
 # selectedWalkRev <- selectedWalkGen(walkRev)
 selectedWalkI <- selectedWalkGen(walkI)
 selectedWalkIRev <- selectedWalkGen(walkIRev)
+selectedMapI <- selectedWalkGen(MapI)
 tagQueryLapply <- selectedWalkGen(lapply)
 
 
@@ -1388,7 +1403,19 @@ tagQueryFindSiblings <- function(els, cssSelector = NULL) {
 
 # Filter the selected elements using a function
 # The answer of `fn(el, i)` should work in an `if` block
-tagQueryFindFilter <- function(els, fn) {
+tagQueryMatches <- function(els, fn) {
+  if (is.character(fn)) {
+    selector <- cssSelectorToSelector(fn)
+    fn <- function(el, i) {
+      elMatchesSelector(el, selector)
+    }
+  }
+  validateFnCanIterate(fn)
+  vapply(selectedMapI(els, fn), isTRUE, logical(1))
+}
+# Filter the selected elements using a function
+# The answer of `fn(el, i)` should work in an `if` block
+tagQueryFilter <- function(els, fn) {
   if (is.character(fn)) {
     selector <- cssSelectorToSelector(fn)
     fn <- function(el, i) {
@@ -1399,7 +1426,7 @@ tagQueryFindFilter <- function(els, fn) {
 
   filterStack <- envirStackUnique()
   selectedWalkI(els, function(el, i) {
-    if (fn(el, i)) {
+    if (isTRUE(fn(el, i))) {
       filterStack$push(el)
     }
   })

tests/testthat/test-tag-query.R

@@ -183,8 +183,58 @@ test_that("tagQuery()$find()", {
   expect_equal_tags(x$selectedTags(), tagListPrintAsList(p("text2")))
 })
 
+test_that("tagQuery()$matches()", {
+  x <- tagQuery(
+    div(
+      span(1, class = "first"),
+      span(2, class = "second"),
+      span(3, class = "third"),
+      span(4, class = "fourth"),
+      span(5, class = "fifth")
+    )
+  )
+
+  x <- x$find("span")
+  expect_length(x$selectedTags(), 5)
+
+  expect_equal(x$matches("span"), rep(TRUE, 5))
+  expect_equal(x$matches(".second"), c(FALSE, TRUE, FALSE, FALSE, FALSE))
+  expect_equal(x$matches(function(el, i) {
+    grepl("second", tagGetAttribute(el, "class"))
+  }), c(FALSE, TRUE, FALSE, FALSE, FALSE))
+
+  expect_error(x$matches("span div"), "using a simple CSS selector")
+
+  # Make sure selected tags were not altered
+  expect_length(x$selectedTags(), 5)
+
+  # Vignette example
+  (html <- tagList(div(), span()))
+  tagQ <- tagQuery(html)
+  expect_equal(tagQ$matches("span"), c(FALSE, TRUE))
+  expect_equal(
+    tagQ$matches(function(el, i) {
+      el$name == "span"
+    }),
+    c(FALSE, TRUE)
+  )
+
+  # If the value is not `TRUE`, then it is `FALSE`
+  expect_equal(
+    tagQ$matches(function(el, i) {
+      c(TRUE, TRUE)
+    }),
+    c(FALSE, FALSE)
+  )
+
+})
+
 test_that("tagQuery()$filter()", {
-  x <- tagQuery(div(span(1), span(2), span(3), span(4), span(5)))
+  x <- tagQuery(div(span(1), span(2, class = "second"), span(3), span(4), span(5)))
+
+  y <- x$find("span")
+  y <- y$filter(".second")
+  expect_equal_tags(y$selectedTags(), tagListPrintAsList(span(2, class = "second")))
 
   x <- x$find("span")
   expect_length(x$selectedTags(), 5)

vignettes/tagQuery.Rmd

@@ -120,6 +120,15 @@ tagQ$
   selectedTags()
 ```
 
+To test your selected tags against a CSS selector, you can use `$matches()` with a CSS selector string:
+
+```{r}
+(html <- tagList(div(), span()))
+tagQ <- tagQuery(html)
+tagQ$matches("span")
+tagQ$matches(function(el, i) { el$name == "span" })
+```
+
 ### Reset
 
 To reset the set of selected tags to the root tag, use `$resetSelected()`: