No tab is displayed when both menu and tabs are dynamically generated

[pisistrato]

Strange behavior here, when both menu and tabs are dynamically generated, with the tab html code itself generated only when selected in the menu, the app fails to display the content of the newly generated tab.

library(bs4Dash)
library(data.table)
library(shiny)

qtable <- data.table(id = paste0("X", c(1, 1, 2, 2, 3, 3, 3)), sid = c(1, 2, 1, 2, 1, 2, 3))

convertMenuItem <- function(mi, tabName) {
  mi$attribs["class"] <- ""
  mi$attribs["style"] <- "position: relative;"
  mi$children[[1]]$attribs["data-target"] <- paste0("#shiny-tab-", tabName)
  mi$children[[1]]$attribs["data-toggle"] <- "tab"
  mi$children[[1]]$attribs["data-value"] <- tabName
  if (length(mi$attribs$class) > 0 && mi$attribs$class == "treeview") {
    mi$attribs$class <- NULL
  }
  mi
}

ui <- dashboardPage(
  dashboardHeader(title = "test"),
  dashboardSidebar(
    sidebarMenuOutput("menu")
  ),
  dashboardBody(
    tabItems(
      uiOutput("tabitems")
    )
  )
)

server <- function(input, output, session) {
  observeEvent(session, {
    updateTabItems(session, "sidetabs", selected = "home")
  })

  output$menu <- renderMenu({
    sidetabs <- c(
      list(
        menuItem("Home", tabName = "home")
      ),
      lapply(split(qtable, by = "id"), function(d) {
        if (nrow(d) > 1) {
          convertMenuItem(
            lapply(unique(d$id), function(i) {
              lapply(unique(d$id), function(i) {
                do.call(menuItem, c(
                  text = i,
                  tabName = i,
                  lapply(d$sid, function(j) {
                    menuSubItem(text = j, tabName = paste0(i, j))
                  })
                ))
              })
            })[[1]][[1]], unique(d$id)
          )
        } else {
          menuItem(d$id, tabName = d$id)
        }
      })
    )

    do.call(sidebarMenu, c(sidetabs, id = "sidetabs"))
  })

  dynamictabs <- reactiveValues(
    pjstab = NULL
  )

  observeEvent(input$sidetabs, {
    if (!input$sidetabs %in% c("home")) {
      dynamictabs$pjstab <- list(
        tabItem(
          tabName = input$sidetabs,
          h1(input$sidetabs)
        )
      )
    }
  })

  output$tabitems <- renderUI({
    mytabs <- c(
      list(
        tabItem(
          tabName = "home",
          h1("HOME")
        )
      ),
      dynamictabs$pjstab
    )

    do.call(tabItems, mytabs)
  })
}

# runApp ----
shinyApp(ui, server)

> sessionInfo()
R version 4.0.4 (2021-02-15)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 17763)

Matrix products: default

locale:
[1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252    LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C                           LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] shinyWidgets_0.6.0 shinyjs_2.0.0      RPostgreSQL_0.6-2  DBI_1.1.1          pool_0.1.6         lubridate_1.7.10   fresh_0.2.0       
 [8] DT_0.17            data.table_1.14.0  bs4Dash_2.0.0      shiny_1.6.0       

loaded via a namespace (and not attached):
 [1] styler_1.4.0      tinytex_0.30      xfun_0.22         bslib_0.2.4       rematch2_2.1.2    purrr_0.3.4       generics_0.1.0   
 [8] sourcetools_0.1.7 vctrs_0.3.6       htmltools_0.5.1.1 yaml_2.2.1        utf8_1.2.1        rlang_0.4.10      R.oo_1.24.0      
[15] jquerylib_0.1.3   later_1.1.0.1     pillar_1.5.1      withr_2.4.1       R.utils_2.10.1    lifecycle_1.0.0   R.cache_0.14.0   
[22] R.methodsS3_1.8.1 htmlwidgets_1.5.3 fastmap_1.1.0     httpuv_1.5.5      crosstalk_1.1.1   fansi_0.4.2       Rcpp_1.0.6       
[29] xtable_1.8-4      promises_1.2.0.1  backports_1.2.1   cachem_1.0.4      jsonlite_1.7.2    mime_0.10         digest_0.6.27    
[36] tools_4.0.4       magrittr_2.0.1    sass_0.3.1        tibble_3.1.0      crayon_1.4.1      pkgconfig_2.0.3   ellipsis_0.3.1   
[43] rstudioapi_0.13   R6_2.5.0          compiler_4.0.4   

In the html code I can see the tab generated upon click before:

<div class="tab-content">
  <div role="tabpanel" class="tab-pane container-fluid active" id="shiny-tab-home">
    <h1>HOME</h1>
  </div>
</div>

after clicking X1:

<div class="tab-content">
            <div id="tabitems" class="shiny-html-output shiny-bound-output" aria-live="polite"><div class="tab-content">
  <div role="tabpanel" class="tab-pane container-fluid" id="shiny-tab-home">
    <h1>HOME</h1>
  </div>
  <div role="tabpanel" class="tab-pane container-fluid" id="shiny-tab-X1">
    <h1>X1</h1>
  </div>
</div></div>
          </div>

Yet, the class of the div "shiny-tab-X1" is not set to active. Not sure why this is happening...

[pisistrato]

Because I needed this to work ASAP, I came up with this workaround, still no idea what it is really going on, but I suspect that it is a timing issue, with something triggered too early.

  var myhtml = $("html")[0];
  function activate() {
    if ($(".tab-pane.container-fluid").last().hasClass("active")) {
      clearInterval(interval);
    } else {
      $(".tab-pane.container-fluid").last().addClass("active");
    }
  }

  var observer = new MutationObserver(function (mutations) {
    mutations.forEach(function (mutation) {
      var newNodes = mutation.addedNodes;
      if (newNodes !== null) {
        interval = setInterval(activate, 0);
      }
    });
  });

  var config = {
    attributes: true,
    childList: true,
    characterData: true,
  };

  observer.observe(myhtml, config);

Some observation the observer must be on html, or it does not work. Also, setInterval is needed, because class active is not added at the first iteration.