Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Implement tagQuery()$matches(fn) #351

Open
wants to merge 9 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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

Expand Down
41 changes: 34 additions & 7 deletions R/tag_query.R
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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) {
Expand Down Expand Up @@ -986,6 +1000,7 @@ tagQueryWalk <- selectedWalkGen(walk)
# selectedWalkRev <- selectedWalkGen(walkRev)
selectedWalkI <- selectedWalkGen(walkI)
selectedWalkIRev <- selectedWalkGen(walkIRev)
selectedMapI <- selectedWalkGen(MapI)
tagQueryLapply <- selectedWalkGen(lapply)


Expand Down Expand Up @@ -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) {
Expand All @@ -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)
}
})
Expand Down
16 changes: 13 additions & 3 deletions man/tagQuery.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

52 changes: 51 additions & 1 deletion tests/testthat/test-tag-query.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
9 changes: 9 additions & 0 deletions vignettes/tagQuery.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -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()`:
Expand Down