Asynchronous Shiny App

app.R

library(shiny)
library(promises)
library(future)
plan(multiprocess)


long_running_function <- function(sleep = 3) {
  Sys.sleep(sleep)
  "Finished long_running_function()"
}

server <- function(input, output, session) {
  
  rv <- reactiveValues(timer = 1, timer_non_async = 1)
  output$status_non_async <- renderText("not yet started")
  output$status_async <- renderText("not yet started")
  
  output$time <- renderText({
    invalidateLater(millis = 1000, session)
    rv$timer <- isolate(rv$timer) + 1
    paste("Time available since start", rv$timer)
  })
  
  
  ################## NON-ASYNC ###############
  observeEvent(input$btn_non_async, {
    output$status_non_async <- renderText("Starting long running process")
    output$status_non_async <- renderText(long_running_function(sleep = 3))
    return(NULL)
  })
  
  
  ################## ASYNC ###############
  observeEvent(input$btn_async, {
    output$status_async <- renderText("Starting long running process")
    
    fut <- future({
      long_running_function(sleep = 3)
    })
    
    then(fut, onFulfilled = function(value) {
      output$status_async <- renderText(value)
    },
    onRejected = function(value) {
      output$status_async <- renderText("Failed!")
    })
    return(NULL)
  })
  
}

ui <- fluidPage(
  h2("Non Async Shiny - Blocking"),
  actionButton("btn_non_async", "Start in non-async!"),
  textOutput("status_non_async", inline = TRUE),
  hr(),
  
  h2("Async Shiny - Non Blocking"),
  actionButton("btn_async", "Start in async"),
  textOutput("status_async", inline = TRUE),
  hr(),
  
  verbatimTextOutput("time")
)

shinyApp(ui, server)