Shiny namespace issue with nested callModules - r

Question

I’m looking for some help with a simple Shiny app with a modularised design please. I think the problem is a name space issue so the example below is set out as a simplified version of my actual project. My feeling is that I have not set output$uis to the correct name space but I am lost on how to map to it.
The app generates 3 instances of select_formUI and should be namespace related to 3 instances of the server returned values from the callModules of select_form. The values from select_form are passed out in a tibble. The inner module binds all 3 tibbles into one reactive tibble all_gen_forms_rctv.
The process works fine until I uncomment the input_slt_type_db column in pass_back_test, which returns the input$slt_type_db. I’m looking for some help please to include this column in the output and see all_gen_forms_rctv change on user selections via output$outpt_test.
library(shiny)
library(shinyjs)
library(glue)
library(tibble)
select_formUI <- function(id){
ns <- NS(id)
tagList(selectInput(ns('slt_type_db'), 'select letter', choices = letters[1:5]))
}
select_form <- function(input, output, session){
#pass_back_test <- reactive({
tibble(
placehold = "FILL VALUE"
# , input_slt_type_db = input$slt_type_db
)
})
return(list(pass_back_test = reactive({pass_back_test()})))
}
inner_moduleUI <- function(id){
ns <- NS(id)
tagList(uiOutput(ns("outpt_forms_ui")))
}
inner_module <- function(input, output, session){
rctval_ui <- reactiveValues(all_ui=NULL)
gen_forms <- reactiveValues()
all_gen_forms_rctv <- reactive({
dplyr::bind_rows(lapply(reactiveValuesToList(gen_forms), function(current_module_output) {
current_module_output$pass_back_test()
}))
})
observeEvent(input$btn_start ,{
for(i in 1:3){
x_id = glue("mod_{i}")
rctval_ui$all_ui[[x_id]] <- select_formUI(x_id)
gen_forms[[x_id]] <- callModule(select_form, x_id)
}
})
output$outpt_forms_ui <- renderUI({
ns <- session$ns
tagList(
actionButton(ns('btn_start'), label = 'start'),
verbatimTextOutput(ns('outpt_test')),
hr(),
uiOutput(ns('uis'))
)
})
output$uis <- renderUI({
ns <- session$ns
tags$div(id = environment(ns)[['namespace']],
tagList(rctval_ui$all_ui))
})
output$outpt_test <- renderPrint({all_gen_forms_rctv()})
}
ui <- fluidPage(
useShinyjs(),
uiOutput('main_ui')
)
server <- function(input, output, session) {
output$main_ui <- renderUI({inner_moduleUI('inner_ns')})
callModule(inner_module, 'inner_ns')
}
shinyApp(ui = ui, server = server)

Answer 1

the problem is that the UI function of the select_form modul doesn't know that it is being called within another module. So you need to tell it by wrapping the the id in session$ns. The callModule function can handle this by itself so here there is no need to change anything. The inner_module function would the look like this
inner_module <- function(input, output, session) {
rctval_ui <- reactiveValues(all_ui=NULL)
gen_forms <- reactiveValues()
all_gen_forms_rctv <- reactive({
browser()
dplyr::bind_rows(lapply(reactiveValuesToList(gen_forms), function(current_module_output) {
current_module_output$pass_back_test()
}))
})
observeEvent(input$btn_start ,{
for(i in 1:3){
x_id = glue("mod_{i}")
rctval_ui$all_ui[[x_id]] <- select_formUI(session$ns(x_id))
gen_forms[[x_id]] <- callModule(select_form, x_id)
}
})
output$outpt_forms_ui <- renderUI({
ns <- session$ns
tagList(
actionButton(ns('btn_start'), label = 'start'),
verbatimTextOutput(ns('outpt_test')),
hr(),
uiOutput(ns('uis'))
)
})
output$uis <- renderUI({
ns <- session$ns
tags$div(id = environment(ns)[['namespace']],
tagList(rctval_ui$all_ui))
})
output$outpt_test <- renderPrint({all_gen_forms_rctv()})
}