Shiny modal module stacking?

[millerh1]

Hello! I am having a strange issue with shiny modals in modules (pictured in the gif below). After every new user input, the modal appears to stack another modal on top of all the previous ones. The result is that the action button in the modal registers a click for every previous change in user input.

This is the code:

library(shiny)


doThingModalUI <- function(id) {
  ns <- NS(id)
  actionButton(ns("openModalBtn"), "Send result to modal")
}

doThingModal <- function(input, output, session) {
  
  # Observe open modal button -- opens modal
  observeEvent(input$openModalBtn, {
    ns <- session$ns
    showModal(ui = shiny::modalDialog(size = "l", {
      actionButton(inputId = ns("doThing"), label = "Analyze")
    }, title = "Do Thing!"), session = session)
  }, ignoreInit = TRUE, autoDestroy = TRUE)
  
  # Observe doThing button -- runs the modal process
  observeEvent(input$doThing, {
    ns <- session$ns
    progress <- shiny::Progress$new()
    on.exit(progress$close())
    progress$set(message = "Doing thing!", value = .3)
    Sys.sleep(3)
  }, ignoreInit = TRUE)
}

ui <- fluidPage(
  h1("Minimal example of modal button double-activation"),
  hr(),
  selectInput(inputId = "selectInput", 
              label = "Select option", 
              choices = c("A", "B", "C"), selected = "A"),
  actionButton(inputId = "doMain", label = "Go"),
  textOutput(outputId = "textOut"),
  br(),
  doThingModalUI("modalExamp"),
  hr()
)

server <- function(input, output, session) {
  
  textOut <- eventReactive(input$doMain, {
    input$selectInput
  })
  output$textOut <- renderText({
    textOut()
  })
  
  observeEvent(textOut(), {
    callModule(doThingModal, "modalExamp")
  })
}

shinyApp(ui = ui, server = server)

I can fix it by taking the callModule() out of the observeEvent(). Yet, I do not understand why this is necessary. I want to be able to pass the user input into the modal, and am unsure how to do this if the callModule() code is not inside of a reactive expression. Any advice would be greatly appreciated! Thank you!

[raytong]

Hi @millerh1. Your code is interesting. You callModule function was triggered by the reactive testOut(), so every time you trigger the callModule will create one new observeEvent to listen the input$doThing. This is the reason why the progress bar appear for the number of time that you trigger the textOut. This can terminate by destroying the observeEvent once it trigger with the argument once = TRUE. Hope I make myself clear.

  observeEvent(input$doThing, {
    ns <- session$ns
    progress <- shiny::Progress$new()
    on.exit(progress$close())
    progress$set(message = "Doing thing!", value = .3)
    Sys.sleep(3)
  }, ignoreInit = TRUE, once = TRUE)

[millerh1]

Thank you so much! I definitely misunderstood how once worked so I didn't even consider it!

Just to add on, another answer I just discovered that I think works well is to place callModule() outside the observer, and just pass it reactive values that are evaluated within it.

[raytong]

Yes. usually callModule called outside the observer but it was not a strict rule. It depends on the logic of your application.