JavaScript to update active sidebar menuSubItems linked to TabPanel in dashboard

Question

I am trying to build a Shiny dashboard with menuSubItems that should correspond to TabPanels. I need also a button on the Home page that move to these TabPanels. This part is not working too bad. The issues come when I try to use some JavaScript code to update which are the 'active' items in the sidebar (reproducible example below).

My main issues are the following:

1. I am not able to set as 'active' the correct menuSubItem in the sidebar : in the js console, I see that the <li> items are correctly selected, but for an unknown reason classList.add('active'); (or remove) remain ineffective.
2. When I switch from "Tabpan" menuSubItems to Home or Settings, I would like the "Tab1" menuItem to collapse; here again, I've tried to do it with js (update class to style.display = 'none';) ; sometimes it works, sometimes it does not (it would be easier to understand if it was always working or not working ...).
3. There are kind of 'stochastic' behaviors that I don't understand. The Tabpan1 and Tabpan2 (and their corresponding observeEvent) are constructed exactly in the same way (using lapply), but Tabpan2 seems to work better than Tabpan1. Also, sometimes switching from Tabpanel TabPan1 to Settings works - sometimes it does not.

How can I debug the following app?

require(shiny)
require(shinyjs)
require(shinydashboard)
require(shinydashboardPlus)
mymenu <- list(list(menuitem=c("Tab1" = "tab1"),
                    subitems=c("Tabpan1" = "tsp1_tabpan1", "Tapan2"="tsp1_tabpan2"),
                    icon="upload"))
build_menu <- function(list_item){
  lapply(list_item, function(x){
    subs <- x[["subitems"]]
    men <- x[["menuitem"]]
    menusubits <- lapply(seq_along(subs), function(i){
      HTML(paste0('<li><a id="mv_',men,'_',subs[i] , '" href="#shiny-tab-',men ,'" class="action-button" data-value="',men,'">
<i class="fas fa-angles-right" role="presentation" aria-label="angles-right icon"></i> ', names(subs)[i],'</a></li>'))
    })
    menuItem(names(men), id=as.character(men), icon = icon(x[["icon"]]),menusubits)
  })
}
ui <- dashboardPage(
  dashboardHeader(title = ""),
  dashboardSidebar(
    sidebarMenu(id="sidebar",
                menuItem("Accueil",tabName = "home", icon = icon("igloo")),
                build_menu(mymenu),
                menuItem("Réglages", tabName = "settings", icon = icon("gears"))
    )),
  dashboardBody(
    useShinyjs(),
    tabItems(
      tabItem(tabName = "home",
              h1("Home"),
              HTML('<br><br><ul><li><a id="see_tab1_pan1" class="action-button" >
                                  Go to tab1 pan1</a></li><br><br>
                                  <li><a id="see_tab1_pan2" class="action-button" >
                                  Go to tab1 pan2</a></li>'),),
      tabItem(tabName = "tab1",
              h1("Tab1"),
              tabsetPanel(id="tab1_tabset",
              tabPanel("TabPan1", value=paste0("tab1_tsp1_tabpan1"),
                       h4("tp tit1")
              ),
            tabPanel("TabPan2", value=paste0("tab1_tsp1_tabpan2"),
                     h4("tp tit2")
            ),)),
      tabItem(tabName = "settings",
              h1("Settings")
    ))))


  server = function(input, output, session) {
    observeEvent(input$see_tab1_pan1,{
      cat(paste0("click_test\n"))
      # debug see_tab1_pan2 first :-)
    })
    observeEvent(input$see_tab1_pan2,{
      cat(paste0("click_test\n"))
      runjs(paste0(
        # emulate a click on menusubitem :
        "var x = document.getElementById('", "mv_tab1_tsp1_tabpan2", "'); ",
        "console.log(x);",
        "x.click();",
        # "// leaving Home -> remove active class ",
        "const $parent = $('.sidebar-menu [data-value=\"home\"]').closest('li');",
        "console.log('parent');",
        "console.log($parent);",
        "$parent.removeClass('active');",
        #"// expand the correspondign menuitem
        "var y = document.getElementById('", "tab1", "'); ",
        "console.log('y');",
        "console.log(y);",
        "y.style.display = 'block';",
        "y.classList.add('menu-open');"#,
    ))})
    ### collapse menuitems if I am in home or settings
    observe({
      if(input$sidebar == "home" | input$sidebar == "settings"){
        #"// collapse the tab1 menuitem
        runjs(paste0("var y = document.getElementById('", "tab1", "'); ",
        "console.log('y');",
        "console.log(y);",
        "y.style.display = 'none';",
        "y.classList.remove('menu-open');"#,
        ))
      }
    })

    lapply(mymenu, function(x){
      men <- as.character(x[["menuitem"]])
      stopifnot(length(men) == 1)
      subits <- x[["subitems"]]
      lapply(seq_along(subits), function(i){
        btnid <- paste0("mv_", men, "_", subits[i])
        observeEvent(input[[btnid]],{
         cat( paste0("click ",btnid,"\n") )
          updateTabItems(session, "sidebar", selected = men)
          updateTabItems(session, inputId = paste0(men, "_tabset"),
                         selected = paste0(men, "_", subits[i]))
          runjs(paste0(
      #"// find all other <li> elements of the menuitem and remove active class",
        "var btn = document.getElementById('", btnid, "');",
        "console.log('btn');",
        "console.log(btn);",
               "var allLi = btn.closest('ul').getElementsByTagName('li');",
               " for (var i = 0; i < allLi.length; i++) {",
        "console.log('allLi[i] - BEFORE');",
        "console.log(allLi[i]);",
                 " allLi[i].classList.remove('active');", #### NOT WORKING ????
        "console.log('allLi[i] - AFTER');",
        "console.log(allLi[i]);",
                 "}" ,
      # "// add 'active' class to <li> of the corresponding menusubitem button ",
      "var z = btn.closest('li');",
      "console.log('will add active to');",
      "console.log(z);",
      "  z.classList.add('active');",
      "  console.log('after set active class');", #### NOT WORKING ????
      "console.log(z);"
      ))
        }
      )})})}

  shinyApp(ui, server)

Answer 1

I found the following workaround, but I find it not clean at all and am still waiting a better answer...

require(shiny)
require(shinyjs)
require(shinydashboard)
require(shinydashboardPlus)


mymenu <- list(list(menuitem=c("Tab1" = "tab1"),
                    subitems=c("Tabpan1" = "tsp1_tabpan1", "Tabpan2"="tsp1_tabpan2"),
                    menuIcon="upload",
                    subMenuIcon = "angles-right"))

getMenuSubmenuItems <- function(list_item){
  lapply(list_item, function(x){
    subs <- x[["subitems"]]
    men <- x[["menuitem"]]
    menusubits <- lapply(seq_along(subs), function(i){
      HTML(paste0('<li><a id="mv_',men,'_',subs[i] , '" href="#shiny-tab-',men ,'" class="action-button" data-value="',men,'">
<i class="fas fa-', x[["subMenuIcon"]], '" role="presentation" aria-label="',x[["subMenuIcon"]] ,' icon"></i> ', 
                  names(subs)[i],'</a></li>'))
    })
    list( HTML(paste0('<li class="treeview">
          <a href="#" id="', as.character(men) ,'_parent" class="action-button">
        <i class="fas fa-', x[["menuIcon"]],'" role="presentation" aria-label="', x[["menuIcon"]],' icon"></i>
        <span>', names(men), '</span>
        <i class="fas fa-angle-left pull-right" role="presentation" aria-label="angle-left icon"></i>
        </a>
        <ul class="treeview-menu" style="display: none;" data-expanded="', names(men),'" id="', as.character(men),'">')),
      menusubits,
      HTML("</ul></li>"))})}

generate_home_menu <-function(mymenu){
  lapply(mymenu, function(menuit){
    mi <- menuit[["menuitem"]]
    si <- menuit[["subitems"]]
    start <- paste0("<h4>", names(mi), "</h4><ul>")
    its <- paste0(sapply(seq_along(si), function(i){
      paste0('<li><a id="see_', as.character(si[i]), '" class="action-button" >
                    Go to ', names(si)[i], '</a></li><br>')
    }), collapse="")
    end <- paste0("</ul>")
    HTML(paste0(c(start, its, end), collapse=""))})}  
generate_subitem_panels <- function(mymenu){
  lapply(mymenu, function(x){
    mi <- x[["menuitem"]]
    si <- x[["subitems"]]
    tabItem(tabName = as.character(mi),
            h1(names(mi)),
            tabsetPanel(id=paste0(mi, "_tabset"),
                        ### iterate over menuSubItems to create corresponding tabPanels
                        !!!lapply(seq_along(si), function(i){
                          tabPanel(names(si)[i], value = paste0(mi, "_", si[i]),
                                   h4(names(si[i])))})))})}

getMenuItem <- function(id, label, icon){
  return(HTML(paste0('<li><a href="#shiny-tab-', id, '" id="', id , '_btn" data-toggle="tab" class="action-button"
              data-value="', id, '">
                <i class="fas fa-', icon, '" role="presentation" aria-label="', icon, ' icon"></i>
                <span>', label, '</span>
              </a></li>')))}

ui <- dashboardPage(
  dashboardHeader(title = ""),
  dashboardSidebar(
    sidebarMenu(id="sidebar",
                getMenuItem("home", "Accueil", "igloo"),
                getMenuSubmenuItems(mymenu),
            getMenuItem("settings", "Settings", "gears"))),
  dashboardBody(
    useShinyjs(),
      do.call(tabItems,c(list(
        tabItem(tabName = "home", ## tabName should match id used in getMenuItem !!
                h1("Home"),
                generate_home_menu(mymenu)
        )),
      generate_subitem_panels(mymenu),
      list(tabItem(tabName = "settings", ## tabName should match id used in getMenuItem !!
              h1("Settings")))))))
  
  server = function(input, output, session) {
    lapply(mymenu, function(mi){
      mit <- as.character(mi[["menuitem"]])
      si <- mi[["subitems"]]
      lapply(si, function(subi){
        observeEvent(input[[paste0("see_", subi)]],{
          runjs(paste0(
            "var x = document.getElementById('", paste0(mit,"_parent"), "'); 
            x.click();"))
          Sys.sleep(1)
          runjs(paste0(
            "var x = document.getElementById('", paste0("mv_", mit, "_", subi), "');
            x.click();"))})})} )
   
    lapply(c("home", "settings"), function(tab){
      observeEvent(input[[paste0(tab, "_btn")]], {
        runjs(paste0("console.log('clicked ", tab, "');
var elements = document.querySelectorAll('ul.sidebar-menu ul.treeview-menu.menu-open');
console.log(elements);
elements.forEach(function(element) {
    element.classList.remove('menu-open');
    element.style.display = 'none';});"))})})

    lapply(mymenu, function(m){
      mi <- as.character(m[["menuitem"]])
      msi <- m[["subitems"]]
      lapply(msi, function(it){
        observeEvent(input[[paste0(mi, "_tabset")]],{
          if(input[[paste0(mi, "_tabset")]] == paste0(mi, "_", it)){
            btnid <- paste0("mv_", mi, "_", it)
            runjs(paste0(
              "var btn = document.getElementById('", btnid, "');",
              "var allLi = btn.closest('ul').getElementsByTagName('li');
              for (var i = 0; i < allLi.length; i++) {
              if(allLi[i].querySelector('a').id == '",btnid, "'){",
              "allLi[i].querySelector('a').dataset.value='", mi, "';",
              "} else{",
              "allLi[i].querySelector('a').dataset.value='",mi, "_foo';",
              "}
              allLi[i].classList.remove('active');
              }
              var z = btn.closest('li');
                z.classList.add('active');"
            ))}})})}) 

    lapply(mymenu, function(x){
      men <- as.character(x[["menuitem"]])
      stopifnot(length(men) == 1)
      subits <- x[["subitems"]]
      lapply(seq_along(subits), function(i){
        btnid <- paste0("mv_", men, "_", subits[i])
        observeEvent(input[[btnid]],{
          updateTabItems(session, "sidebar", selected = men)
          updateTabItems(session, inputId = paste0(men, "_tabset"),
                         selected = paste0(men, "_", subits[i]))
        })})})}
  
  shinyApp(ui, server)      

and I am still struggling with this part specifically :

          runjs(paste0(
            "var x = document.getElementById('", paste0(mit,"_parent"), "'); 
            x.click();"))
          Sys.sleep(1)
          runjs(paste0(
            "var x = document.getElementById('", paste0("mv_", mit, "_", subi), "');
            x.click();"))

(posted in this other SO question)