javascriptrshinydtshinymodules

Action buttons in rows of a DT data table inside a module


Inspired by this post, I've written a shiny app with a module for a DT data table with two action buttons on each row.

Without the module the code works, as shown in the original post. Unfortunately, using the module I can't access the buttons id, so I think the problem is that the javascript code cannot handle the namespace provided by the module. Any idea to make it work?

app.R

library(shiny)
library(DT)

source("mymodule.R")

ui <- fluidPage(
   shiny::includeScript("script.js"),
   mymodule_ui("try")
)

server <- function(input, output, session) {
   mymodule_server("try")
}

shinyApp(ui = ui, server = server)

mymodule.R

mymodule_ui <- function(id) {
ns <- NS(id)

 div(class = "container",
     style = "margin-top: 50px;",
     DT::DTOutput(outputId = ns("dt_table"), width = "100%")
  )
}

mymodule_server <- function(id) {
    moduleServer(id, function(input, output, session) {
        ns <- session$ns

        btns <- lapply(1:32, function(x) {
            paste0(
                '<div class = "btn-group">
                 <button class="btn btn-default action-button btn-info" id="edit_',
                 x, '" type="button" onclick=get_id(this.id)><i class="far fa-pen-to-square"></i></button>
                 <button class="btn btn-default action-button btn-danger" id="delete_',
                 x, '" type="button" onclick=get_id(this.id)><i class="fas fa-trash-alt"></i></button></div>'
                  )
             }) |> unlist()


           df <- cbind(mtcars, btns)
           colnames(df) <- c(colnames(mtcars), "btns")

           output$dt_table <- DT::renderDT(df, escape = FALSE)

           observeEvent(input$current_id, {
               print("Hi!")
           })

  })

}

script.js

function get_id(clicked_id) {
    Shiny.setInputValue("current_id", clicked_id, {priority: "event"});
}

Solution

  • In Shiny.setInputValue(), you need to include the module id, e.g. "current_id" has to become "try-current_id".

    Extend get_id in script.js with a parameter module_id and include this in the onclick event which is defined in mymodule.R.

    script.js
    function get_id(module_id, clicked_id) {
        Shiny.setInputValue(module_id.concat('-', "current_id"), 
                            clicked_id, 
                            {priority: "event"});
    }
    
    mymodule.R
    mymodule_ui <- function(id) {
      ns <- NS(id)
      
      div(class = "container",
          style = "margin-top: 50px;",
          DT::DTOutput(outputId = ns("dt_table"), width = "100%")
      )
    }
    
    mymodule_server <- function(id) {
      moduleServer(id, function(input, output, session) {
        ns <- session$ns
        
        btns <- lapply(1:32, function(x) {
          sprintf(paste0(
            '<div class = "btn-group">
                     <button class="btn btn-default action-button btn-info" id="edit_',
            x, '" type="button" onclick=get_id(%s,this.id)><i class="far fa-pen-to-square"></i></button>
                     <button class="btn btn-default action-button btn-danger" id="delete_',
            x, '" type="button" onclick=get_id(%s,this.id)><i class="fas fa-trash-alt"></i></button></div>'
          ), paste0("'", id, "'"), paste0("'", id, "'"))
        }) |> unlist()
        
        
        df <- cbind(mtcars, btns)
        colnames(df) <- c(colnames(mtcars), "btns")
        
        output$dt_table <- DT::renderDT(df, escape = FALSE)
        
        observeEvent(input$current_id, {
          print("Hi!")
        })
        
      })
      
    }