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

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

Amazing write-up! Great job isolating the issue! :clap: :clap:


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()`: Weird output/modufication of tags with htmlwidget output inside · 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. :disappointed:

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

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

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.