Nested server modules - how to use global instead of local namespace inside inner module?

[ansokolov]

Hello,
I am having some trouble with nested modules. I am trying to update an input based on the change in another input using a nested module approach. I fully get how to do this without modules. In the advanced case I would like to pass an arbitrary module creating function into another module.
Here is the simple reprex.
The outer module is observing the first input and after detecting the change in the first input, is calling the inner module.
The inner module is supposed to change the choices in the second input.

If I run these separately, they work. However, when I nest them, they do not work.

I think the reason is that the inner module is looking for the namespace = 2 INSIDE of the namespace = 1. So then the updateselecticizeInput is looking for a something like 1-2-input$value. This sort of makes sense to me.

I demonstrate that this is true by literally labeling the namespace of the input as "1-2".

So how can I change the code below to ensure that the inner module is looking in the global namespace instead of the local one provided by the outer function?

Thanks!
Anatoliy

library(shiny)


outer = function(id) {
    moduleServer(id,
                 function(input, output, session) {
                     observeEvent(input$value, {
                         print(paste("outer = ", input$value))
                         inner("2")
                     })
                 })
}


inner = function(id) {
    moduleServer(id, function(input, output, session) {

        # using this as a print statement to check for detection
        observeEvent(input$value, {
            print(paste("inner = ", input$value))
        })
        print("Calling inner module")
        ## ideally I want to call this
       # updateSelectizeInput(session, inputId = "value", choices = "x")

    })
}

listUI = function(index, phrasing, level)
{
    ns <- NS(index)
    selectizeInput(inputId = ns("value"), label = phrasing, choices = level)
}

ui <- fluidPage(

    titlePanel("module nesting"),
        mainPanel(
           listUI(index = "1", phrasing = "test", level = c("a", "b")),
           listUI(index = "2", phrasing = "test", level = c("c", "d")),  ## I want this one
           listUI(index = "1-2", phrasing = "test", level = c("c", "d")) ## not this one
        )
)


server <- function(input, output) {

    outer("1") 
}

shinyApp(ui = ui, server = server)

[ansokolov]

I solved it. Posting here as an example, but hoping that maybe someone can help improve.

I solved it by passing the parent reactive domain INTO the nested module. This requires me to first save the domain and then pass it. I don't like it that much, and think maybe there is a more ideal solution, but I dont think I understand how to get the parent domain. I would really appreciate it if someone could help explain to me how to more properly access the parent reactive domain, maybe using withReactiveDomain?
Thanks!
Anatoliy

library(shiny)


outer = function(id) {
    domain = getDefaultReactiveDomain()
    moduleServer(id,
                 function(input, output, session) {
                     observeEvent(input$value, {
                         print(paste("outer = ", input$value))
                         inner("2", domain)
                     })
                 })
}


inner = function(id, domain) {
    print(id)
    moduleServer(id, function(input, output, session) {

       # using this as a print statement to check for detection
        observeEvent(input$value, {
            print(paste("inner = ", input$value))
        })
        print("Calling inner module")
        ## ideally I want to call this
       # updateSelectizeInput(session, inputId = "value", choices = "x")

    }, session = domain)
}

listUI = function(index, phrasing, level)
{
    ns <- NS(index)
    selectizeInput(inputId = ns("value"), label = phrasing, choices = level)
}

ui <- fluidPage(

    titlePanel("module nesting"),
        mainPanel(
           listUI(index = "1", phrasing = "test", level = c("a", "b")),
           listUI(index = "2", phrasing = "test", level = c("c", "d"))  ## I want this one
         #  listUI(index = "1-2", phrasing = "test", level = c("c", "d")) ## not this one
        )
)


server <- function(input, output) {

    outer("1")
}

shinyApp(ui = ui, server = server)

[nirgrahamuk]

I wouldn't approach it like this.
Any inner module can return its state to a calling module. That calling module should be responsible for updating any other module that is inner to it in the normal ways.

[ansokolov]

Hi, I was wondering if you could please expand on that answer as I am not sure i understood it. Can you re-write my example to do what you mean?

I am looking to update an input on change from a different input. The other constraint here is that I already have pre-generated the UIs with specific namespaces, so I cannot edit the ns names.

My goal is that the outer and inner functions actually remain static, and that I can use functional programming to tune them. So in some cases I will pass a function to a module, which I will subsequently pass to another module. So I was looking to understand how to properly manage the domains/environments.

Thanks!

[nirgrahamuk]

Here is an example

library(shiny)

inner_1_UI <- function(id) {
  ns <- NS(id)
  tagList(
    sliderInput(ns("myslide"),
      "slide me",
      min = 0,
      max = 100,
      value = 50
    )
  )
}
inner_1 <- function(id) {
  moduleServer(id, function(input, output, session) {
    reactive({
      req(input$myslide)
    })
  })
}


inner_2_UI <- function(id) {
  ns <- NS(id)
  tagList(
    verbatimTextOutput(ns("outtext"))
  )
}
inner_2 <- function(id, val) {
  moduleServer(id, function(input, output, session) {
    output$outtext <- renderText({
      req(val())
    })
  })
}

outer_UI <- function(id) {
  ns <- NS(id)
  tagList(
    inner_1_UI(ns("1")),
    inner_2_UI(ns("2"))
  )
}

outer <- function(id) {
  moduleServer(id, function(input, output, session) {
    i1 <- inner_1("1")
    inner_2("2", i1)
    
    observeEvent(
      i1(),
      str(i1())
    )
    
  })
}


ui <- fluidPage(
  outer_UI("myouter")
)

server <- function(input, output, session) {
  outer("myouter")
}

shinyApp(ui, server)