rshinybs4dash

bs4DashPage inside a module


I've been working on integrating bs4Dash components within a Shiny module and have encountered an issue where the tabs created with bs4TabItems inside a bs4DashPage are not displaying correctly.

Goal: To create a bs4DashPage that contains multiple tabs (bs4TabItems), each defined inside a Shiny module.

Issue: The tabs are not rendering any content when the module is used within bs4DashBody. The module function reservationAppUI is intended to output a series of tabs, but when these are integrated within the main bs4DashPage using bs4DashBody, the content appears empty or does not display as expected.

library(shiny)
library(bs4Dash)
library(DT)

# Define the UI for the module
dataAppUI <- function(id) {
  ns <- NS(id)
  
  # Use bs4TabItems directly as this is going to be part of a bs4DashPage
  bs4TabItems(
    bs4TabItem(tabName = ns("dataTableTab"),
               fluidRow(
                 DTOutput(ns("dataDisplayTable"))
               )
    ),
    bs4TabItem(tabName = ns("addDataTab"),
               fluidRow(
                 box(title = "Data Entry Form", status = "primary", solidHeader = TRUE, width = 12,
                     "Input form elements for data entry go here."
                 )
               )
    ),
    bs4TabItem(tabName = ns("adjustmentsTab"),
               fluidRow(
                 box(title = "Adjust Settings", status = "primary", solidHeader = TRUE, width = 12,
                     "Adjustable settings for the application go here."
                 )
               )
    ),
    bs4TabItem(tabName = ns("settingsTab"),
               fluidRow(
                 box(title = "Configuration Settings", status = "primary", solidHeader = TRUE, width = 12,
                     "Configuration options for application settings go here."
                 )
               )
    ),
    bs4TabItem(tabName = ns("userManagementTab"),
               fluidRow(
                 box(title = "User Management", status = "primary", solidHeader = TRUE, width = 12,
                     "Manage user credentials and access levels."
                 )
               )
    )
  )
}

# Define the server logic for the module
dataApp <- function(input, output, session) {
  output$dataDisplayTable <- renderDT({
    datatable(
      data.frame(
        Description = c("Item Description"),
        Quantities = c("1,2", "3,4"),
        `10:00` = c(0, 100),
        `11:00` = c(0, 123),
        `12:00` = c(0, 0),
        `13:00` = c(0, 0),
        check.names = FALSE
      ),
      options = list(pageLength = 5, autoWidth = TRUE)
    )
  })
}

# Main application code using bs4DashPage
ui <- bs4DashPage(
  title = "Generic Data App",
  header = bs4DashNavbar(
    title = "Generic Data App",
    sidebarIcon = icon("bars"),
    skin = "light"
  ),
  sidebar = bs4DashSidebar(
    skin = "light",
    status = "primary",
    bs4SidebarMenu(
      id = "sidebarMenu",
      bs4SidebarMenuItem("Data Table", tabName = "dataTableTab", icon = icon("table")),
      bs4SidebarMenuItem("Add Data", tabName = "addDataTab", icon = icon("plus")),
      bs4SidebarMenuItem("Adjustments", tabName = "adjustmentsTab", icon = icon("sliders")),
      bs4SidebarMenuItem("Settings", tabName = "settingsTab", icon = icon("cogs")),
      bs4SidebarMenuItem("User Management", tabName = "userManagementTab", icon = icon("users"))
    )
  ),
  body = bs4DashBody(
    dataAppUI("mainApp")
  )
)

server <- function(input, output, session) {
  callModule(dataApp, "mainApp")
}

shinyApp(ui, server)


Solution

  • The issue is that you confused the main app namespace and the module namespace, i.e. the side bar menu items refer to tabs in the main namespace, whereas only the body refers to tabs created in the module namespace.

    To fix your issue add a second UI function to your module to create the sidebar menu items (or the whole sidebar menu):

    library(shiny)
    library(bs4Dash)
    library(DT)
    
    # Define the UI Body for the module
    dataAppUiBody <- function(id) {
      ns <- NS(id)
    
      # Use bs4TabItems directly as this is going to be part of a bs4DashPage
      bs4TabItems(
        bs4TabItem(
          tabName = ns("dataTableTab"),
          fluidRow(
            DTOutput(ns("dataDisplayTable"))
          )
        ),
        bs4TabItem(
          tabName = ns("addDataTab"),
          fluidRow(
            box(
              title = "Data Entry Form", 
              status = "primary", 
              solidHeader = TRUE, width = 12,
              "Input form elements for data entry go here."
            )
          )
        )
      )
    }
    
    # Define the UI Sidebar for the module
    dataAppUiSidebar<- function(id) {
      ns <- NS(id)
      
      tagList(
        bs4SidebarMenuItem("Data Table", tabName = ns("dataTableTab"), icon = icon("table")),
        bs4SidebarMenuItem("Add Data", tabName =  ns("addDataTab"), icon = icon("plus"))
      )
    }
    
    # Define the server logic for the module
    dataApp <- function(input, output, session) {
      output$dataDisplayTable <- renderDT({
        datatable(
          data.frame(
            Description = c("Item Description"),
            Quantities = c("1,2", "3,4"),
            `10:00` = c(0, 100),
            `11:00` = c(0, 123),
            `12:00` = c(0, 0),
            `13:00` = c(0, 0),
            check.names = FALSE
          ),
          options = list(pageLength = 5, autoWidth = TRUE)
        )
      })
    }
    
    # Main application code using bs4DashPage
    ui <- bs4DashPage(
      title = "Generic Data App",
      header = bs4DashNavbar(
        title = "Generic Data App",
        sidebarIcon = icon("bars"),
        skin = "light"
      ),
      sidebar = bs4DashSidebar(
        skin = "light",
        status = "primary",
        bs4SidebarMenu(
          id = "sidebarMenu",
          dataAppUiSidebar("mainApp")
        )
      ),
      body = bs4DashBody(
        dataAppUiBody("mainApp")
      )
    )
    
    server <- function(input, output, session) {
      callModule(dataApp, "mainApp")
    }
    
    shinyApp(ui, server)
    #> 
    #> Listening on http://127.0.0.1:6786