I have a modularized Golem app using bs4Dash. I want to update the active sidebar tab from an actionBttn that is dynamically generated from renderUI. While updatebs4ControlbarMenu works as expected as shown here, it does not work in the modularized version of the application. What am I doing wrong? I suspect it is related to input[[btnID]] management across modules but I struggle to find the solution.
Working example without modules as shown here:
library(shiny)
library(shinyWidgets)
library(bs4Dash)
library(tidyverse)
shinyApp(
ui = bs4DashPage(
sidebar_collapsed = FALSE,
controlbar_collapsed = TRUE,
enable_preloader = FALSE,
navbar = bs4DashNavbar(skin = "dark"),
sidebar = bs4DashSidebar(
inputId = "sidebarState",
bs4SidebarMenu(
id = "sidebr",
bs4SidebarMenuItem(
"Tab 1",
tabName = "tab1"
),
bs4SidebarMenuItem(
"Tab 2",
tabName = "tab2"
)
)
),
bs4DashBody(
bs4TabItems(
bs4TabItem(
tabName = "tab1",
h1("Welcome!"),
fluidRow(
pickerInput(
inputId = "car",
label = "Car",
choices = row.names(mtcars),
selected = head(row.names(mtcars), 3),
multiple = TRUE,
options = list(
`actions-box` = TRUE)
),
pickerInput(
inputId = "gear",
label = "Gear",
choices = unique(mtcars$gear),
selected = unique(mtcars$gear),
multiple = TRUE,
options = list(
`actions-box` = TRUE)
)
),
fluidRow(
column(6,
uiOutput("uiboxes")
)
)
),
bs4TabItem(
tabName = "tab2",
h4("Yuhuuu! You've been directed automatically in Tab 2!")
)
)
)
),
server = function(input, output, session) {
submtcars <- reactive({
req(input$car, input$gear)
mtcars %>%
mutate(
carnames = rownames(mtcars)) %>%
filter(
carnames %in% input$car &
gear %in% input$gear
)
})
observeEvent( submtcars(), {
n_ex <- nrow(submtcars())
output$uiboxes <- renderUI({
lapply(1:n_ex, FUN = function(j) {
print(paste("j is ", j))
bs4Box(
title = submtcars()$carnames[j],
width = 12,
str_c("Number of gears:", submtcars()$gear[j]),
btnID <- paste0("btnID", j),
print(btnID),
fluidRow(
column(
2,
actionBttn(
inputId = btnID,
icon("search-plus")
)
)
)
)
})
})
lapply(1:n_ex, function(j) {
btnID <- paste0("btnID", j)
observeEvent(input[[btnID]] , {
updatebs4ControlbarMenu(
session,
inputId = "sidebr",
selected = "tab2"
)
})
})
})
}
)
Modularized attempt not working:
library(shiny)
library(shinyWidgets)
library(bs4Dash)
library(tidyverse)
mod_exlib_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
pickerInput(
inputId = ns("car"),
label = "Car",
choices = row.names(mtcars),
selected = head(row.names(mtcars), 3),
multiple = TRUE,
options = list(
`actions-box` = TRUE)
),
pickerInput(
inputId = ns("gear"),
label = "Gear",
choices = unique(mtcars$gear),
selected = unique(mtcars$gear),
multiple = TRUE,
options = list(
`actions-box` = TRUE)
)
),
fluidRow(
column(6,
uiOutput(ns("uiboxes"))
)
)
)
}
mod_exlib_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
submtcars <- reactive({
# req(input$car, input$gear)
mtcars %>%
dplyr::mutate(
carnames = rownames(mtcars)) %>%
dplyr::filter(
carnames %in% input$car &
gear %in% input$gear
)
})
observeEvent( submtcars(), {
n_ex <- nrow(submtcars())
output$uiboxes <- renderUI({
lapply(1:n_ex, FUN = function(j) {
print(paste("j is ", j))
bs4Box(
title = submtcars()$carnames[j],
width = 12,
paste("Number of gears: ", submtcars()$gear[j]),
btnID <- paste0("btnID", j),
print(btnID),
fluidRow(
column(
2,
actionBttn(
inputId = ns(btnID),
icon("search-plus")
)
)
)
)
})
})
lapply(1:n_ex, function(j) {
btnID <- paste0("btnID", j)
observeEvent(input[[btnID]] , {
print(btnID)
updatebs4ControlbarMenu(
session,
inputId = "sidebr",
selected = "exdet2"
)
})
})
})
})
}
app_ui <- tagList(
bs4DashPage(
navbar = bs4DashNavbar(),
sidebar = bs4DashSidebar(
expand_on_hover = TRUE,
inputId = "sidebarState",
bs4SidebarMenu(
id = "sidebr",
bs4SidebarMenuItem(
"Tab 1",
tabName = "tab1"
),
bs4SidebarMenuItem(
"Tab 2",
tabName = "tab2"
)
)
),
bs4DashBody(
bs4TabItems(
bs4TabItem(
tabName = "tab1",
h1("Welcome!"),
mod_exlib_ui("exlib_ui_1")
),
bs4TabItem(
tabName = "tab2",
h4("Yuhuuu! You've been directed automatically in Tab 2!")
)
)
)
)
)
app_server <- function( input, output, session ) {
# Your application server logic
mod_exlib_server("exlib_ui_1")
}
shinyApp(
ui = app_ui,
server = app_server)
