namespacing from shiny module server

Hi everyone! I could be confounding some issues here but I want to dynamically create download buttons in a table using server side logic, and I think this code doesn't work because I'm not NSing properly?

In the dummy app below, we're using a file path (here my desktop, youll have to change this locally to a directory with files) and the app will display the names of those files, and I'd like the DOWNLOAD button to download said file.

library(shiny)

# function to make inputs
shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
}


mod_data_ui <- function(id) {
    fluidPage(
        DT::dataTableOutput(NS(id, "data")),
        textOutput(NS(id, 'myText'))
    )
}


mod_data_server <- function(id, trainingname) {
    moduleServer(id, function(input, output, session) {
        
        path <- "/Users/mayagans/Desktop/"
        
        datafiles <- reactiveValues(
            names = unlist(list.files(path)),
            number = length(unlist(list.files(path))),
            file = NULL
        )
        
        
        df <- reactive({
            data.frame(
                Files = datafiles$names,
                Delete = shinyInput(downloadLink, 
                                    datafiles$number, 
                                    NS(id, 'delete_btn_'), 
                                    label = "DOWNLOAD", 
                                    class="delete_btn", 
                                    onclick = paste0('Shiny.setInputValue(\"', NS(id, "select_button"), '\", this.id)'))
            )
            
        })

        
        output$data <- DT::renderDT({
            DT::datatable(
                df(),
                escape = FALSE,
                selection = 'none',
                rownames = FALSE,
                options(
                    dom = 'lrt',
                    bFilter = FALSE,
                    bInfo = FALSE,
                    paging = FALSE,
                    lengthChange = FALSE
                )
            )
        }, server = FALSE)
        
        observeEvent(input$select_button, {
            selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][3])
            datafiles$file <- paste('click on ',df()$Files[selectedRow])
        
            
            # I think I need to gsub out the namespace
            # because the server does this for free?
            # but output[[input$select_button]] isnt working
            
            browser()
             output[[gsub(".*-", "", input$select_button)]] <- downloadHandler(
                filename = function() {
                    list.files(path)[selectedRow]
                },
                content = function(file) {
                    file.copy(
                        paste0(
                            path,
                            unlist(list.files(path))[selectedRow]
                        ),
                        file
                    )
                }
            )
        })
        
        output$myText <- renderText({ datafiles$file })
    })

}







# the app

ui <- fluidPage(mod_data_ui("data"))


server <- function(input, output) {
    mod_data_server("data")
}



shinyApp(ui = ui, server = server)

this should work:
1)

mod_data_ui <- function(id) {
  fluidPage(
    DT::dataTableOutput(NS(id)("data")),
    textOutput(NS(id)("text"))
  )
}

or the conventional way:

mod_data_ui <- function(id) {
ns <- NS(id)
  fluidPage(
    DT::dataTableOutput(ns("data")),
    textOutput(ns("text"))
  )
}

Hi,

library(shiny)
library(shinyjs)

mod_data_ui <- function(id) {
  ns <- NS(id)
  fluidPage(
    DT::dataTableOutput(ns("data")),
    textOutput(ns("myText")),
    # here you create a generic download btn and hide it
    # unfortunately using display:hidden prevents it from being clickable
    # so the trick is to reduce its size and disable overflow
    tags$div(style="position:fixed; top:0; left:0; height:0; width:0; overflow:overlay;",
             downloadButton(ns("down_gene"), "Download"))
  )
}

mod_data_server <- function(id, trainingname) {
  moduleServer(id, function(input, output, session) {
    path <- "/Users/mayagans/Desktop/"
    
    datafiles <- reactiveValues(files = unlist(list.files(path, full.names = TRUE)),
                                idx = integer(),
                                selected = character())
    
    # I removed the reactive df and placed it directly into the rendered table
    output$data <- DT::renderDT({
      DT::datatable(
        data.frame(
          Files = basename(datafiles$files),
          # here I created actionButton rather than download link
          Delete = sapply(1:length(datafiles$files), FUN = function(i) {
            as.character(actionButton(inputId = paste0("download_btn_", i),
                                      label = "Download",
                                      icon = icon("download", lib = "font-awesome"),
                                      onclick = paste0('Shiny.setInputValue(\"', NS(id, "select_button"), '\", this.id)')))
          })
        ),
        escape = FALSE,
        selection = 'none',
        rownames = FALSE,
        options(
          dom = 'lrt',
          bFilter = FALSE,
          bInfo = FALSE,
          paging = FALSE,
          lengthChange = FALSE
        )
      )
    }, server = FALSE)
    
    observeEvent(input$select_button, ignoreNULL = TRUE, {
      # here you retrieve which input has been clicked
      datafiles$idx <- as.integer(strsplit(input$select_button, "_")[[1]][3])
      datafiles$selected <- datafiles$files[datafiles$idx]
      
      ## with some magic from shinyjs 
      # you reinit select_button so that same link can be click again
      runjs(code = paste0('Shiny.setInputValue(\"', NS(id, "select_button"), '\", null)'))
      # you forward click action to down_gene
      click("down_gene")
    })
    
    output$down_gene <- downloadHandler(
      filename = function() {
        datafiles$selected
      },
      content = function(file) {
        file.copy(from = datafiles$selected, to = file)
      })
    
    output$myText <- renderText({ paste('click on', basename(datafiles$selected)) })
  })
  
}

# the app
ui <- fluidPage(shinyjs::useShinyjs(), mod_data_ui("data"))


server <- function(input, output) {
  mod_data_server("data")
}

shinyApp(ui = ui, server = server)

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.