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)

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

1 个答案: