如何在独立Shiny模块中绑定input_task_button()与ExtendedTask

问题说明 #

当将bslib::input_task_button()和ExtendedTask$new()分别放在不同的Shiny模块中时，无法成功完成绑定，但将二者放在同一模块内则可正常运行。以下是可复现的失败与成功代码示例：

失败的跨模块代码 #

future::plan(future::multisession)

# Module 1: Task Button
taskButtonUI <- function(id, label = "Recalculate") {
  ns <- shiny::NS(id)
  bslib::input_task_button(ns("recalc"), label)
}

taskButtonServer <- function(id) {
  shiny::moduleServer(id, function(input, output, session) {
    # Return the reactive trigger as well as the full namespaced button ID.
    list(
      trigger = shiny::reactive(input$recalc),
      btn_id = session$ns("recalc")
    )
  })
}

# Module 2: Extended Task
extendedTaskServer <- function(id, trigger, btn_id) {
  shiny::moduleServer(id, function(input, output, session) {
    rand_task <- ExtendedTask$new(function() {
      future::future({
        Sys.sleep(2)
        runif(1)
      }, seed = TRUE)
    })
    
    # Bind the task button (using the full namespaced id from the button module)
    bind_task_button(rand_task, btn_id)
    
    shiny::observeEvent(trigger(), {
      rand_task$invoke()
    })
    
    # Return the extended task object so that its result can be used by the app.
    rand_task
  })
}

ui <- bslib::page_sidebar(
  sidebar = bslib::sidebar(
    taskButtonUI("taskButton")
  ),
  shiny::textOutput("outval")
)

server <- function(input, output, session) {
  btn <- taskButtonServer("taskButton")
  rand_task <- extendedTaskServer("randTask", trigger = btn$trigger, btn_id = btn$btn_id)
  
  output$outval <- shiny::renderText({
    rand_task$result()
  })
}

shiny::shinyApp(ui, server)

成功的同模块代码 #

future::plan(future::multisession)

# Module 1: Task Button
taskButtonUI <- function(id, label = "Recalculate") {
  ns <- shiny::NS(id)
  bslib::input_task_button(ns("recalc"), label)
}

taskButtonServer <- function(id) {
  shiny::moduleServer(id, function(input, output, session) {
    
    rand_task <- ExtendedTask$new(function() {
      future::future({
        Sys.sleep(2)
        runif(1)
      }, seed = TRUE)
    }) |> bind_task_button("recalc")
    
    shiny::observeEvent(input$recalc, {
      rand_task$invoke()
    })
    
    rand_task
  })
}


ui <- bslib::page_sidebar(
  sidebar = bslib::sidebar(
    taskButtonUI("taskButton")
  ),
  shiny::textOutput("outval")
)

server <- function(input, output, session) {
  rand_task <- taskButtonServer("taskButton")
  
  output$outval <- shiny::renderText({
    rand_task$result()
  })
}

shiny::shinyApp(ui, server)

问题根源 #

跨模块绑定失败的核心原因是：bind_task_button默认会使用当前模块的命名空间处理传入的inputId。在失败代码中，btn_id已经是按钮模块的全命名空间ID（如taskButton-recalc），但在extendedTaskServer模块中调用bind_task_button时，该函数会再次用当前模块（randTask）的命名空间包裹这个ID，最终生成错误的ID（randTask-taskButton-recalc），导致无法匹配到实际的按钮元素。

解决方案 #

要解决这个问题，需要让bind_task_button使用按钮所在模块的命名空间解析ID，具体步骤如下：

1. 在按钮模块的server函数中，返回按钮的未命名空间ID以及按钮所在的session对象；
2. 在任务模块的server函数中，调用bind_task_button时传入按钮的未命名空间ID，并指定session参数为按钮模块的session。

修正后的完整代码 #

future::plan(future::multisession)

# Module 1: Task Button
taskButtonUI <- function(id, label = "Recalculate") {
  ns <- shiny::NS(id)
  bslib::input_task_button(ns("recalc"), label)
}

taskButtonServer <- function(id) {
  shiny::moduleServer(id, function(input, output, session) {
    list(
      trigger = shiny::reactive(input$recalc),
      btn_id = "recalc",  # 返回未命名空间的基础ID
      btn_session = session  # 返回按钮所在模块的session对象
    )
  })
}

# Module 2: Extended Task
extendedTaskServer <- function(id, trigger, btn_id, btn_session) {
  shiny::moduleServer(id, function(input, output, session) {
    rand_task <- ExtendedTask$new(function() {
      future::future({
        Sys.sleep(2)
        runif(1)
      }, seed = TRUE)
    })
    
    # 使用按钮模块的session来绑定按钮，确保ID匹配
    bind_task_button(rand_task, btn_id, session = btn_session)
    
    shiny::observeEvent(trigger(), {
      rand_task$invoke()
    })
    
    rand_task
  })
}

ui <- bslib::page_sidebar(
  sidebar = bslib::sidebar(
    taskButtonUI("taskButton")
  ),
  shiny::textOutput("outval")
)

server <- function(input, output, session) {
  btn <- taskButtonServer("taskButton")
  rand_task <- extendedTaskServer(
    "randTask", 
    trigger = btn$trigger, 
    btn_id = btn$btn_id,
    btn_session = btn$btn_session
  )
  
  output$outval <- shiny::renderText({
    rand_task$result()
  })
}

shiny::shinyApp(ui, server)

说明 #

通过传递按钮模块的session对象，bind_task_button会使用该session的命名空间生成正确的按钮ID，确保与UI中实际渲染的按钮ID完全匹配，从而实现跨模块的绑定功能。

内容的提问来源于stack exchange，提问作者Giovanni Colitti