Rhino框架+Shiny.Fluent模块间响应性传递失效问题排查

我正在使用Appsilon Rhino框架与shiny.fluent包开发模块化Shiny应用，需要实现用户下拉选择内容实时在另一面板展示，无需返回下拉框查看选择项。数据模块（用户输入）向选择模块（展示选择）传递数据，再经布局模块格式化后传入main.R与app.R。尝试过定义响应式元素、使用observe()和observeEvent()，但仍无法实现选择内容随用户操作实时更新，同一会话中用户可能多次切换列选择以获取不同结果。怀疑问题源于模块服务器的引用方式，以下是修正后的各模块代码：

修正后的data.R #

box::use(
  shiny.fluent[Dropdown.shinyInput, Separator, updateDropdown.shinyInput],
  shiny[moduleServer, NS, div],
  janitor[make_clean_names],
  magrittr[`%>%`],
  dplyr[mutate]
)

column_options <- c('column 1', 'column 2', 'column 3')

#' @export
ui <- function(id) {
  ns <- NS(id)
  div(
    Separator('fields'),
    Dropdown.shinyInput(
      ns('cols'),
      multiSelect = TRUE,
      value = character(0),  # 初始化为空，避免默认文本干扰多选
      options = column_options
    )
  )
}

#' @export
server <- function(id) {
  moduleServer(id, function(input, output, session) {
    # 暴露响应式选择结果
    cols_selected <- reactive(input$cols)
    
    list(
      cols_selected = cols_selected
    )
  })
}

修正后的selection.R #

box::use(
  shiny.fluent[DetailsList, Separator],
  shiny[moduleServer, NS, div, renderUI, uiOutput]
)

col_headers <- list(
  list(key = 'fields', fieldName = 'fields', name = 'Fields')
)

#' @export
ui <- function(id) {
  ns <- NS(id)
  div(
    Separator('selected fields'),
    uiOutput(ns('selected_list'))  # 用uiOutput实现动态更新
  )
}

#' @export
server <- function(id, cols_selected) {  # 接收传入的响应式对象
  moduleServer(id, function(input, output, session) {
    # 动态渲染选择列表
    output$selected_list <- renderUI({
      selected <- cols_selected()
      # 处理空选择的情况
      if (length(selected) == 0) {
        div("暂无选择列")
      } else {
        # 将选择项转为DetailsList需要的格式
        items <- lapply(selected, function(x) list(fields = x))
        DetailsList(items = items, columns = col_headers)
      }
    })
  })
}

修正后的layout.R #

box::use(
  shiny[moduleServer, NS, div, uiOutput, renderUI],
  shiny.fluent[Stack, fluentPage, Text],
  glue[glue]
)

box::use(
  app/view/selection,
  app/view/data
)

## header UI details ----
header <- div(
  class = "page-title",
  span('App', class = "title"),
  br(),
  span('data', class = "subtitle")
)

## helper functions ----
# 生成卡片组件
makeCard <- function(title, content, size = 12, style = "") {
  div(
    class = glue("card ms-depth-8 ms-sm{size} ms-xl{size}"),
    style = style,
    Stack(
      tokens = list(childrenGap = 5),
      Text(variant = "large", title, block = TRUE),
      content
    )
  )
}

# 页面布局函数
layout <- function(mainUI) {
  div(class = 'grid-container',
      div(class = 'header', header),
      div(class = 'main', mainUI)
  )
}

#' @export
ui <- function(id) {
  ns <- NS(id)
  fluentPage(
    uiOutput(ns('layout_content'))  # 动态渲染布局内容
  )
}

#' @export
server <- function(id) {
  moduleServer(id, function(input, output, session) {
    # 初始化数据模块
    data_module <- data$server('data')
    
    # 初始化选择模块，传递响应式数据
    selection$server('selection', cols_selected = data_module$cols_selected)
    
    # 动态渲染完整页面布局
    output$layout_content <- renderUI({
      layout(
        div(
          Stack(
            horizontal = TRUE,
            tokens = list(childrenGap = 10),
            makeCard('Choose Data', data$ui('data'), size = 3),
            makeCard('Current selections', selection$ui('selection'), size = 3)
          )
        )
      )
    })
  })
}

修正后的main.R #

box::use(
  shiny[tagList, moduleServer, NS]
)

box::use(
  app/view/layout
)

#' @export
ui <- function(id) {
  ns <- NS(id)
  tagList(
    layout$ui(ns('layout'))  # 仅加载布局模块，避免重复加载子模块UI
  )
}

#' @export
server <- function(id) {
  moduleServer(id, function(input, output, session) {
    layout$server('layout')  # 仅初始化布局模块，子模块由布局内部管理
  })
}

修正后的app.R #

# Rhino / shinyApp entrypoint. Do not edit.
rhino::app()

关键修正点说明 #

1. 移除重复模块实例化：确保数据模块只在布局模块中初始化一次，避免多个实例导致数据不共享
2. 动态UI渲染：选择模块使用renderUI+uiOutput实现实时更新，替代静态UI绑定
3. 响应式数据传递：选择模块的server函数直接接收传入的响应式对象，而非重新创建数据模块
4. 修复初始值问题：下拉框初始值改为空字符，避免默认文本干扰多选逻辑
5. 统一模块调用规范：全程使用Rhino推荐的moduleServer，弃用旧的callModule

内容的提问来源于stack exchange，提问作者Erik Renz