CODEWITHSUNDEEP
rshinynamespacesshinyjs
CallumH
CallumH

Reputation: 779

Shiny namespace issue with nested callModules

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)

Upvotes: 1

Views: 519

Answers (1)

Bertil Baron
Bertil Baron

Reputation: 5003

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()})
  
}

Upvotes: 2

Related Questions