CODEWITHSUNDEEP
javascriptrshinydtshinymodules
Ndr
Ndr

Reputation: 574

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"});
}

Upvotes: 2

Views: 80

Answers (1)

Jan
Jan

Reputation: 8856

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!")
    })
    
  })
  
}

Upvotes: 0

Related Questions