Search code examples
rshinyr-markdownpagedown

Shiny app will not download pdf from chrome_print render of Rmd

I'm following the example at https://github.com/RLesur/chrome_print_shiny to build a Shiny app that will produce .pdf output from an .Rmd file. I can get the example app.R to run locally (for most of the selections), but modifying for an .Rmd that will eventually use render(params()) has not been successful.

ReportGenerator.Rmd

---
title: "Test Report"
output:
  pagedown::html_paged:
    includes:
    number_sections: false
    self_contained: true
    css:
       - default

params:
  gonna: "a"
  have: "b"
  some: "c"
  later: "d"
#knit: pagedown::chrome_print # commented out for use in Shiny
---

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

```{r cars}
summary(cars)
```

## Plot

```{r pressure}
plot(pressure)
```

app.R

library(pagedown)
library(promises)
library(rmarkdown)
library(shiny)
library(shinybusy)

chrome_extra_args <- function(default_args = c("--disable-gpu")) {
  args <- default_args
  # Test whether we are in a shinyapps container
  if (identical(Sys.getenv("R_CONFIG_ACTIVE"), "shinyapps")) {
    args <- c(args,
              "--no-sandbox", # required because we are in a container
              "--disable-dev-shm-usage") # in case of low available memory
  }
  args
}

# send the .Rmd to temp
tempReport <- tempfile(fileext=".Rmd")
file.copy("ReportGenerator.Rmd", tempReport, overwrite=TRUE)

ui <- fluidPage(
  actionButton( # build the report
    inputId="buildBtn",
    label="Build Report"
  ),
  uiOutput("downloadBtn") # download the report
)

server <- function(input, output) {
  observeEvent(input$buildBtn, {
    output$downloadBtn <- renderUI({
      show_modal_spinner()
      # generate PDF
      chrome_print(
        render(tempReport,
               # will have params here later
               envir = new.env(parent = globalenv())
        ),
        output=tempfile(fileext=".pdf"),
        extra_args=chrome_extra_args(),
        verbose=1,
        async=TRUE
      )$then(
        onFulfilled=function(value){
          showNotification("PDF file successfully generated", type="message")
          output$downloadBtn <- downloadHandler(
            filename="Report.pdf", 
            content=function(file){
              file.copy(value, file) # I think the problem is here?
            },
            contentType="application/pdf"
          )
          downloadButton(
            outputId="downloadBtn",
            label="Download Report"
          )
        },
        onRejected=function(error){
          showNotification(
            error$message,
            duration=NULL,
            type="error"
          )
          HTML("")
        }
      )$finally(remove_modal_spinner)
    })
    
  })
  
}

shinyApp(ui = ui, server = server)

Clicking the "Build Report" button does indeed generate the .pdf - using tempdir(), I can navigate to the temp directory for the session and see that the .Rmd has been roped in and the .pdf is right there, named with the usual tempfile hash, and looks as expected when opened. However, clicking the "Download Report" button does not provide the .pdf. Instead, I get a dialog box for an .html file that does not include the file name indicated in downloadHandler. Opening it produces an .html window that looks similar to the original Shiny app page.

dialog box for html download

Given that the .pdf does get generated, I'm guessing the issue is somewhere in downloadHandler(content), but I'm not familiar enough with how chrome_print(async=TRUE) works with library(promises), $then(), and temporary files to pull the .pdf out of the Temp directory and stick it in the handler.

Solution

  • Make output_file_path as a reactiveVal. This will serve as a storage point for the path to the generated PDF. Additionally, downloadHandler should be defined independently, utilizing the path retained in output_file_path.

    downloadHandler then leverages this stored path to facilitate the downloading of the PDF file: Attention shameless self promotion (some questions I asked on SO about this topic). See here, here, and here. These only are marginally related as I believe the issue in your case is coming from promises (but I am not sure):

    library(pagedown)
library(promises)
library(rmarkdown)
library(shiny)
library(shinybusy)

chrome_extra_args <- function(default_args = c("--disable-gpu")) {
  args <- default_args
  # Test whether we are in a shinyapps container
  if (identical(Sys.getenv("R_CONFIG_ACTIVE"), "shinyapps")) {
    args <- c(args,
              "--no-sandbox", # required because we are in a container
              "--disable-dev-shm-usage") # in case of low available memory
  }
  args
}

# send the .Rmd to temp
tempReport <- tempfile(fileext=".Rmd")
file.copy("ReportGenerator.Rmd", tempReport, overwrite=TRUE)

# <- changed here
ui <- fluidPage(
  titlePanel("ABR Dashboard"),
  actionButton(inputId = "buildBtn", label = "Build Report"),
  uiOutput("downloadBtn")
)

server <- function(input, output) {
    
    # new a path for the pdf
    output_file_path <- reactiveVal()
    
    observeEvent(input$buildBtn, {
      show_modal_spinner()
      # generate PDF
      promise <- chrome_print(
        input = render(tempReport,
                       # will have params here later
                       envir = new.env(parent = globalenv())
        ),
        output = tempfile(fileext = ".pdf"),
        extra_args = chrome_extra_args(),
        verbose = 1,
        async = TRUE
      )
      
      promise$then(
        onFulfilled = function(value) {
          output_file_path(value) # <- store to path to the generated pdf
          remove_modal_spinner()
          showNotification("PDF file successfully generated", type = "message")
        },
        onRejected = function(error) {
          remove_modal_spinner()
          showNotification(error$message, duration = NULL, type = "error")
        }
      )
    })
    
    output$downloadBtn <- renderUI({
      if (!is.null(output_file_path())) {
        downloadButton(outputId = "downloadPDF", label = "Download Report")
      }
    })
    
    output$downloadPDF <- downloadHandler(
      filename = "Report.pdf",
      content = function(file) {
        file.copy(output_file_path(), file, overwrite = TRUE)
      },
      contentType = "application/pdf"
    )

}

shinyApp(ui = ui, server = server)