[Bug]: Certain singletons are loaded multiple times when teal_modifiers are used

[vedhav]

What happened?

JS file load singletons which are created on the server side has this issue.

Here's the example app to reproduce it. Note that the JS console will have an error because the file is loaded twice.

library(teal)

popup_button <- function(id, button_label = "Button") {
  ns <- shiny::NS(id)
  shiny::tagList(
    shiny::singleton(
      tags$head(
        shiny::includeScript(system.file("js/verbatim_popup.js", package = "teal.widgets"))
      )
    ),
    shiny::singleton(tags$head(
      tags$script("console.log('singleton script tag');")
    )),
    tags$head(
      tags$script("console.log('non-singleton script tag');")
    ),
    actionButton(inputId = ns("button"), label = button_label)
  )
}

tm_testing <- function() {
  module(
    "Testing JS load bug",
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        ns <- session$ns

        output$dataset_reporter <- renderUI({
          popup_button(ns("rcode"), "Show  code")
        })
      })
    },
    datanames = "all",
    ui = function(id) {
      ns <- NS(id)
      uiOutput(ns("dataset_reporter"))
    }
  )
}

app <- init(
  data = teal_data(iris = iris, mtcars = mtcars),
  modules = modules(
    tm_testing(),
    tm_testing()
  )
) |>
  modify_title(
    title = "Exploratory Analysis Teal Demo App"
  )

shinyApp(app$ui, app$server)

Code of Conduct

• I agree to follow this project's Code of Conduct.

Contribution Guidelines

• I agree to follow this project's Contribution Guidelines.

Security Policy

• I agree to follow this project's Security Policy.

[vedhav]

This bug happens specifically when a singleton tag is used in both UI and server and tagQuery replaces the UI.
Here's the code to reproduce:

library(shiny)

popup_button <- function(id, button_label = "Button") {
  ns <- shiny::NS(id)
  shiny::tagList(
    tags$head(
      tags$script("console.log('non-singleton script tag');")
    ),
    htmltools::singleton(
      tags$head(
        tags$script("console.log('singleton script tag');")
      )
    ),
    actionButton(inputId = ns("button"), label = button_label)
  )
}

ui_mod_1 <- function(id) {
  ns <- NS(id)
  uiOutput(ns("dataset_reporter"))
}
server_mod_1 <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    output$dataset_reporter <- renderUI({
      popup_button(ns("rcode"), "Show  code")
    })
  })
}

ui_mod_2 <- function(id) {
  ns <- NS(id)
  popup_button(ns("rcode"), "Show  code")
}
server_mod_2 <- function(id) {
  moduleServer(id, function(input, output, session) {
  })
}

ui <- fluidPage(
  tags$div(id = "replace-id"),
  tabsetPanel(
    tabPanel(
      "Module 1",
      ui_mod_1("module1")
    ),
    tabPanel(
      "Module 2",
      ui_mod_2("module2")
    )
  )
)

server <- function(input, output, session) {
  server_mod_1("module1")
  server_mod_2("module2")
}

# singleton loaded once
shinyApp(ui, server)

new_ui <- htmltools::tagQuery(ui)$allTags()

# singleton loaded twice
shinyApp(new_ui, server)