Barbara/bookmark

[bborgesr]

Simple example app (open, collapse the sidebar, bookmark, then open the bookmarked URL - the sidebar will be collapsed):

library(shinydashboard)
library(shiny)

enableBookmarking("url")
shinyApp(
    ui = function(request) {
        dashboardPage(
            dashboardHeader(),
            dashboardSidebar(),
            dashboardBody(bookmarkButton())
        )
    },
    server = function(input, output, session) {}
)

---

The next two apps are (in some version) included in /tests-manual.

Complex example:

# Run this app (with "live" URL bookmarking) to make sure that the sidebar state
# (collapsed/expanded state of the sidebar itself; selected menuItem and; if
# applicable, the expanded menuItem)

library(shinydashboard)
library(shiny)
library(threejs)

ui <- function(request) {
  dashboardPage(
    dashboardHeader(title = "Testing sidebar bookmarkability"),
    dashboardSidebar(
      uiOutput("sidebarControls"),
      sidebarMenu(id = "smenu",
        menuItem("Frontpage", tabName = "front"),
        menuItem("Models",
          menuSubItem("Linear model", "models1"),
          menuSubItem("Logistic regression", "models2")
        ),
        menuItem("Plots",
          helpText("This is help text"),
          menuSubItem("Scatterplot", "plots1"),
          menuSubItem("3D graph", "plots2")
        ),
        menuItem("Tables", tabName = "tables")
      )
    ),
    dashboardBody(
      tabItems(
        tabItem("front",
          h3("Click through the different tabs to see different content")
        ),
        tabItem("models1",
          h3("Here's a linear model"),
          verbatimTextOutput("models1")
        ),
        tabItem("models2",
          h3("Here's a logistic regression"),
          verbatimTextOutput("models2")
        ),
        tabItem("plots1",
          h3("Here's a 2D plot"),
          plotOutput("plots1")
        ),
        tabItem("plots2",
          h3("Here's a 3D plot"),
          scatterplotThreeOutput('plots2')
        ),
        tabItem("tables",
          h3("Here's a table"),
          tableOutput("tbl")
        )
      )
    )
  )
}
server <- function(input, output, session) {
  output$sidebarControls <- renderUI({
    req(input$smenu)
     if (input$smenu %in% c("models1", "models2", "plots1")) {
       tagList(
         selectInput("xaxis", "X axis", names(mtcars), selected = input$xaxis),
         selectInput("yaxis", "Y axis", names(mtcars), selected = input$yaxis)
       )
     } else if (input$smenu == "plots2") {
       tagList(
         selectInput("xaxis", "X axis", names(mtcars), selected = input$xaxis),
         selectInput("yaxis", "Y axis", names(mtcars), selected = input$yaxis),
         selectInput("zaxis", "Z axis", names(mtcars), selected = input$zaxis)
       )
     } else NULL
  })

  formula <- reactive({
    req(input$yaxis, input$xaxis)
    as.formula(paste(input$yaxis, input$xaxis, sep = " ~ "))
  })

  output$models1 <- renderPrint({
    summary(glm(formula(), data = mtcars), family = "linear")
  })

  output$models2 <- renderPrint({
    summary(glm(formula(), data = mtcars), family = "binomial")
  })

  output$plots1 <- renderPlot({
    plot(formula(), data = mtcars)
  })

  output$plots2 <- renderScatterplotThree({
    x <- mtcars[[input$xaxis]]
    y <- mtcars[[input$yaxis]]
    z <- mtcars[[input$zaxis]]
    scatterplot3js(x, y, z)
  })

  output$tbl <- renderTable({
    mtcars
  })

  observe({
    # Trigger this observer every time an input changes
    reactiveValuesToList(input)
    session$doBookmark()
  })
  onBookmarked(function(url) {
    updateQueryString(url)
  })

}

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

---

Even more complex example (dynamic sidebarMenu):

# Run this app (with "live" URL bookmarking) to make sure that the sidebar state
# (collapsed/expanded state of the sidebar itself; selected menuItem and; if
# applicable, the expanded menuItem)

library(shinydashboard)
library(shiny)
library(threejs)

ui <- function(request) {
  dashboardPage(
    dashboardHeader(title = "Testing dynamic sidebar bookmarking"),
    dashboardSidebar(
      uiOutput("sidebarControls"),
      sidebarMenuOutput("menu")
    ),
    dashboardBody(
      tabItems(
        tabItem("front",
          h3("Click through the different tabs to see different content")
        ),
        tabItem("models1",
          h3("Here's a linear model"),
          verbatimTextOutput("models1")
        ),
        tabItem("models2",
          h3("Here's a logistic regression"),
          verbatimTextOutput("models2")
        ),
        tabItem("plots1",
          h3("Here's a 2D plot"),
          plotOutput("plots1")
        ),
        tabItem("plots2",
          h3("Here's a 3D plot"),
          scatterplotThreeOutput('plots2')
        ),
        tabItem("tables",
          h3("Here's a table"),
          tableOutput("tbl")
        )
      )
    )
  )
}


server <- function(input, output, session) {
  output$menu <- renderMenu({
    sidebarMenu(id = "smenu",
      menuItem("Frontpage", tabName = "front"),
      menuItem("Models",
        menuSubItem("Linear model", "models1"),
        menuSubItem("Logistic regression", "models2")
      ),
      menuItem("Plots",
        helpText("This is help text"),
        menuSubItem("Scatterplot", "plots1"),
        menuSubItem("3D graph", "plots2")
      ),
      menuItem("Tables", tabName = "tables")
    )
  })
  output$sidebarControls <- renderUI({
    req(input$smenu)
    if (input$smenu %in% c("models1", "models2", "plots1")) {
      tagList(
        selectInput("xaxis", "X axis", names(mtcars), selected = input$xaxis),
        selectInput("yaxis", "Y axis", names(mtcars), selected = input$yaxis)
      )
    } else if (input$smenu == "plots2") {
      tagList(
        selectInput("xaxis", "X axis", names(mtcars), selected = input$xaxis),
        selectInput("yaxis", "Y axis", names(mtcars), selected = input$yaxis),
        selectInput("zaxis", "Z axis", names(mtcars), selected = input$zaxis)
      )
    } else NULL
  })

  formula <- reactive({
    req(input$yaxis, input$xaxis)
    as.formula(paste(input$yaxis, input$xaxis, sep = " ~ "))
  })

  output$models1 <- renderPrint({
    summary(glm(formula(), data = mtcars), family = "linear")
  })

  output$models2 <- renderPrint({
    summary(glm(formula(), data = mtcars), family = "binomial")
  })

  output$plots1 <- renderPlot({
    plot(formula(), data = mtcars)
  })

  output$plots2 <- renderScatterplotThree({
    x <- mtcars[[input$xaxis]]
    y <- mtcars[[input$yaxis]]
    z <- mtcars[[input$zaxis]]
    scatterplot3js(x, y, z)
  })

  output$tbl <- renderTable({
    mtcars
  })

  observe({
    # Trigger this observer every time an input changes
    reactiveValuesToList(input)
    session$doBookmark()
  })
  onBookmarked(function(url) {
    updateQueryString(url)
  })

}

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

[wch]

I think you can remove this line, and then re-run yarn.

[wch]

This can be removed.

[wch]

paste() isn't necessary.

[wch]

How about sidebarItemExpanded instead of itemExpanded.

[wch]

A comment above here explaining what's going on would be helpful.

[wch]

Is this still necessary? If so, a more detailed comment would be helpful.

Also, I think it should be be $(el) instead. $(this) shouldn't return anything useful.

[wch]

This shouldn't be needed anymore.

[wch]

It might be simpler in the long run to check for the menu-open class, and if it's not present, trigger a click event on the $(firstChild).parent().prev() (or whatever it is), which will cause the event handler from AdminLTE to run. Then you don't have to try to duplicate the behavior, like calling $ul.show().

And same for the else below.

[wch]

Maybe try putting // eslint-disable-line consistent-return here?

[bborgesr]

closing in favor of #199