Shiny/htmltools: Custom tags behave weird when using `tagQuery()` to modify tags

[DavidJesse]

Hi, I recently encountered a weird side effect, when using the htmltools::tagQuery() function to create and modify custom html tags for my shiny application.

Scenario: My goal was to create a function for bootstrap 4 cards as containers for my UI output.
I have already successfully done so in the past using "classic" manipulation of shiny tags along with functions like tagAppendChildren() or tagAppendAttributes().
Now, I just wanted to refactor my code a little bit and use the above mentioned tagQuery approach.

Consider the following app now:

library(shiny)
library(bslib)
library(htmltools)
library(reactable)

myWellPanel <- function(...) {
  panel <- wellPanel(...)
  panel <- tagQuery(panel)$allTags()
  panel
}


ui <- fluidPage(
  theme = bs_theme(version = 4),
  fluidRow(
    column(
      6,
      wellPanel(reactableOutput("test1"))
    ),
    column(
      6,
      myWellPanel(reactableOutput("test2"))
    )
  )
)

server <- function(input, output, session) {
  output$test1 <- renderReactable(
    reactable(iris)
  )
  output$test2 <- renderReactable(
    reactable(iris)
  )
}

shinyApp(ui, server)

For the sake of demonstration, I didn't create any custom card function, but just wrote a wrapper function around shiny::wellPanel(), simply calling tagQuery() on it and returning all tags.

The example above still works, but myWellPanel behaves weird in the following scenario:

1. It contains an htmlwidget output (here a reactable) and
2. Is used at least twice (when used once like in the example, it works).

I.e. when I change the above UI code and only use myWellPanel instead of wellPanel no output will be shown at all:

# Does not work
ui <- fluidPage(
  theme = bs_theme(version = 4),
  fluidRow(
    column(
      6,
      myWellPanel(reactableOutput("test1"))
    ),
    column(
      6,
      myWellPanel(reactableOutput("test2"))
    )
  )
)

I want to emphasize that this seems to be the case only when the output is an htmlwidget.
E.g. when I render a static plot, these issues don't encounter at all.

The only thing I know so far is that calling tagQuery(mytag)$allTags() seems to change the structure of the shiny tag:

str_normal <- wellPanel(reactableOutput("test1"))
str_custom <- myWellPanel(reactableOutput("test2"))
View(str_normal)
View(str_custom)

In particular, it seems to remove one list wrapper from the tag's children, which might in some way be the cause (however I am just not expert enough in shiny or web development to telll what exactly it is).

I would be very grateful if someone could explain to me, what exactly causes this weird behaviour and if it's rather me, who needs to learn more about tagQuery and modify the code or if this might be some issue around htmltools::tagQuery().

Thanks in advance and kind regards
David

[barret]

Amazing write-up! Great job isolating the issue!

---

I would be very grateful if someone could explain to me, .... if this might be some issue around htmltools::tagQuery() .

This is an issue of tagQuery(). (Tagging issue: `tagQuery()`: Nested `tagList()` `htmlDependency()` values are being dropped · Issue #301 · rstudio/htmltools · GitHub)

---

The only thing I know so far is that calling tagQuery(mytag)$allTags() seems to change the structure of the shiny tag:

Correct! For optimization, all children tags are squashed into a single child tag, as the final rendering does not treat a squashed list structure different from a nest list structure.

It seems that the nested list structures in the children are losing their html dependencies.

Ex:

library(htmltools)

barret_dep <- htmlDependency(name = "barret", version = 1, src = list(file = "some/file.js"))

children <- attachDependencies(list("A", "B"), barret_dep)

html <- div("example", children)
tq_html <- tagQuery(html)$allTags()

# These should match
str(html)
#> List of 3
#>  $ name    : chr "div"
#>  $ attribs : Named list()
#>  $ children:List of 2
#>   ..$ : chr "example"
#>   ..$ :List of 2
#>   .. ..$ : chr "A"
#>   .. ..$ : chr "B"
#>   .. ..- attr(*, "html_dependencies")=List of 1
#>   .. .. ..$ :List of 10
#>   .. .. .. ..$ name      : chr "barret"
#>   .. .. .. ..$ version   : chr "1"
#>   .. .. .. ..$ src       :List of 1
#>   .. .. .. .. ..$ file: chr "some/file.js"
#>   .. .. .. ..$ meta      : NULL
#>   .. .. .. ..$ script    : NULL
#>   .. .. .. ..$ stylesheet: NULL
#>   .. .. .. ..$ head      : NULL
#>   .. .. .. ..$ attachment: NULL
#>   .. .. .. ..$ package   : NULL
#>   .. .. .. ..$ all_files : logi TRUE
#>   .. .. .. ..- attr(*, "class")= chr "html_dependency"
#>  - attr(*, "class")= chr "shiny.tag"
str(tq_html)
#> List of 3
#>  $ name    : chr "div"
#>  $ attribs : Named list()
#>  $ children:List of 3
#>   ..$ : chr "example"
#>   ..$ : chr "A"
#>   ..$ : chr "B"
#>  - attr(*, "class")= chr "shiny.tag"

# These should match
findDependencies(html)
#> [[1]]
#> List of 10
#>  $ name      : chr "barret"
#>  $ version   : chr "1"
#>  $ src       :List of 1
#>   ..$ file: chr "some/file.js"
#>  $ meta      : NULL
#>  $ script    : NULL
#>  $ stylesheet: NULL
#>  $ head      : NULL
#>  $ attachment: NULL
#>  $ package   : NULL
#>  $ all_files : logi TRUE
#>  - attr(*, "class")= chr "html_dependency"
findDependencies(tq_html)
#> NULL

[barret]

Fixed in PR: `tagQuery()`: Copy html deps found on tag list items to the flattened tag list by schloerke · Pull Request #302 · rstudio/htmltools · GitHub