Dynamic messages creation causes the entire app to reload, problem for multi-tab apps

[PaulHiemstra]

The code at the end of the post nicely illustrates the issue. You start on the first tab, then you go to the second. There we have a button which will generate a message in the header. If you click the button, the message will indeed be generated. However, this will cause the entire app to reload and we end up on the first tab because of it. In my opinion this is unwanted behavior, the app should stay on the second tab if the message was generated there.

Is this a flaw in Shiny, or am I missing a trick.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = 'Example', menuItemOutput('messages')),
  dashboardSidebar(sidebarMenu(
    menuItem('Tab1', tabName = 'tab1'),
    menuItem('Tab2', tabName = 'tab2')
  )),
  dashboardBody(tabItems(
    tabItem(tabName = 'tab1', h2('This is tab 1')),
    tabItem(tabName = 'tab2', h2('This is tab 2'), actionButton('send_message', 'Send a message'))
  ))
)

server <- function(input, output) { 
  messages = reactiveVal()
  observeEvent(input$send_message, {
    messages(list(messageItem('Me', 'Button pushed')))
  })
  output$messages = renderMenu({
    validate(need(messages, message = FALSE))
    dropdownMenu(type = 'messages', .list = messages())
  })
}

shinyApp(ui, server)

[wch]

When I run your app and click the button, a message shows up but it doesn't reload. Can you provide the output of sessionInfo() or (better) devtools::session_info()?

[PaulHiemstra]

Thanks for respoding @wch, with the following session info I can reproduce the issue:

> devtools::session_info()
Session info --------------------------------------------------------------------------------------------------------------------------------
 setting  value                       
 version  R version 3.4.3 (2017-11-30)
 system   x86_64, mingw32             
 ui       RStudio (1.1.423)           
 language (EN)                        
 collate  Dutch_Netherlands.1252      
 tz       Europe/Berlin               
 date     2018-04-13                  

Packages ------------------------------------------------------------------------------------------------------------------------------------
 package        * version date       source        
 base           * 3.4.3   2017-12-06 local         
 compiler         3.4.3   2017-12-06 local         
 datasets       * 3.4.3   2017-12-06 local         
 devtools         1.13.5  2018-02-18 CRAN (R 3.4.3)
 digest           0.6.15  2018-01-28 CRAN (R 3.4.3)
 graphics       * 3.4.3   2017-12-06 local         
 grDevices      * 3.4.3   2017-12-06 local         
 htmltools        0.3.6   2017-04-28 CRAN (R 3.4.3)
 httpuv           1.3.5   2017-07-04 CRAN (R 3.4.3)
 jsonlite         1.5     2017-06-01 CRAN (R 3.4.3)
 memoise          1.1.0   2017-04-21 CRAN (R 3.4.3)
 methods        * 3.4.3   2017-12-06 local         
 mime             0.5     2016-07-07 CRAN (R 3.4.1)
 R6               2.2.2   2017-06-17 CRAN (R 3.4.3)
 Rcpp             0.12.15 2018-01-20 CRAN (R 3.4.3)
 shiny          * 1.0.5   2017-08-23 CRAN (R 3.4.3)
 shinydashboard * 0.6.1   2017-06-14 CRAN (R 3.4.3)
 stats          * 3.4.3   2017-12-06 local         
 tools            3.4.3   2017-12-06 local         
 utils          * 3.4.3   2017-12-06 local         
 withr            2.1.1   2017-12-19 CRAN (R 3.4.3)
 xtable           1.8-2   2016-02-05 CRAN (R 3.4.3)
 yaml             2.1.16  2017-12-12 CRAN (R 3.4.3)

[PaulHiemstra]

I just updated to the latest shinydashboard on CRAN and the issue is fixed.

[PaulHiemstra]

@wch The usecase for which I wanted to fix this is a little more complex (see code example below). It is a notification module which can communicate with other module. In this case each tab is a module, and an extra module for the notifications. It use a closure to allow the notification module to communicate with the other modules, providing a number of functions that allow the other modules to post and delete notifications. Left it here for posterity :).

library(shiny)
library(shinydashboard)

## Modules
# Code related to the first tab -------------------------------------------
tab1UI = function(id) {
  ns = NS(id)

  fluidPage(
    h2('This is tab 1'),
    actionButton(ns('send_message'), 'Send a message'),
    actionButton(ns('remove_message'), 'Remove most recent message')
  )
}
tab1Server = function(input, output, session, notifficationModule) {
  observeEvent(input$send_message, {
    notifficationModule$push_notification(notificationItem(sprintf('Tab 1: Pushed a notification at %s', Sys.time())))
  }) 
  observeEvent(input$remove_message, {
    notifficationModule$pop_notification()
  })
}

# Code related to the second tab ------------------------------------------
tab2UI = function(id) {
  ns = NS(id)

  fluidPage(
    h2('This is tab 2'),
    actionButton(ns('send_message'), 'Send a message'),
    actionButton(ns('remove_message'), 'Remove most recent message')
  )
}
tab2Server = function(input, output, session, notifficationModule) {
  observeEvent(input$send_message, {
    notifficationModule$push_notification(notificationItem(sprintf('Tab2: Pushed a notification at %s', Sys.time())))
  }) 
  observeEvent(input$remove_message, {
    notifficationModule$pop_notification()
  })
}

# The notification module -------------------------------------------------
notificationUI = function(id) {

  ns = NS(id)

  dropdownMenuOutput(ns('notifications'))
}
notificationServer = function(input, output, session) {
  notification_list = reactiveVal()
  output$notifications = renderMenu({
    validate(need(notification_list(), message = FALSE))
    dropdownMenu(type = 'notifications', badgeStatus = 'warning', .list = notification_list())
  })

  return(list(
    push_notification = function(message) {
      pf = parent.env(environment())
      pf$notification_list(c(pf$notification_list(), list(message)))
    },
    pop_notification = function() {
      pf = parent.env(environment())
      pf$notification_list(notification_list()[-length(pf$notification_list())])
    }
  ))
}

# Main app ----------------------------------------------------------------
ui <- dashboardPage(
  dashboardHeader(title = 'Notification Example', notificationUI('notificationUI')),
  dashboardSidebar(sidebarMenu(
    menuItem('Tab1', tabName = 'tab1'),
    menuItem('Tab2', tabName = 'tab2')
  )),
  dashboardBody(tabItems(
    tabItem(tabName = 'tab1', tab1UI('tab1UI')),
    tabItem(tabName = 'tab2', tab2UI('tab2UI'))
  ))
)

server <- function(input, output) { 
  notificationModule = callModule(notificationServer, 'notificationUI')
  callModule(tab1Server, 'tab1UI', notificationModule)
  callModule(tab2Server, 'tab2UI', notificationModule)
}

shinyApp(ui, server)