shinydashboard header dropdown add group links - html

Question

I want to put multiple links within a dropdown menu in the header panel, but now I can only create it with a flat horizonal layout through tags$li, while I want a vertical grouped dropdown menu.
A minimal repeatable code is as below, I means I want to put the linkA and linkB under grouplinkAB, and users can open one of them in a new window. It may be achieved with dropdownMenu(type='notifications',...) as in the code, but I do not know where to put the group name of "grouplinkAB", and which can not open a new window when clicking on the link, also I have to hide the text "You have 2 notifications", so I want to achieve it with tags$li and tags$ul, but I have little knowledge on HTML, any help will be appreciated.
library(shinydashboard)
library(shiny)
runApp(
shinyApp(
ui = shinyUI(
dashboardPage(
dashboardHeader(title='Reporting Dashboard',
tags$li(class="dropdown",tags$a("grouplinkAB",href="http://stackoverflow.com/", target="_blank")),
tags$li(class="dropdown",tags$a("linkA",href="http://stackoverflow.com/", target="_blank")),
tags$li(class="dropdown",tags$a("linkB",href="http://stackoverflow.com/", target="_blank")),
dropdownMenu(type='notifications',
notificationItem(text='linkA',href="http://stackoverflow.com/"),
notificationItem(text='linkB',href="http://stackoverflow.com/")
)
),
dashboardSidebar(),
dashboardBody()
)
),
server = function(input, output){}
), launch.browser = TRUE
)

Answer 1

Ok, I saw a similar request about a year ago, but didn't look much deeper. This time I tried to get your code to work and couldn't then I looked at the dropdownMenu code and saw it simply wasn't setup to handle this, but could be modified to do so fairly easily.
I choose not to do that though, instead I created a new version of dropdownMenu specialized to do just this.
Here is the code:
library(shinydashboard)
dropdownHack <- function (...,badgeStatus = NULL, .list = NULL,menuname=NULL)
{
if (!is.null(badgeStatus)){
shinydashboard:::validateStatus(badgeStatus)
}
items <- c(list(...), .list)
lapply(items, shinydashboard:::tagAssert, type = "li")
dropdownClass <- paste0("dropdown ", "text-menu")
numItems <- length(items)
if (is.null(badgeStatus)) {
badge <- NULL
}
else {
badge <- span(class = paste0("label label-", badgeStatus), numItems)
}
tags$li(class = dropdownClass, a( href="#", class="dropdown-toggle",
`data-toggle`="dropdown", menuname, badge),
tags$ul(class = "dropdown-menu", items )
)
}
menuitemHack <- function(text,href){
notificationItem(text=text,href=href,icon=shiny::icon("rocket") )
}
runApp(
shinyApp(
ui = shinyUI(
dashboardPage(
dashboardHeader(title='Reporting Dashboard',
dropdownHack(menuname="GroupAB",
menuitemHack(text='linkA',href="http://stackoverflow.com/"),
menuitemHack(text='linkB',href="http://stackoverflow.com/")
),
dropdownMenu(type='notifications',
notificationItem(text='linkA',href="http://stackoverflow.com/"),
notificationItem(text='linkB',href="http://stackoverflow.com/")
)
),
dashboardSidebar(),
dashboardBody()
)
),
server = function(input, output){}
), launch.browser = TRUE
)
And here is the result:
Notes:
It needs an icon, you can select any fontAwesome or Glyphicons, there is probably a blank one there somewhere if you want to have nothing.
I imagine it will break if the ShinyDashboard structure changes much, so keep that in mind.
Maybe the next version will support this option as well, it would just be a few lines of extra code.