How to trigger a modalwindow with a click event using shiny.setInputValue inside a module

Question

My app triggers a modalwindow when a row inside a reactable table is clicked. It works fine with no modules, but when I used modules it doesn't.

I search for a solution and tried many variations with no success. (I found some similar questions, but none with a working solution for my problem).

First a working example with no modules:

if (interactive()) {
library(shiny)
library(reactable)

n = c(2, 3, 5) 
s = c("aa", "bb", "cc") 
b = c(TRUE, FALSE, TRUE) 
dframe = data.frame(n, s, b) 

shinyApp(
ui <- fillPage(
reactableOutput("table")
),

server <- function(input,output,session){
output$table <- renderReactable(
  reactable(dframe,
            compact = T,
            rowStyle = list(cursor = "pointer"),
            defaultColDef = colDef(align = "left", maxWidth = 60),
            onClick = JS("function(rowInfo) {
                        Shiny.setInputValue('name', {id:rowInfo.id})
                        }"),
  )
)
observeEvent(input$name, {
  row_nr <- as.numeric(input$name$id)+1
  showModal( modalDialog( title = dframe$s[row_nr]))
})
})}

The same app with modules:

library(shiny)
library(reactable)

n = c(2, 3, 5) 
s = c("aa", "bb", "cc") 
b = c(TRUE, FALSE, TRUE) 
dframe = data.frame(n, s, b) 


tUI <- function(idd){
  ns <- NS(idd)
  tagList(
    reactableOutput(ns("table"))
  )
}

tServer <- function(idd, d){
  moduleServer(idd,
               function(input, output, session){
                 output$table <- renderReactable(
                   reactable(d,
                             compact = T,
                             rowStyle = list(cursor = "pointer"),
                             defaultColDef = colDef(align = "left", maxWidth = 60),
                             onClick = JS("function(rowInfo) {
                          Shiny.setInputValue('idd-name', {id:rowInfo.id})
                          }"),
                   )
                 )
                 observeEvent(input$"idd-name", {
                   row_nr <- as.numeric(input$name$id)+1
                   showModal( modalDialog( title = dframe$s[row_nr]))
                 })
  })}

ui <- fillPage(
  tUI("tt")
)
server <- function(input,output,session){
  ttt <- tServer("tt", d = dframe)
}
shinyApp(ui,server)

(I called the namespace "idd" so there was no conflict with {id:rowInfo.id} - don't know if it makes any difference...)

I tried the following combinations:

(from https://community.rstudio.com/t/shiny-setinputvalue-in-modular-app-with-namespaces/23263):

Shiny.setInputValue('idd-name', ... observeEvent(input$name ...

(from How to use shiny.setInputValue within a module?):

Shiny.setInputValue('idd-name', ... observeEvent(input$name ...

Shiny.setInputValue('",idd,"-name', observeEvent(input$name ...

I tried I don't know how many combinations but with no success. Probably the solution is quite simple... Can someone help?

Thanks, António

Answer 1

Here is a partial solution. I'm not familiar with reactable so can't sort out the final wrinkle...

Your problem is that whilst Shiny knows about modules, JavaScript and the rest of R don't. So you have to take care when writing your JavaScript.

You also have a couple of syntax errors in your observeEvent. Let's put those right first.

      observeEvent(
        input[["idd-name"]], {
          row_nr <- as.numeric(input[["idd-name"]])+1
          showModal( modalDialog(title = dframe$s[row_nr]))
        }
      )

Note the use of [[]] rather than $ to access elements of Shiny's input array. Doing this allows the module to handle the namspacing for you. Also, I've corrected your definition of row_nr. This allows the title of the modal to be set correctly.

Now we need to handle the namespacing issue for Javascript. First, put the definition of the JS function into a variable, and use paste0 to manually handle the name spacing.

ns <- session$ns
jsCode <- paste0(
  "function(rowInfo) { Shiny.setInputValue('", 
  ns("idd-name"), 
  "', 
  {id:rowInfo.id}) }"
)

Your onClick argument then becomes

onClick = JS(jsCode)

This allows a modal to be displayed:

But clearly, the body of the modal needs work. I suspect you need to make more adjustments similar to those I have made elsewhere, but - as I said - I don't know reactable. Or did you intend to display a blank modal?

Here's the full code of the MWE.

library(shiny)
library(reactable)

n = c(2, 3, 5) 
s = c("aa", "bb", "cc") 
b = c(TRUE, FALSE, TRUE) 
dframe = data.frame(n, s, b) 


tUI <- function(idd){
  ns <- NS(idd)
  tagList(
    reactableOutput(ns("table"))
  )
}

tServer <- function(idd, d) {
  moduleServer(
    idd,
    function(input, output, session) {
      ns <- session$ns
                 
      jsCode <- paste0("function(rowInfo) { Shiny.setInputValue('", ns("idd-name"), "', {id:rowInfo.id}) }")
      
      output$table <- renderReactable(
        reactable(
          d,
          compact = T,
          rowStyle = list(cursor = "pointer"),
          defaultColDef = colDef(align = "left", maxWidth = 60),
          onClick = JS(jsCode),
        )
      )
                 
      observeEvent(
        input[["idd-name"]], {
          row_nr <- as.numeric(input[["idd-name"]])+1
          showModal( modalDialog(title = dframe$s[row_nr]))
        }
      )
    })
}

ui <- fillPage(
  tUI("tt")
)
server <- function(input,output,session){
  ttt <- tServer("tt", d = dframe)
}
shinyApp(ui,server)

Also, you wrote 'I called the namespace "idd"...'. Actually, you didn't. You called the namespace tt. The variable that stores the name of the namespace is idd. I wonder if that's the cause of some of your confusion...