How to add a downloadButton in a popup?

Question

I'm currently developing an R Shiny application where I'm mapping services providers on a map and when I click on a specific marker I have a popup with additional information and I would like to include a downloadButton in that popup. Unfortunately when I'm calling the downloadHandler it doesn't work and I'm downloading a html file called qwe_download.html. But if I put the downloadButton outside the popup (i.e. in the ui) then it works. Is it possible to use a downloadButton inside a leaflet popup?

I can't share the original code as it is quite sensitive but you can find below what I'm trying to achieve.

library('leaflet')
library('shinydashboard')



id <- c(1, 2, 3)
lat <- c(10.01, 10.6, 10.3)
long <- c(0.2, 0.3, 0.4)
name <- c('test1', ' test2', 'test3')
test <- data_frame(id, lat, long, name)


#User interface

header <- dashboardHeader(title = 'Title', titleWidth = 900)

sidebar <- dashboardSidebar(
  width = 300)

body <- dashboardBody(
  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
  leafletOutput("map")
)

ui <- dashboardPage(header, sidebar, body)



server <- function(input, output, session) {
  
  data <- reactiveValues(clickedMarker=NULL)  
  
  output$map <- renderLeaflet({
    
    mymap <- leaflet() %>%
      addTiles() %>%
      addMarkers(data = test, lng = long, lat = lat, layerId = id,
                 popup = paste0(
                   "<div>",
                   "<h3>",
                   "Name:&nbsp;",
                   test$name,
                   downloadButton(outputId = "dlData",label =  "Download Details"),
                   "</div>"))
    
    observeEvent(input$map_marker_click,{
      print("observed map_marker_click")
      data$clickedMarker <- input$map_marker_click
      print(data$clickedMarker)
      x <- filter(test, id == data$clickedMarker$id)
      view(x)})
    
    data_react <- reactive({
      data_table <- filter(test, test$id == data$clickedMarker$id)
    })
    
    
    
    
    output$dlData <- downloadHandler(
      filename = "dataset.csv",
      content = function(file) {
        write.csv(data_react(), file)
      }
    )
    
   
    
    mymap
  })
  
}


# Run app ----
shinyApp(ui, server)

Note that the observeEvent block was just there for me to check if my code was filtering the right selection.

Hope this makes sense.

Thanks!

Answer 1

The download button is not binded to Shiny. You can use the pointerenter event to run Shiny.bindAll() and the pointerleave event to run Shiny.unbindAll():

library('leaflet')
library('shinydashboard')
library(shiny)
library(dplyr)

id <- c(1, 2, 3)
lat <- c(10.01, 10.6, 10.3)
long <- c(0.2, 0.3, 0.4)
name <- c('test1', ' test2', 'test3')
test <- tibble(id, lat, long, name)

js <- "$('body').on('pointerenter', '#dlData', function(){Shiny.bindAll('#dwnld');}).on('pointerleave', '#dlData', function(){Shiny.unbindAll('#dwnld');})"

header <- dashboardHeader(title = 'Title', titleWidth = 900)

sidebar <- dashboardSidebar(
  width = 300)

body <- dashboardBody(
  useShinyjs(),
  tags$script(HTML(js)),
  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
  leafletOutput("map")
)

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output, session) {
  
  data <- reactiveValues(clickedMarker=NULL)  
  
  
  output$map <- renderLeaflet({
    
    mymap <- leaflet() %>%
      addTiles() %>%
      addMarkers(
        data = test, lng = long, lat = lat, layerId = id,
        popup = paste0(
          "<div id='dwnld'>",
          "<h3>",
          "Name:&nbsp;",
          test$name,
          "</h3>",
          downloadButton(
            outputId = "dlData", label = "Download Details"
          ),
          "</div>")) 
    mymap
  })
  
  observeEvent(input$map_marker_click,{
    data$clickedMarker <- input$map_marker_click
  })
  
  data_react <- reactive({
    filter(test, id == data$clickedMarker$id)
  })
  
  output$dlData <- downloadHandler(
    "dataset.csv",
    content = function(file) {
      write.csv(data_react(), file)
    })

}

# Run app ----
shinyApp(ui, server)

Answer 2

You need to bind the downloadButtons yourself after placing them in the popup.

Please see this related answer from Joe Cheng.

Here you can find some great answers on how to bindAll custom inputs in a leaflet popup.

And this is how to apply those answers regarding your particular requirements:

library('leaflet')
library('shinydashboard')

id <- c(1, 2, 3)
lat <- c(10.01, 10.6, 10.3)
long <- c(0.2, 0.3, 0.4)
name <- c('test1', ' test2', 'test3')
test <- data.frame(id, lat, long, name)

header <- dashboardHeader(title = 'Title', titleWidth = 900)

sidebar <- dashboardSidebar(width = 300)

body <- dashboardBody(
  tags$div(id = "garbage"),
  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
  leafletOutput("map")
)

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output, session) {
  data <- reactiveValues(clickedMarker = NULL)
  
  output$map <- renderLeaflet({
    mymap <- leaflet() %>%
      addTiles() %>%
      addMarkers(
        data = test,
        lng = long,
        lat = lat,
        layerId = id,
        popup = sprintf(
          paste0(
            "<div>",
            "<h3>",
            "Name:&nbsp;",
            test$name,
            br(),
            downloadButton(outputId = "dlData%s", label =  "Download Details"),
            "</div>"
          ),
          id
        )
      ) %>% htmlwidgets::onRender(
        'function(el, x) {
              var target = document.querySelector(".leaflet-popup-pane");
            
              var observer = new MutationObserver(function(mutations) {
                mutations.forEach(function(mutation) {
                  if(mutation.addedNodes.length > 0){
                    Shiny.bindAll(".leaflet-popup-content");
                  }
                  if(mutation.removedNodes.length > 0){
                    var popupNode = mutation.removedNodes[0];
            
                    var garbageCan = document.getElementById("garbage");
                    garbageCan.appendChild(popupNode);
            
                    Shiny.unbindAll("#garbage");
                    garbageCan.innerHTML = "";
                  }
                });
              });
            
              var config = {childList: true};
            
              observer.observe(target, config);
            }'
      )
  })
  
  observeEvent(input$map_marker_click,{
    print("observed map_marker_click")
    data$clickedMarker <- input$map_marker_click
    print(data$clickedMarker)
    x <- filter(test, id == data$clickedMarker$id)
    })
  
  data_react <- reactive({
    data_table <- filter(test, test$id == data$clickedMarker$id)
  })
  
  lapply(id, function(i) {
    output[[paste0("dlData", i)]] <- downloadHandler(
      filename = "dataset.csv",
      content = function(file) {
        write.csv(data_react(), file)
      }
    )
  })
  
}

shinyApp(ui, server)