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

Question

当所有代码都在同一个环境中时，很容易在shinydashboard. 但是，当将代码包装在闪亮的模块中时，我不清楚如何仍然可以创建通知。在我的用例中，应用程序中的每个选项卡都有自己的模块，用于仪表板主体。我没有看到让通知正常工作的明显方法，应该将其发布在仪表板标题中。

我特地问这个问题是为了回答它，因为我在尝试解决这个问题时没有找到任何好的资源。

Answer 1

关键是在不同模块之间交换反应。在这个例子中，我专门为通知创建了一个模块。该模块返回一个允许其他模块发布通知的函数列表（使其有效地成为一个闭包）。请注意使用parent.env允许列表中的函数访问控制通知的内部反应值。

在server我们将通知功能列表输入到每个需要它的模块中。以下应用程序说明了我的解决方案。好消息是通知模块可以在任何其他应用程序中重复使用。

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)