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

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
```