rshiny

How can I use ExtendedTask with downloadbutton?


I'm trying to use non-blocking feature for shiny app along with a download button to improve intra-session concurrency, but it doesn't seem to work. I have been able to implement using async programming method however. Below is a simple example using async programming which works fine:

library(shiny)
library(future)
library(promises)
library(writexl)
library(data.table)

ui <- fluidPage(
  titlePanel("Cars Data"),
  uiOutput("download_format"),
  downloadButton("download_data", "Download")
)

server <- function(input, output) {
  
  output$download_format <- renderUI({
    radioButtons("download_format", "Download Format:", choices = c("CSV", "Excel"), inline = T)
  })
  
  output$download_data <- downloadHandler(
    filename = function() {
      if(input$download_format == "Excel") {
        paste("Data-", Sys.time(), ".xlsx", sep="")
      } else {
        paste("Data-", Sys.time(), ".csv", sep="")
      }
    },
    content = function(file) {
      
      download_format <- input$download_format
      
      future_promise({
        df <- mtcars
        Sys.sleep(10)
        if(download_format == "Excel") {
          writexl::write_xlsx(df, file)
        } else {
          data.table::fwrite(df, file)
        }
      })
    }
  )
}

shinyApp(ui = ui, server = server)

Thanks to @Mikko & @smartse, I'm now able to use ExtendedTask feature to download the data by enabling the download button once the data is ready but this involves a 2-step process. Below is the sample code:

library(shiny)
library(bslib)
library(future)
library(promises)
future::plan(multisession)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  titlePanel("Cars Data"),
  textOutput("time"),
  bslib::input_task_button("export", "Export", icon = icon("file-export")),
  downloadButton("download", "Download") |> shinyjs::hidden(),
)

server <- function(input, output, session) {
  # Just to prove UI is not blocked.
  output$time <- renderText({
    invalidateLater(1000)
    format(Sys.time())
  })
  
  # Task that prepares a file with the data for download.  
  export_task <- ExtendedTask$new(function(file) {
    promises::future_promise({
      data <- mtcars
      Sys.sleep(2)
      write.csv(data, file)
      file
    })
  }) |> bslib::bind_task_button("export")
  
  # Set up a reusable file for this session's download data.
  download_content_path <- tempfile("download_content")
  session$onEnded(function() unlink(download_content_path))
  
  observeEvent(input$export, export_task$invoke(download_content_path))
  
  # Show download button only when file is ready.
  observe({
    if (export_task$status() == "success") {
      showNotification("Your download is ready.")
      shinyjs::show("download")
    } else {
      shinyjs::hide("download")
    }
  })
  
  # Handle download with file prepared by task.  
  output$download <- downloadHandler(
    filename = function() {
      paste0("Data-", Sys.time(), ".csv")
    },
    content = function(file) {
      file.copy(export_task$result(), file)
    }
  )
}

shinyApp(ui = ui, server = server)

I would like to further improve the feature to be able to download the data without using additional download button. I modified it slightly, but it doesn't seem to work with Edge web browser and shiny version 1.10.0. All I'm getting is an html page in the download. Sample app:

library(shiny)
library(bslib)
library(future)
library(promises)
future::plan(multisession)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  titlePanel("Cars Data"),
  textOutput("time"),
  bslib::input_task_button("export", "Export", icon = icon("file-export")),
  downloadButton("download", "Download") |> shinyjs::hidden(),
)

server <- function(input, output, session) {
  # Just to prove UI is not blocked.
  output$time <- renderText({
    invalidateLater(1000)
    format(Sys.time())
  })
  
  # Task that prepares a file with the data for download.  
  export_task <- ExtendedTask$new(function(file) {
    promises::future_promise({
      data <- mtcars
      Sys.sleep(2)
      write.csv(data, file)
      file
    })
  }) |> bslib::bind_task_button("export")
  
  # Set up a reusable file for this session's download data.
  download_content_path <- tempfile("download_content")
  session$onEnded(function() unlink(download_content_path))
  
  observeEvent(input$export, export_task$invoke(download_content_path))
  
  # Show download button only when file is ready.
  observe({
    if (export_task$status() == "success") {
      showNotification("Your download is ready.")
      shinyjs::click("download")
      # shinyjs::runjs("$('#download')[0].click();")
      # shinyjs::runjs("document.getElementById('download').click();")
    }
  })
  
  # Handle download with file prepared by task.  
  output$download <- downloadHandler(
    filename = function() {
      paste0("Data-", Sys.time(), ".csv")
    },
    content = function(file) {
      file.copy(export_task$result(), file)
    }
  )
}

shinyApp(ui = ui, server = server)

Is there a way I can achieve one button click to download the data instead of 2-step process?

I also asked this question here (rstudio/shiny#4217).


Solution

  • Apparently "shinyjs::hidden()" updates css to "display:none;" which makes the button unclickable. After a small modification, it started working. Thanks @Mikko and @smartse for your input. Below is the working example with single click download using ExtendedTask feature:

    library(shiny)
    library(bslib)
    library(future)
    library(promises)
    future::plan(multisession)
    
    ui <- fluidPage(
      shinyjs::useShinyjs(),
      titlePanel("Cars Data"),
      textOutput("time"),
      bslib::input_task_button("export", "Export", icon = icon("file-export")),
      downloadButton("download", "Download", style = "position: absolute; left: -9999px; top: -9999px;"),
    )
    
    server <- function(input, output, session) {
      # Just to prove UI is not blocked.
      output$time <- renderText({
        invalidateLater(1000)
        format(Sys.time())
      })
      
      # Task that prepares a file with the data for download.  
      export_task <- ExtendedTask$new(function(file) {
        promises::future_promise({
          data <- mtcars
          Sys.sleep(2)
          write.csv(data, file)
          file
        })
      }) |> bslib::bind_task_button("export")
      
      # Set up a reusable file for this session's download data.
      download_content_path <- tempfile("download_content")
      
      observeEvent(input$export, export_task$invoke(download_content_path))
      
      # Show download button only when file is ready.
      observe({
        if (export_task$status() == "success") {
          showNotification("Your download is ready.")
          shinyjs::click("download")
        }
      })
      
      # Handle download with file prepared by task.  
      output$download <- downloadHandler(
        filename = function() {
          paste0("Data-", Sys.time(), ".csv")
        },
        content = function(file) {
          file.rename(export_task$result(), file)
        }
      )
    }
    
    shinyApp(ui = ui, server = server)