使用闪亮模块时，如何在闪亮仪表板中动态发布通知

Question

When all code is in the same evironment, it is easy to create notifications in shinydashboard . However, when wrapping code in shiny modules it is not obvious to me how I can still create notifications. In my use case each tab in the app has it's own module which is used in the dashboard body. I don't see an obvious way to get notifications working, which should be posted in the dashboard header.

I asked this question specificaly to answer it because I did not find any good resources when trying to solve this issue.

Answer 1

The crux is to exchange reactives between the different modules. In this example I created a module specifically for the notifications. The module returns a list of functions (making it a closure effectivally) that allow other modules to post notifications. Note the use of parent.env to allow the function in the list to access the internal reactive value that controls the notifications.

In the server we input the notification function list into each of the modules that needs it. The following app illustrates my solution. The nice thing is that the notification module can be reused in any other app.

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)