ModuleServer combined with modalDialog - modalDialog quits after first usage - r

Question

In my Shiny application, I have the functionality to insert a new line of information, this is done via InsertUI. Then for every added line, the source of that line can be updated via an actionButton. The actionButton leads to a modalDialog, allowing the user to insert the text for the source there.
To prevent multiple lines getting the same source after updating, a moduleServer is used for the part around the modalDialog. That works well, with the only exception that after the first time the modalDialog is used (with inside an action button that updates the text after insertion), the modalDialog closes directly after clicking. Reclicking does give the pop-up again, but is somewhat annoying.
Any suggestions to prevent this?
Example UI and server with this behaviour:
UI.R
library(shiny)
shinyUI(fluidPage(
div(id = "input_add_div_block"),
br(),
# Input for the new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
textInput(inputId = "input_new_line",
label = "Give description of new line")
),
# Adding a new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
id = "input_add_div",
actionButton("input_add", "Add new line")
)
))
Server.R
library(shiny)
shinyServer(function(input, output, session) {
data <- reactiveValues(
lines = list()
)
observeEvent(input$input_add, {
current_lines <- length(data$lines)
n <- current_lines + 1
insertUI(selector = "#input_add_div_block",
where = "beforeEnd", # insert after last element
ui = fluidPage(
div(style="display:inline-block"), # div inline-block is used to get two input boxes on the same line
# Adding input field
numericInput(inputId = paste0("input_", n),
label = paste0(input$input_new_line, " - % of previous line"),
value = 10,
min = 0,
max = 100
),
actionButton(inputId = paste0("input_", n,"_source"),
label = "No source")
)
)
observeEvent(input[[paste0("input_", current_lines+1,"_source")]],{
update_source_UI(id = paste0("source",n), data = data, n = n)
update_source_Server(id = paste0("source",n), data = data, n = n, original_session = session)
})
})
})
update_source_UI <- function(id, data, label = "Update UI", n){
ns <- NS(id)
showModal(
modalDialog(
title = "Update source",
textInput(inputId = ns("new_source"), label = "Update the source",
value = "Assumption"),
actionButton(inputId = ns("add_source"),
label = "Update the source"),
"\n",
actionButton(inputId = ns("cancel"),
label = "Cancel"),
easyClose = TRUE,
footer = NULL
)
)
}
# Pop-up to change the source of the funnel line input
update_source_Server <- function(id, data, n, original_session){
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
# When the user clicks "Update the source", the source is updated
observeEvent(input$add_source,{
updateActionButton(session = original_session,
inputId = paste0("input_", n,"_source"),
label = paste0("Source: ", input$new_source))
removeModal()
data$button_status[[1]] <- FALSE
})
# When the user clicks "Cancel", the modal is removed without changes
observeEvent(input$cancel,{
removeModal()
})
}
)
}

Answer 1

A few points:
I've never seen showModule in the UI part, normally you use it in the server; it's interesting that it works nevertheless
at least in your example, n is always 1, therefore you don't have unique ids which leads to problems
I find passing session objects to modules to refer to something defined in the main server quite complicated
I propose to pack everything for one line into a module and then handle the logic there. I think it's easier and you already work with modules.
My take:
library(shiny)
one_line_UI <- function(id, input_new_line){
ns <- NS(id)
tagList(
div(style="display:inline-block"), # div inline-block is used to get two input boxes on the same line
# Adding input field
numericInput(inputId = ns("input_number"),
label = paste0(input_new_line(), " - % of previous line"),
value = 10,
min = 0,
max = 100
),
actionButton(inputId = ns("input_source"),
label = "No source")
)
}
# Pop-up to change the source of the funnel line input
one_line_Server <- function(id, data){
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
observeEvent(input$input_source, {
showModal(
modalDialog(
title = "Update source",
textInput(inputId = ns("new_source"), label = "Update the source",
value = "Assumption"),
actionButton(inputId = ns("add_source"),
label = "Update the source"),
"\n",
actionButton(inputId = ns("cancel"),
label = "Cancel"),
easyClose = TRUE,
footer = NULL
)
)
})
# When the user clicks "Update the source", the source is updated
observeEvent(input$add_source,{
updateActionButton(inputId = "input_source",
label = paste0("Source: ", input$new_source))
removeModal()
data$button_status[[1]] <- FALSE
})
# When the user clicks "Cancel", the modal is removed without changes
observeEvent(input$cancel,{
removeModal()
})
}
)
}
ui <- fluidPage(
div(id = "input_add_div_block"),
br(),
# Input for the new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
textInput(inputId = "input_new_line",
label = "Give description of new line")
),
# Adding a new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
id = "input_add_div",
actionButton("input_add", "Add new line")
)
)
server <- function(input, output, session) {
data <- reactiveValues(
lines = list(),
n = 0
)
observeEvent(input$input_add, {
n <- data$n + 1
insertUI(selector = "#input_add_div_block",
where = "beforeEnd", # insert after last element
ui = one_line_UI(id = n,
input_new_line = reactive({input$input_new_line}))
)
one_line_Server(id = n, data = data)
data$n <- n
})
}
shinyApp(ui, server)
If you want more information, you can also check out my tutorial how to dynamically add modules.