moodymudskipper
moodymudskipper

Reputation: 47320

Unexpected output using `observeEvent`, `updateTabsetPanel` and nested modules

My app has several screens and I deal with it using tabsetPanel(), hiding the tab headers (I leave them visible here for debugging) and selecting them using updateTabsetPanel()

It starts on a home screen (coded into mod_home_ui() / mod_home_server()) You push a button to trigger an action, there would be several but I just left one here, called "learn" (coded into mod_learn_ui() / mod_learn_server())

The "learn" module itself contains games, here I left only two games and used the same module functions for both for simplicity. A reactive value panel_flag, determines which game should be played, here I force it to FALSE, which means game2 should be played.

This last step doesn't work as I expect, while messages show that the code went through the right updateTabsetPanel() call, the expected tab isn't selected, and moreover, the expected text isn't shown on top of the screen.

This looks like a namespacing issue but I don't understand what I did wrong here.

The code below can be copy pasted in one go to run the app and here's a gif of what would happen :

enter image description here

# main ui and server

app_ui <- function() {
  tagList(
    fluidPage(
      title = "My app",
      tabsetPanel(
        id = "switcher",
        #type = "hidden",
        selected = "home",
        tabPanel("home",  mod_home_ui("home_ui")),
        tabPanel("learn", mod_learn_ui("learn_ui"))
      )
    )
  )
}

app_server <- function(input, output,session) {
  learn <- callModule(mod_home_server, "home_ui")
  observeEvent(learn(), {
    message("In app_server: observeEvent on learn() to switch to 'learn' panel")
    updateTabsetPanel(session, "switcher", selected = "learn")
  })
  callModule(mod_learn_server, "home_ui", learn = learn)
}
# home module

mod_home_ui <- function(id){
  ns <- NS(id)
  tagList(
    textOutput(ns("some_text")),
    actionButton(ns("learn"), "learn")
  )
}

mod_home_server <- function(input, output, session){
  output$some_text <- renderText("I expect clicking on the above to trigger game2, not game1")
  ns <- session$ns
  reactive({
    res <- req(input$learn)
    message(
      'In mod_home_server: returning req(input$learn) in mod_home_server to trigger learn()')
    res
  })
}
# learn module

mod_learn_ui <- function(id){
  ns <- NS(id)
  tabsetPanel(
    id = ns("switcher"),
    #type = "hidden",
    tabPanel("game1", mod_game_ui(ns("game1_ui"))),
    tabPanel("game2", mod_game_ui(ns("game2_ui")))
  )
}

mod_learn_server <- function(input, output, session, learn){
  ns <- session$ns
  
  panel_flag <- eventReactive(learn(), {
    message('In mod_learn_server: eventReactive on learn() to trigger relevant game')
    # in reality this would be computed or random
    FALSE
  })
  
  observeEvent(panel_flag(), {
    message('In mod_learn_server: observeEvent on panel_flag()')
    if (panel_flag()) {
      message('In mod_learn_server:  select "game1" panel')
      updateTabsetPanel(session, "switcher", selected = "game1")
    } else {
      message('In mod_learn_server: select "game2" panel')
      updateTabsetPanel(session, "switcher", selected = "game2")
    }
  })  
  callModule(mod_game_server, "game1_ui")
  callModule(mod_game_server, "game2_ui")
}
# game module

mod_game_ui <- function(id){
  ns <- NS(id)
  tagList(
    textOutput(ns("some_text")),
    "I expect another line of text above this one"
  )
}

mod_game_server <- function(input, output, session){
  ns <- session$ns
  output$some_text <- renderText("I expect this to be shown")
}
library(shiny)
shinyApp(app_ui, app_server)

Upvotes: 1

Views: 275

Answers (2)

moodymudskipper
moodymudskipper

Reputation: 47320

To make sure this doesn't happen again I made a package that tests the consistency of the shiny code, it is designed with the {golem} framework and conventions in mind.

Install with remotes::install_github("moodymudskipper/shinycheck")

This is what I get when I run shinycheck::check_shiny() on my real app (which is slightly different from the above):

shinycheck::check_shiny()
-----------------------------------------------------------------------
Check that all module scripts contain exactly 2 functions named appropriately
-----------------------------------------------------------------------
Check that all module ui functions use ns() or NS() on argument named id/inputId/outputId
-----------------------------------------------------------------------
Check that in ui, module ui functions, named `mod_MODULE_ui` refer to modules which exist and ids fed to them are prefixed with "MODULE_"
-----------------------------------------------------------------------
Check that ns() and NS() are never called in an argument that isn't id/inputId/outputId
-----------------------------------------------------------------------
Check that the module args of callModule are of the form "mod_MODULENAME_server", that there is an R file properly named for "MODULENAME", and that the id argument is prefixed by "MODULENAME_"
* In 'mod_main_server', a call to `callModule` has a module argument `mod_learn_server` and an `id` argument 'home_ui' that is not prefixed by the module name 'learn'
-----------------------------------------------------------------------
Check that modules and module ids mentionned on both ui and server side are consistent
* In 'mod_main_ui' we find the module id 'learn_ui' but we don't find it in 'mod_main_server'

We find :

In 'mod_main_server', a call to callModule has a module argument mod_learn_server and an id argument 'home_ui' that is not prefixed by the module name 'learn'

In 'mod_main_ui' we find the module id 'learn_ui' but we don't find it in 'mod_main_server'

This would have made debugging trivial.

See more at https://github.com/moodymudskipper/shinycheck

Upvotes: 1

YBS
YBS

Reputation: 21297

callModule(mod_learn_server, "learn_ui", learn = learn)

instead of

callModule(mod_learn_server, "home_ui", learn = learn)

should fix it.

Upvotes: 1

Related Questions