URI routing for shinydashboard using shiny.router

Question

Suppose you have a simple shinydashboard which contains links created with menuItem and pages created with tabItems:

library(shiny)
library(shinydashboard)

skin <- Sys.getenv("DASHBOARD_SKIN")
skin <- tolower(skin)
skin <- "blue"

## ui.R ##
sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Widgets", icon = icon("th"), tabName = "widgets",
             badgeLabel = "new", badgeColor = "green")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName = "dashboard",
            h2("Dashboard tab content")
    ),
    
    tabItem(tabName = "widgets",
            h2("Widgets tab content")
    )
  )
)

# Put them together into a dashboardPage
ui<-dashboardPage(
  dashboardHeader(title = "Simple tabs"),
  sidebar,
  body
)


server <- function(input, output) {
  
}

shinyApp(ui, server)

Is it possible to create permalinks for the pages? e.g. the home page (tabName == "dashboard") has a URL of 127.0.0.1:1234/home and the widgets page is at 127.0.0.1:1234/widgets?

It seems that shiny doesn't have URL routing out of the box. shiny.router seems to be a possible alternative but I've found no easy ways to do this with shinydashboard i.e. with the use of menuItem and tabItem. I'm trying to avoid rewriting the app's UI to use something which is more tightly integrated with shiny.router (e.g. shiny.semantic)

Is it possible to keep the above shinydashboard code while implementing permalinks to the various different pages?

I think the `session$clientData$url_` elements will allow you to construct the necessary links programmatically. See [here](https://shiny.rstudio.com/reference/shiny/1.6.0/session.html) for details. — Limey, Nov 23 '21 at 13:28
Thanks for the link. I'll be honest, this is way over my head. I have a background in Django development so I'm familiar with URL routing. Shiny apps really kill my brain, sometimes. — Simon, Nov 23 '21 at 13:50
It seems that shinydashboard adds some js that makes it impossible to integrate it with shiny.router: https://github.com/Appsilon/shiny.router/issues/20 If you don't neeed to do a production.grade app, you can check brochure: https://github.com/ColinFay/brochure — Pabort, Nov 24 '21 at 08:41
Thanks for the heads up regarding {brochure}. Although this sounds promising, I'm reluctant to use a library which says not to use (and one that hasn't been updated since February). I did make some progress yesterday getting `shiny.router` working with `shinydashboard`. However, all the pages' content renders on a single page, which likely ties in with your assertion that they can't be integrated. — Simon, Nov 24 '21 at 09:01
@Simon could you provide your progress with `shiny.routers` and `shinydashboard` on a single page? Im curious. — Pabort, Nov 24 '21 at 09:40

ismirsehregal · Accepted Answer · 2022-08-10T18:23:20.603

Here is how to use the below approach with shiny's tabPanel() function.

Workarounds not using library(shiny.router):

Edit - Alternative using clientData$url_search and mode = "push" for updateQueryString to push a new history entry onto the browser's history stack:

library(shiny)
library(shinydashboard)

ui <- function(request) {
  dashboardPage(
    header = dashboardHeader(title = "Simple tabs"),
    sidebar = dashboardSidebar(
      sidebarMenu(
        id = "sidebarID",
        menuItem(
          "Dashboard",
          tabName = "dashboard",
          icon = icon("tachometer-alt")
        ),
        menuItem(
          "Widgets",
          icon = icon("th"),
          tabName = "widgets",
          badgeLabel = "new",
          badgeColor = "green"
        )
      )
    ),
    body = dashboardBody(tabItems(
      tabItem(tabName = "dashboard",
              h2("Dashboard tab content")),
      tabItem(tabName = "widgets",
              h2("Widgets tab content"))
    ))
  )
}

server <- function(input, output, session) {
  # http://127.0.0.1:6172/?tab=dashboard
  # http://127.0.0.1:6172/?tab=widgets
  
  observeEvent(getQueryString(session)$tab, {
    currentQueryString <- getQueryString(session)$tab # alternative: parseQueryString(session$clientData$url_search)$tab
    if(is.null(input$sidebarID) || !is.null(currentQueryString) && currentQueryString != input$sidebarID){
      freezeReactiveValue(input, "sidebarID")
      updateTabItems(session, "sidebarID", selected = currentQueryString)
    }
  }, priority = 1)
  
  observeEvent(input$sidebarID, {
    currentQueryString <- getQueryString(session)$tab # alternative: parseQueryString(session$clientData$url_search)$tab
    pushQueryString <- paste0("?tab=", input$sidebarID)
    if(is.null(currentQueryString) || currentQueryString != input$sidebarID){
      freezeReactiveValue(input, "sidebarID")
      updateQueryString(pushQueryString, mode = "push", session)
    }
  }, priority = 0)
  
}

shinyApp(ui, server, enableBookmarking = "disable")

Another Edit - using url_hash (uri fragments):

library(shiny)
library(shinydashboard)

ui <- function(request) {
  dashboardPage(
    header = dashboardHeader(title = "Simple tabs"),
    sidebar = dashboardSidebar(
      sidebarMenu(
        id = "sidebarID",
        menuItem(
          "Dashboard",
          tabName = "dashboard",
          icon = icon("tachometer-alt")
        ),
        menuItem(
          "Widgets",
          icon = icon("th"),
          tabName = "widgets",
          badgeLabel = "new",
          badgeColor = "green"
        )
      )
    ),
    body = dashboardBody(tabItems(
      tabItem(tabName = "dashboard",
              h2("Dashboard tab content")),
      tabItem(tabName = "widgets",
              h2("Widgets tab content"))
    ))
  )
}

server <- function(input, output, session) {
  
  observeEvent(input$sidebarID, {
    # http://127.0.0.1:6172/#dashboard
    # http://127.0.0.1:6172/#widgets
    
    newURL <- paste0(
      session$clientData$url_protocol,
      "//",
      session$clientData$url_hostname,
      ":",
      session$clientData$url_port,
      session$clientData$url_pathname,
      "#",
      input$sidebarID
    )
    updateQueryString(newURL, mode = "replace", session)
  })
  
  observe({
    currentTab <- sub("#", "", session$clientData$url_hash)
    if(!is.null(currentTab)){
      updateTabItems(session, "sidebarID", selected = currentTab)
    }
  })
  
}

shinyApp(ui, server, enableBookmarking = "disable")

Edit - using url_search: Actually we can do the same without bookmarking using getQueryString and updateTabItems:

library(shiny)
library(shinydashboard)

ui <- function(request) {
  dashboardPage(
    header = dashboardHeader(title = "Simple tabs"),
    sidebar = dashboardSidebar(
      sidebarMenu(
        id = "sidebarID",
        menuItem(
          "Dashboard",
          tabName = "dashboard",
          icon = icon("tachometer-alt")
        ),
        menuItem(
          "Widgets",
          icon = icon("th"),
          tabName = "widgets",
          badgeLabel = "new",
          badgeColor = "green"
        )
      )
    ),
    body = dashboardBody(tabItems(
      tabItem(tabName = "dashboard",
              h2("Dashboard tab content")),
      tabItem(tabName = "widgets",
              h2("Widgets tab content"))
    ))
  )
}

server <- function(input, output, session) {

  observeEvent(input$sidebarID, {
    # http://127.0.0.1:6172/?tab=dashboard
    # http://127.0.0.1:6172/?tab=widgets
    
    newURL <- paste0(
        session$clientData$url_protocol,
        "//",
        session$clientData$url_hostname,
        ":",
        session$clientData$url_port,
        session$clientData$url_pathname,
        "?tab=",
        input$sidebarID
      )
    updateQueryString(newURL, mode = "replace", session)
  })
  
  observe({
    currentTab <- getQueryString(session)$tab # alternative: parseQueryString(session$clientData$url_search)$tab
    if(!is.null(currentTab)){
      updateTabItems(session, "sidebarID", selected = currentTab)
    }
  })
  
}

shinyApp(ui, server, enableBookmarking = "disable")

Using bookmarks:

Not sure if you are interested in a workaround like this, but you could use shiny's bookmarking and updateQueryString to achive a similar behaviour:

library(shiny)
library(shinydashboard)

ui <- function(request) {
  dashboardPage(
    header = dashboardHeader(title = "Simple tabs"),
    sidebar = dashboardSidebar(
      sidebarMenu(
        id = "sidebarID",
        menuItem(
          "Dashboard",
          tabName = "dashboard",
          icon = icon("tachometer-alt")
        ),
        menuItem(
          "Widgets",
          icon = icon("th"),
          tabName = "widgets",
          badgeLabel = "new",
          badgeColor = "green"
        )
      )
    ),
    body = dashboardBody(tabItems(
      tabItem(tabName = "dashboard",
              h2("Dashboard tab content")),
      tabItem(tabName = "widgets",
              h2("Widgets tab content"))
    ))
  )
}


server <- function(input, output, session) {
  bookmarkingWhitelist <- c("sidebarID")
  
  observe({
    setBookmarkExclude(setdiff(names(input), bookmarkingWhitelist))
  })
  
  observeEvent(input$sidebarID, {
    # http://127.0.0.1:6172/?_inputs_&sidebarID=%22dashboard%22
    # http://127.0.0.1:6172/?_inputs_&sidebarID=%22widgets%22
    
    newURL <- paste0(
        session$clientData$url_protocol,
        "//",
        session$clientData$url_hostname,
        ":",
        session$clientData$url_port,
        session$clientData$url_pathname,
        "?_inputs_&sidebarID=%22",
        input$sidebarID,
        "%22"
      )
    
    updateQueryString(newURL,
                      mode = "replace",
                      session)
  })
}

shinyApp(ui, server, enableBookmarking = "url")

Some related links:

@ismirsehregal, Do you know of a way to use URI routing with a dashboard that uses a navbarPage structure? Regarding this problem I posted [this question](https://stackoverflow.com/questions/71541259/uri-routing-with-shiny-router-and-navbarpage-in-a-r-shiny-app). — jantau, Apr 08 '22 at 16:06

URI routing for shinydashboard using shiny.router

1 Answers1

Linked