bs4Dash Controlbar behavior - updateSelectInput only successful when tied to actionButton

I have a workaround, I'm hoping to better understand what is going on.

I've created dynamic controlbars in bs4Dash by splitting my module UI function into two functions: mod_UI and mod_option_ui. I call the mod_UI functions in the dashboardBody function as normal, but I render the controlBar on the serverside, passing whichever mod_option_ui function matches the active tabName.

One option has a selectInput, I use updateSelectInput to update the choices based on data passed into the module (this is the filepath of a project loaded through another module). I can only get the updateSelectInput() function to succeed if I tie it to an actionButton Dependency. (I discovered this by trying to force the observer to run with an observeEvent)

I don't have to click the button, just simply having it in the observer is enough to get updateSelectInput to behave the way I expect.

Here's some code to play with. Commenting out the input$updateSelect line shows the issue.

# --- Demo Module ---
basicMod_ui <- function(id){
  ns <- NS(id)
  tagList(
    textOutput(ns("text"))
  )
}

basicMod_options_ui <- function(id){
  ns <- NS(id)
  tagList(
    actionButton(ns("updateSelect"), label = "Update Select"),
    selectInput(ns("column"), "Select Column", choices = NULL, multiple = TRUE)
  )
}

basicMod_server <- function(id, inputData){
  moduleServer(id, function(input, output, session) {
    observe({
      input$updateSelect # Comment to disable updateSelectInput
      updateSelectInput(session, "column", choices = inputData())
    })
    output$text <- renderText({
      paste("Selected Column: ", paste(input$column, collapse = ", "))
    })
  })
} # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

app_ui <- function(request) {
  bs4Dash::dashboardPage(
    header = bs4Dash::dashboardHeader(),
    sidebar = bs4Dash::dashboardSidebar(
      bs4Dash::sidebarMenu(
        id = "sidebar",
        bs4Dash::menuItem(
          text = "basicMod",
          tabName = "basicMod"
        )
      )
    ),
    controlbar = bs4Dash::dashboardControlbar(
      uiOutput("controlbar")
    ),
    footer = bs4Dash::dashboardFooter(),
    body = bs4Dash::dashboardBody(
      bs4Dash::tabItems(
        bs4Dash::tabItem(
          tabName = "basicMod",
          basicMod_ui("basicMod")
        )
      )
    )
  )
}

app_server <- function(input, output, session) {
  
  # Setup Module
  basicMod_server("basicMod", inputData = reactive(LETTERS))
  
  # Setup Dynamic Control Bar - switching on tab allows different option menus
  output$controlbar <- renderUI({
    basicMod_options_ui("basicMod")
  })
}

shinyApp(app_ui, app_server)

Solution

This issue is based on using renderUI. Shiny is lazy. By default it doesn't update outputs which aren't visible, which is the case for your output$controlbar.

You can opt-out of this behaviour by setting: outputOptions(output, "controlbar", suspendWhenHidden = FALSE)

Opt-out example:

library(shiny)

# --- Demo Module ---
basicMod_ui <- function(id){
  ns <- NS(id)
  tagList(
    textOutput(ns("text"))
  )
}

basicMod_options_ui <- function(id){
  ns <- NS(id)
  tagList(
    # actionButton(ns("updateSelect"), label = "Update Select"),
    selectInput(ns("column"), "Select Column", choices = NULL, multiple = TRUE)
  )
}

basicMod_server <- function(id, inputData){
  moduleServer(id, function(input, output, session) {
    observe({
      # input$updateSelect # Comment to disable updateSelectInput
      updateSelectInput(session, "column", choices = inputData())
    })
    output$text <- renderText({
      paste("Selected Column: ", paste(input$column, collapse = ", "))
    })
  })
} # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

app_ui <- function(request) {
  bs4Dash::dashboardPage(
    header = bs4Dash::dashboardHeader(),
    sidebar = bs4Dash::dashboardSidebar(
      bs4Dash::sidebarMenu(
        id = "sidebar",
        bs4Dash::menuItem(
          text = "basicMod",
          tabName = "basicMod"
        )
      )
    ),
    controlbar = bs4Dash::dashboardControlbar(
      uiOutput("controlbar")
    ),
    footer = bs4Dash::dashboardFooter(),
    body = bs4Dash::dashboardBody(
      bs4Dash::tabItems(
        bs4Dash::tabItem(
          tabName = "basicMod",
          basicMod_ui("basicMod")
        )
      )
    )
  )
}

app_server <- function(input, output, session) {
  
  # Setup Module
  basicMod_server("basicMod", inputData = reactive({
    LETTERS
  })
  )
  
  # Setup Dynamic Control Bar - switching on tab allows different option menus
  output$controlbar <- renderUI({
    basicMod_options_ui("basicMod")
  })
  outputOptions(output, "controlbar", suspendWhenHidden = FALSE)
}

shinyApp(app_ui, app_server)

However, regarding your use case renderUI isn't needed at all (and I recommend avoiding it when possible). You can simply call your module UI directly.

Recommended approach:

library(shiny)

# --- Demo Module ---
basicMod_ui <- function(id){
  ns <- NS(id)
  tagList(
    textOutput(ns("text"))
  )
}

basicMod_options_ui <- function(id){
  ns <- NS(id)
  tagList(
    # actionButton(ns("updateSelect"), label = "Update Select"),
    selectInput(ns("column"), "Select Column", choices = NULL, multiple = TRUE)
  )
}

basicMod_server <- function(id, inputData){
  moduleServer(id, function(input, output, session) {
    observe({
      print(inputData())
      # input$updateSelect # Comment to disable updateSelectInput
      updateSelectInput(session, "column", choices = inputData())
    })
    output$text <- renderText({
      paste("Selected Column: ", paste(input$column, collapse = ", "))
    })
  })
} # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

app_ui <- function(request) {
  bs4Dash::dashboardPage(
    header = bs4Dash::dashboardHeader(),
    sidebar = bs4Dash::dashboardSidebar(
      bs4Dash::sidebarMenu(
        id = "sidebar",
        bs4Dash::menuItem(
          text = "basicMod",
          tabName = "basicMod"
        )
      )
    ),
    controlbar = bs4Dash::dashboardControlbar(
      # uiOutput("controlbar")
      basicMod_options_ui("basicMod")
    ),
    footer = bs4Dash::dashboardFooter(),
    body = bs4Dash::dashboardBody(
      bs4Dash::tabItems(
        bs4Dash::tabItem(
          tabName = "basicMod",
          basicMod_ui("basicMod")
        )
      )
    )
  )
}

app_server <- function(input, output, session) {
  # Setup Module
  basicMod_server("basicMod", inputData =
                    reactive({
                      invalidateLater(3000L) # update choices every 3s for testing
                      LETTERS[seq_len(round(runif(1L, 1L, 10L)))]
                    })
  )
}

shinyApp(app_ui, app_server)