rshinyshinymodules

Observe event within module nested in another module isn't recognizing input change


I have a large wizard app that I'd like to break up by putting each of the hidden tabs within their own modules.

I've made the reprex below based off of Hadleys wizard example.

The layout is

ui
L outer_ui
  L inner_ui
server
L outer_server
  L inner_server

Things that do work:

Thing that doesn't work:

library(shiny)

inner_ui <- function(id) {
  ns <- NS(id)
  tabPanel(title = "page_1",
    actionButton(
      inputId = ns("page_12"),
      label = "next")
  )
}

inner_server <- function(id, r, parent) {
  moduleServer(id, function(input, output, session) {
    r$page <- 2
    observeEvent(input$page_12, r$page <- 2)
  }
)}

outer_ui <- function(id) {
  ns <- NS(id)
  fluidPage(
    tabsetPanel(
      # we name the set of tabs so we can call on the group later
      id = ns("wizard"),
      # this makes all the tabs except for the selected one hidden
      type = "hidden",
      
      # modularized the first page tab
      inner_ui("first_page"),
      
      # The other two tabs are identical to the Hadley example
      tabPanel(title = "page_2",
        h4("Only one page to go"),
        actionButton(inputId = ns("page_21"), label = "prev"),
        actionButton(inputId = ns("page_23"), label = "next")
      ),
      tabPanel(title = "page_3",
        h4("You're done!"),
        actionButton(inputId = ns("page_32"), label = "prev")
      )
    )
  )
}


outer_server <- function(id, r, parent) {
  moduleServer(id, function(input, output, session) {
    observeEvent(r$page, {
      updateTabsetPanel(inputId = "wizard", selected = paste0("page_", r$page))
    })
    inner_server("first_page", r = r, parent = session)
    observeEvent(input$page_21, r$page <- 1)
    observeEvent(input$page_23, r$page <- 3)
    observeEvent(input$page_32, r$page <- 2)
  }
  )
}

# Define the tabsetPanel module
ui <- navbarPage(
    title = NULL,
    tabPanel(title = "test Wizard",
      outer_ui("test_outer"))
  )

server <- function(input, output, session) {
  r <- reactiveValues()
  outer_server("test_outer", r = r, parent = session)
}

# Run the Shiny app
shinyApp(ui, server)

Solution

  • I was able to find the answer from Ben's comment on this question.

    Changing inner_ui("first_page") to inner_ui(ns("first_page)) in the inner_ui function fixed the issue.