How to trigger a download handler from a custom button in Shiny

Question

I have a shiny app. The app contains a table. Each row in the table contains one button that should allow a user to download the data from that row into a report.

I am simply stuck on being able to hook the custom row button to the download handler. Normally I'd use the download button to do this but how can I do it with a custom button.

My observe event:

observeEvent(input$lastClick,
               {
                 if (input$lastClickId%like%"letter")
                 {
                   row_to_report=as.numeric(gsub("letter_","",input$lastClickId))
                   MyLetter=RV4$data[row_to_report,]

How do I trigger the download here using the downloadHandler:

                 downloadHandler(
                 filename = "letter.docx",
                 content = function(file) {
                   tempReport <- file.path(tempdir(), "letter.Rmd")
                   file.copy("letter.Rmd", tempReport, overwrite = TRUE)

                   # Set up parameters to pass to Rmd document
                   params <- list(MyLetter)

                   rmarkdown::render(tempReport, output_file = file,
                                     params = params,
                                     envir = new.env(parent = globalenv()),

                   )
                 }
               )
             }
             else if (input$lastClickId%like%"delete")
             {
               row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
               RV3$data=RV3$data[-row_to_del,]
             }
           }

)

My datatable is created like this:

  output$drilldownBarr <- DT::renderDT({

      if (!is.null(drilldataBarrd())) {  

        browser()
        drilldataBarrdf<-drilldataBarrd()
        drilldataBarrdf$Actions<-
         paste0('
                <div class="btn-group" role="group" aria-label="Basic example">
                <button type="button" class="btn btn-secondary letter" id=letter_',1:nrow(drilldataBarrd()),'>Letter</button>
                </div>
                ')
     }

    datatable(drilldataBarrdf,escape=F, extensions = c("Select","Buttons"), selection = "none",

              options = list(
                scrollX = TRUE,
                scrollY = TRUE,
                pageLength = 200,
                select = "api",
                dom = 'Bfrtip',
                buttons = c('copy', 'csv', 'excel', 'pdf', 'print','colvis'))
    )
  })

Perhaps there is a better way? For example creating a download button in each row. But how to do this?

Answer 1

Here is a solution using base64 encoding of the report file. It does not use downloadHandler.

library(shiny)
library(DT)
library(base64enc)
library(rmarkdown)

js <- '
Shiny.addCustomMessageHandler("download", function(b64){
  const a = document.createElement("a");
  document.body.append(a);
  a.download = "report.docx";
  a.href = b64;
  a.click();
  a.remove();
})
'

buttonHTML <- function(i){
  as.character(
    actionButton(
      paste0("button_", i), label = "Report", 
      onclick = sprintf("Shiny.setInputValue('button', %d);", i)           
    )
  )
}

dat <- iris[1:5,]
dat$Action <- sapply(1:nrow(dat), buttonHTML)

ui <- fluidPage(
  tags$head(tags$script(HTML(js))),
  br(),
  DTOutput("dtable")
)

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

  output[["dtable"]] <- renderDT({
    datatable(dat, escape = -ncol(dat)-1)
  })

  observeEvent(input[["button"]], {
    showNotification("Creating report...", type = "message")
    tmpReport <- tempfile(fileext = ".Rmd")
    file.copy("report.Rmd", tmpReport)
    outfile <- file.path(tempdir(), "report.docx")
    render(tmpReport, output_file = outfile, 
           params = list(data = dat[input[["button"]], -ncol(dat)]))
    b64 <- dataURI(
      file = outfile, 
      mime = "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
    )
    session$sendCustomMessage("download", b64)
  })

}

shinyApp(ui, server)

The rmarkdown file report.Rmd:

---
title: "Untitled"
author: "Stéphane Laurent"
date: "16 avril 2020"
output: word_document
params:
  data: "x"
---

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

```{r}
params$data
```