Search code examples
rshinyurl-routing

How to do page routing for an R Shiny app that works locally and on shinyapps.io

I've created a reprex for an R Shiny app where I want to give the appearance of subpages for navigation, swapping the main content of the page out depending on the URL given.

The closest I've got to it working currently is using the shiny.router package, this works locally but then I'm struggling to get the links to work when deployed to shinyapps.io. It also redirects the main page URL on shinyapps.io, which I'd also like to avoid if possible.

I want use relative links within the app to navigate, though I'm having issues working out how to approach this.

Ideal solution would be to have the main app at:

and the 'subpage' at something like:

So far, I've tried the shiny.router package, and have the following app.R working locally, this gives me a main page at the main URL, and then the subpages at /#!/subpage.

When deployed to the server I hit two issues.

  1. The main app URL redirects to https://cjrace.shinyapps.io/shiny-routing-reprex/_w_9c312d7b/#!/
  2. The subpage link points to https://cjrace.shinyapps.io/#!/subpage, where there's no content hosted

Ideally I'd like the main URL to not redirect elsewhere, and I want to find a way that I can use a relative link to the subpage URL that works both locally and when on the server.

I'm open to alternative solutions, and from the looks of answers to URI routing with shiny.router and navbarPage in a R shiny app and URI routing for shinydashboard using shiny.router it looks like there could even might be a better way to achieve what I'd like without the shiny.router package, though I'm not sure where to start in applying those to what I have currently as I'm not using buttons or tabs for navigation.

My current app.R script is below:

library(shiny)
library(shiny.router)

main_page <- function() {
  div(h1("Main page"), p("Some main text."))
}

sub_page <- function() {
  div(h1("Sub page"), p("Some subtext."))
}

ui <- fluidPage(
  tags$ul(
    tags$li(tags$a("Main page", href = "/")),
    tags$li(tags$a("Sub page", href = "/#!/subpage"))
  ),
  router_ui(
    route("/", main_page()),
    route("subpage", sub_page())
  )
)

server <- function(input, output, session) {
  shiny.router::router_server()
}

shinyApp(ui = ui, server = server)
Solution

  • You could use a hidden tabsetPanel to utilize my earlier answer along with your page layout:

    library(shiny)

ui <- fluidPage(
  tags$ul(
    tags$li(actionLink("main_page", "Main page")),
    tags$li(actionLink("sub_page", "Sub page"))
  ),
  tabsetPanel(
    id = "switcher",
    type = "hidden",
    tabPanelBody(value = "main", div(h1("Main page"), p("Some main text."))),
    tabPanelBody(value = "sub", div(h1("Sub page"), p("Some subtext.")))
  )
)

server <- function(input, output, session) {
  observeEvent(input$main_page, {
    updateTabsetPanel(inputId = "switcher", selected = "main")
  })
  observeEvent(input$sub_page, {
    updateTabsetPanel(inputId = "switcher", selected = "sub")
  })
  observeEvent(getQueryString(session)$page, {
    currentQueryString <- getQueryString(session)$page # alternative: parseQueryString(session$clientData$url_search)$page
    if(is.null(input$switcher) || !is.null(currentQueryString) && currentQueryString != input$switcher){
      freezeReactiveValue(input, "switcher")
      updateTabsetPanel(session, "switcher", selected = currentQueryString)
    }
  }, priority = 1)
  
  observeEvent(input$switcher, {
    currentQueryString <- getQueryString(session)$page # alternative: parseQueryString(session$clientData$url_search)$page
    pushQueryString <- paste0("?page=", input$switcher)
    if(is.null(currentQueryString) || currentQueryString != input$switcher){
      freezeReactiveValue(input, "switcher")
      updateQueryString(pushQueryString, mode = "push", session)
    }
  }, priority = 0)
}

shinyApp(ui = ui, server = server)