diff --git a/NEWS.md b/NEWS.md index 7655ee74..28017c27 100644 --- a/NEWS.md +++ b/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 diff --git a/R/tag_query.R b/R/tag_query.R index 9ac07982..3856de8d 100644 --- a/R/tag_query.R +++ b/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) } }) diff --git a/man/tagQuery.Rd b/man/tagQuery.Rd index 2480baf3..64463f53 100644 --- a/man/tagQuery.Rd +++ b/man/tagQuery.Rd @@ -85,9 +85,19 @@ ancestor tag (including itself) satisfying a \code{cssSelector}. If \subsection{Custom filter}{ \itemize{ -\item \verb{$filter(fn)}: Filter the selected tags to those for which \code{fn(x, i)} returns \code{TRUE}. In addition to an R function with two arguments -(the selected tag \code{x} and the index \code{i}), \code{fn} may also be a valid -CSS selector. +\item \verb{$filter(fn)}: Filter the selected tags to those for which +\code{fn(x, i)} returns \code{TRUE}. In addition to an R function with two +arguments (the selected tag \code{x} and the index \code{i}), \code{fn} may also +be a valid CSS selector. +} +} + +\subsection{Matching}{ +\itemize{ +\item \verb{$matches(fn)}: For each of the selected tags, return \code{TRUE} if +\code{fn(el)} returns \code{TRUE}. In addition to an R function with two +arguments (the selected tag \code{x} and the index \code{i}), \code{fn} may also +be a valid CSS selector. } } diff --git a/tests/testthat/test-tag-query.R b/tests/testthat/test-tag-query.R index d0f482ed..a84fc8bf 100644 --- a/tests/testthat/test-tag-query.R +++ b/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) diff --git a/vignettes/tagQuery.Rmd b/vignettes/tagQuery.Rmd index 94d463d5..5fb01dff 100644 --- a/vignettes/tagQuery.Rmd +++ b/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()`: