future_promise in the downloadHandler for an R markdown render is still hanging up my Shiny app

I have an R Shiny application that generates an R markdown pdf via the downloadHandler. It takes a few seconds to generate the pdf for download and it hangs up my Shiny app without any indication that it is working on it before the download is available. I am trying to use the future_promise feature to generate the R markdown while the user is still able to use the Shiny app.

I have created a simple example that attempts to use the future_promise unsuccessfully; the app does not react to the slider input changes after I click the download button until the download is available.

Shiny App:

library(shiny)
library(promises)
library(future)

plan(multisession)

# Define UI for application that draws a histogram
ui <- fluidPage(
  
    titlePanel("Old Faithful Geyser Data"),

    sidebarLayout(
        sidebarPanel(
            sliderInput("bins",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30),
            downloadButton("makePDF", "Download PDF")
        ),

        mainPanel(
           plotOutput("distPlot")
        )
    )
)

server <- function(input, output) {

    output$distPlot <- renderPlot({
        x    <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = input$bins + 1)

        hist(x, breaks = bins, col = 'darkgray', border = 'white',
             xlab = 'Waiting time to next eruption (in mins)',
             main = 'Histogram of waiting times')
    })
    
    output$makePDF <- downloadHandler(
      
      filename = function() {
        paste("Histogram", ".pdf", sep = "")
      },
      
      content = function(file) {
        req(input$bins)
        varbins <- input$bins
        
        future_promise({
        tempReport <- file.path(tempdir(), "Histogram.Rmd")
        file.copy("Histogram.Rmd", tempReport, overwrite = TRUE)
        Sys.sleep(5)
        rmarkdown::render(tempReport, output_file = file,
                          params = list(vbins = varbins),
                          envir = new.env(parent = globalenv()))
        })
      }
    )
}

shinyApp(ui = ui, server = server)`

Histogram.Rmd:

    ---
    title: "Untitled"
    output: 
      pdf_document:
        latex_engine: xelatex

    params:
      vbins: 10
    ---

    ```{r setup, include=FALSE}
    knitr::opts_chunk$set(echo = TRUE)
    ```
    ## Including Plots

    You can also embed plots, for example:

    ```{r pressure, echo=FALSE}
    plot(pressure)

        # generate bins based on input$bins from ui.R
        x    <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = params$vbins + 1)

        # draw the histogram with the specified number of bins
    hist(x, breaks = bins, col = 'darkgray', border = 'white',
         xlab = 'Waiting time to next eruption (in mins)',
         main = 'Histogram of waiting times')

    ```

Any help would be appreciated! Thank you

The problem with your example is that the futures is called inside the downloadHandler so that will be busy until the result is available. You need to render the document outside of the downloadHandler and just copy it once it is ready.

Here's an example - the two buttons are required so that the render and download are separate operations but they appear like one to the user as the downloadButton is invisible and triggered by {shinyjs} once the render is complete.

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

ui <- fluidPage(
  useShinyjs(),
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30),
      textOutput("time"),
      bslib::input_task_button("download", "Download", icon = shiny::icon("download")),
      div(style = "visibility: hidden;",
        downloadButton("makePDF", "Download PDF")
      )
)

server <- function(input, output, session) {

  # function to create report
  make_report <- function(bins){
    output_file <- tempfile(fileext = ".pdf")
    Sys.sleep(5)
    rmarkdown::render("Histogram.Rmd", output_file = output_file,
                      params = list(vbins = bins))
    output_file
  }

  # task that calls the function
  task <- ExtendedTask$new(function(...){
    future_promise(make_report(...))
  }) |> bslib::bind_task_button("download")

  # start the task
  observeEvent(input$download, {
    req(input$bins)
    task$invoke(input$bins)
  })

  # wait for the render to complete and then trigger the download
  observe({
    task$result()
    shinyjs::runjs("document.getElementById('makePDF').click();")
  })

  output$makePDF <- downloadHandler(
    filename = function() {"Histogram.pdf"},
    content = function(file) {file.copy(task$result(), file)}
  )

  output$time <- renderText({
      invalidateLater(1000, session = session)
      Sys.time()
    })
}

shinyApp(ui = ui, server = server)