fix(insertTab): Render inserted nav html only once

[gadenbuie]

This PR refactors the shiny-insert-tab message handler.

This message handler recieves two critical components:

• liTag: the <li> item to be added to the nav controls
• divTag: the tab content associated with those nav controls.

These parts are not very well named:

• If adding one nav_panel() (or one tab), then there will be one <li> tag and one <div> tag.
• But its also possible to add a nav_menu(), which counts as one <li> tag but includes many <div> tags.

There are many places that the <li> tag could end up, either as a direct child of the parent nav list, or somewhere inside a nav menu of the selected navset. To know where to add the <li> tag, we need to render it so we can inspect it, and then we probably also need to update attributes inside that tag to coordinate everything appropriately.

There is only one place the <div> tag(s) end up, which is appended to the tab content container. Position is not important because visibility of this item is controlled by the nav item. If we're adding a nav_menu(), shiny/bslib will create IDs pairing the nav controls and the nav panel contents. But if we're adding a single nav_panel(), Shiny currently uses the existing navset markup to find an incremental ID for the new content <div>, and we need to modify its ID.

For these reasons, we previously would render the HTML once via jQuery, modify the markup as needed, and then stringify the markup and run it through renderContentAsync().

But there's no guarantee that the stringified markup will match the initial markup. If any elements modify their own attributes when added to the page (say a web component doing some initialization), the second insertion might not match the first.

This PR refactors the shiny-insert-tab message handler to use renderContentAsync() to handle rendering of liTag and divTag and to perform the rendering exactly once:

1. We render the liTag into a virtual document element via renderContentAsync(), modify the markup and then move the updated nodes into place.
2. We simply call renderContentAsync() once on the divTag html to add it to the tab content area. After it's added, we update the placeholder ID with the correct ID, if needed.

Replaces #4176

Example app

Example app

This isn't the absolutely most comprehensive test, but it covers some of the different content types that could be included in the nav items and content.

library(shiny)
library(bslib)
library(plotly)

ui <- bslib::page_navbar(
	title = "Reprex",
	id = "main",
	lang = "en"
)

action_link <- shiny::actionLink("refresh", "Refresh")
singleton <- shiny::singleton(
	shiny::HTML("<script>alert('ello world')</script>")
)

server <- function(input, output, session) {
	bslib::nav_insert(
		id = "main",
		nav = bslib::nav_menu(
			title = "Page",
			bslib::nav_panel(
				title = "A",
				"Page A",
				action_link,
				singleton,
				plotlyOutput("simple_plot")
			),
			bslib::nav_panel(title = "B", "Page B", action_link, singleton),
			bslib::nav_panel(title = "C", "Page C", action_link),
			bslib::nav_panel(title = "D", "Page D")
		)
	)

	bslib::nav_insert(
		id = "main",
		nav = bslib::nav_panel(title = "E", "Page E")
	)

	bslib::nav_insert(
		id = "main",
		nav = nav_item(
			input_dark_mode(id = "mode")
		)
	)

	output$simple_plot <- renderPlotly({
		plot_ly(
			x = c(1, 2, 3),
			y = c(10, 15, 13),
			type = 'scatter',
			mode = 'lines+markers'
		) %>%
			layout(title = "Simple Plotly Plot")
	})

	observe(message("refresh: ", input$refresh))
	observe(message("tab: ", input$main))
	observe(message("color-mode: ", input$mode))
}

shiny::shinyApp(ui, server)

[jcheng5]

Note B in the mega-comment below says "renderContent must be called on an element that's attached to the document". Is that going to be a problem here?

[gadenbuie]

It didn't seem to be in testing but I'll take another look. The mega comment is quite old; while the insert tab message handler hasn't changed much since it was written, renderContent() certainly has seen a few changes.

The comment was added here 91dbb0e in #1794

[gadenbuie]

Actually it seems like renderContentAsync() is essentially the same but renderHtml() has changed. (Leaving crumbs for myself)
https://github.com/rstudio/shiny/blob/91dbb0e77bfe137335e628ba314c6c9c399e2b71/srcjs/output_binding_html.js

[gadenbuie]

I found a very helpful comment from you @jcheng5 in that PR thread that I'll move up to a top-level comment here.

[gadenbuie]

The mega comment also states

// D) renderContent has a bug where only position "replace" (the default)
//    uses the jQuery functions, so other positions like "beforeend" will
//    prevent child script tags from running.

but one core difference is that renderHtml() does now use jQuery for all insertion positions. The change was made in #3630.

[gadenbuie]

Oh, I found it! Output elements need to be attached to the DOM, otherwise they aren't bound

shiny/srcts/src/shiny/bind.ts

Lines 317 to 320 in d764ea9

	// In some uncommon cases, elements that are later in the
	// matches array can be removed from the document by earlier
	// iterations. See https://github.com/rstudio/shiny/issues/1399
	if (!$.contains(document.documentElement, el)) continue;

So we just need to call bindAll() again after inserting the nav controls, in case they contain outputs. af6ecdb

[gadenbuie]

Here's a fun twist: I don't think this is needed anymore. The issue from #1399 doesn't reproduce if I take out the above line (added in #1402). (This change smells like an indirect fix that was reasonable at the time but might not be needed anymore.)

[jcheng5]

After further reflection, I'm fine with this the way you've written it. I was going to suggest doing all the tag manipulation with a parsed-but-not-rendered-or-inserted $liTag, then calling renderContentAsync without doing the appending the $liTag as a separate step. And if it were me I'd still maybe try to do it, but it's a pretty marginal improvement in code clarity and no difference in behavior AFAICT. So I'll leave it up to you.

[gadenbuie]

In #1794 (comment) @jcheng5 wrote:

We need these test cases for anywhere we insert dynamic UI:

1. <script> blocks should run
2. <script> blocks should only run once
3. head()/singleton() should be respected
4. HTML widgets should work
   a. Even when the dependencies are not part of the initial page load
5. Shiny inputs/outputs should work
6. Subapps should work (include a shinyApp object right in the UI)

I don't think these test cases became codified directly in a test app in shinycoreci, but I've recreated all of them in the following app (that can serve as the basis for an automated test). All cases work as expected with the current PR.

Test dynamic tabs

library(shiny)
library(bslib)

ui <- page_navbar(
  title = "Reprex for #4179",
  id = "main",
  lang = "en",
  navbar_options = navbar_options(collapsible = FALSE)
)

# https://github.com/rstudio/shiny/pull/1794#issuecomment-318722200
# We need these test cases for anywhere we insert dynamic UI:

# 1. `<script>` blocks should run
# 2. `<script>` blocks should only run once
# 3. `head()`/`singleton()` should be respected
# 4. HTML widgets should work
# 	a. Even when the dependencies are not part of the initial page load
# 5. Shiny inputs/outputs should work
# 6. Subapps should work (include a `shinyApp` object right in the UI)

action_link <- shiny::actionLink("refresh", "Refresh")

script_hello_world <- local({
  i <- 0

  function() {
    i <<- i + 1

    shiny::HTML(
      sprintf('<p id="hello-%s"></p>', i),
      "<script>(function() {",
      sprintf("const text = 'Hello from %s.';", i),
      sprintf("const p = document.getElementById('hello-%s');", i),
      "p.textContent = text;",
      "alert(text);",
      "})()</script>"
    )
  }
})

script_singleton <- shiny::singleton(script_hello_world())

server <- function(input, output, session) {
  nav_insert(
    id = "main",
    select = TRUE,
    nav_panel(
      "One",
      p("Alert 'Hello 1' should run once."),
      # 1. script blocks should run
      script_singleton,
      # 3. head() should be respected
      tags$head(tags$meta(content = "shiny-test-head"))
    ),
  )

  nav_insert(
    id = "main",
    select = TRUE,
    nav_panel(
      "Two",
      p(
        "Alert 'Hello 2' and 'Hello 3' should appear once each. No 'Hello 1' should happen."
      ),
      # 3. singleton blocks should be respected
      script_singleton,
      # 2. script blocks should only run once
      script_hello_world(),
      script_hello_world()
    ),
  )

  # 4. htmlwidgets work even if not part of initial page load
  nav_insert(
    id = "main",
    select = TRUE,
    nav_panel(
      "Map",
      leaflet::addTiles(leaflet::leaflet())
    ),
  )

  # 5. Input/outputs should work (in content)
  nav_insert(
    id = "main",
    select = TRUE,
    nav_panel(
      "Inputs/outputs",
      layout_columns(
        actionButton("btn", "Click me"),
        sliderInput("slider", "Slide me", min = 0, max = 10, value = 2),
      ),
      verbatimTextOutput("debug")
    )
  )

  output$debug <- renderPrint({
    list(
      btn = input$btn,
      slider = input$slider,
      nav_link = input$nav_link
    )
  })

  # 5. Inputs/outputs work (in navbar)
  nav_insert(
    id = "main",
    nav_item(
      actionLink("nav_link", "Click me too", class = "nav-link")
    )
  )

  nav_insert(
    id = "main",
    nav_item(textOutput("nav_output"))
  )

  output$nav_output <- renderText({
    sprintf("Clicked %d times", input$nav_link)
  })

  # 6. Shiny subapps
  nav_insert(
    id = "main",
    select = TRUE,
    nav_panel(
      "Shiny app",
      p("There should be another shiny app in here."),
      shinyApp(
        ui = page_fluid(
          theme = bs_theme(preset = "darkly"),
          titlePanel("Hello from in here!"),
          p("This is a sub-app. Notice we're re-using the btn id."),
          actionButton("btn", "Click me"),
          verbatimTextOutput("debug")
        ),
        server = function(input, output, session) {
          output$debug <- renderPrint(list(btn = input$btn))
        }
      )
    )
  )
}

shinyApp(ui, server)