Search code examples
rshinyshinydashboard

Changing direction of menuItems arrow icon on click in R shinydashboard

In the example below, is there anyway to make the sidebar's left-facing arrow point down when not selected (indicating that clicking it would open the menu) and up when selected (indicating that it can be closed)?

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem(text = "Click Me!",
               "Hello World!")
    )
  ),
  dashboardBody()
)

server <- function(input, output) { }

shinyApp(ui, server)

My desired end result would thus be:

enter image description here

Solution

  • You can achive this via shinyjs:

    library(shiny)
library(shinyjs)
library(htmltools)
library(shinydashboard)

sidebar <- htmltools::tagQuery(dashboardSidebar(
  sidebarMenu(
    id = "sidebarID",
    menuItem(text = "Click Me!",
             "Hello World!")
  )
))

sidebar <- sidebar$find("i")$removeClass("fa-angle-left")$addClass("fa-angle-down")$allTags()

ui <- dashboardPage(
  dashboardHeader(),
  sidebar,
  dashboardBody(
    useShinyjs()
  )
)

server <- function(input, output) {
  observeEvent(input$sidebarItemExpanded, {
    if(!is.null(input$sidebarItemExpanded)){
      removeCssClass(class = "fa-angle-down", selector = "#sidebarItemExpanded > ul > li > a > i")
      addCssClass(class = "fa-angle-up", selector = "#sidebarItemExpanded > ul > li > a > i")
    } else {
      addCssClass(class = "fa-angle-down", selector = "#sidebarItemExpanded > ul > li > a > i")
      removeCssClass(class = "fa-angle-up", selector = "#sidebarItemExpanded > ul > li > a > i")
    }
  }, ignoreNULL = FALSE)
}

shinyApp(ui, server)

    Edit: for multiple menuItems:

    library(shiny)
library(shinyjs)
library(htmltools)
library(shinydashboard)

sidebar <- htmltools::tagQuery(dashboardSidebar(
  sidebarMenu(
    id = "sidebarID",
    menuItem(text = "Click Me!",
             "Hello World!"),
    menuItem(text = "or click Me!",
             "Hello World!")
  )
))

sidebar <- sidebar$find("i")$removeClass("fa-angle-left")$addClass("fa-angle-down")$allTags()

ui <- dashboardPage(
  dashboardHeader(),
  sidebar,
  dashboardBody()
)

server <- function(input, output) {
  previousSelection <- reactiveVal(isolate(input$sidebarItemExpanded))
  observeEvent(input$sidebarItemExpanded, {
    if(!is.null(input$sidebarItemExpanded)){
      removeCssClass(class = "fa-angle-down", selector = "#sidebarItemExpanded > ul > li.treeview.active > a > i")
      addCssClass(class = "fa-angle-up", selector = "#sidebarItemExpanded > ul > li.treeview.active > a > i")
      
      if(!is.null(previousSelection())){
        if(input$sidebarItemExpanded != previousSelection()){
          addCssClass(class = "fa-angle-down", selector = "#sidebarItemExpanded > ul > li > a > i")
          removeCssClass(class = "fa-angle-up", selector = "#sidebarItemExpanded > ul > li > a > i")
          removeCssClass(class = "fa-angle-down", selector = "#sidebarItemExpanded > ul > li.treeview.active > a > i")
          addCssClass(class = "fa-angle-up", selector = "#sidebarItemExpanded > ul > li.treeview.active > a > i")
        }
      }

      previousSelection(input$sidebarItemExpanded)
      
    } else {
      addCssClass(class = "fa-angle-down", selector = "#sidebarItemExpanded > ul > li > a > i")
      removeCssClass(class = "fa-angle-up", selector = "#sidebarItemExpanded > ul > li > a > i")
    }
  }, ignoreNULL = FALSE)
}

shinyApp(ui, server)