rshinybslib

How to bind input_task_button() to an ExtendedTask in separate shiny modules?


Is it possible to bind a bslib::input_task_button() to an ExtendedTask$new() if the two are in separate Shiny modules? I haven't been able to get it to work.

Here is a reprex:

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)

If I move the task input and ExtendedTask call inside the same module, it works as expected:

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)

Solution

  • The answer is to pass the session object from the module with the input to the module with the ExtendedTask$new() and use this as an arg inside bslib::bind_task_button():

    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 session.
        list(
          trigger = shiny::reactive(input$recalc),
          session = session
        )
      })
    }
    
    # Module 2: Extended Task
    extendedTaskServer <- function(id, res) {
      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", session = res$session)
        
        shiny::observeEvent(res$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) {
      res <- taskButtonServer("taskButton")
      rand_task <- extendedTaskServer("randTask", res)
      
      output$outval <- shiny::renderText({
        rand_task$result()
      })
    }
    
    shiny::shinyApp(ui, server)