Dynamically adding tabs with insertUI and a module

Question

I'm trying to create a tabset where tabs are dynamically added. Each new tab has the same carousel with images. The carousel is loaded from a module.

This would be the desired end result, but that works for multiple dynamically added tabs:

Reading other SO questions leads me to believe that I might need a nested module. Alternatively I've made a mistake with insertUI. Help much appreciated!

Here is a MVE where you need to place a single png in the same folder as the code:

library(shiny)
library(slickR)

my_module_UI <- function(id) {
  ns <- NS(id)
  slickROutput(ns("slickr"), width="100%")
}

my_module <- function(input, output, session) {

  output$slickr <- renderSlickR({
    imgs <- list.files("", pattern=".png", full.names = TRUE)
    slickR(imgs)
  })
}

ui <- fluidPage(  
  tabItem(tabName = "main_tab_id",
          tabsetPanel(id = "test_tabs",
                      tabPanel(
                        title = "First tab",
                        value = "page1",
                        fluidRow(textInput('new_tab_name', 'New tab name'),
                                 actionButton('add_tab_button','Add'))
                      )
          )
  )
)

server <- function(input, output, session) {

  tab_list <- NULL

  observeEvent(input$add_tab_button,
               {
                 tab_title <- input$new_tab_name

                 if(tab_title %in% tab_list == FALSE){

                   appendTab(inputId = "test_tabs",
                             tabPanel(
                               title=tab_title,
                               div(id="placeholder") # Content
                             )
                   )

                   # A "unique" id based on the system time
                   new_id <- gsub("\\.", "", format(Sys.time(), "%H%M%OS3"))
                   insertUI(
                     selector = "#placeholder",
                     where = "beforeBegin",
                     ui = my_module_UI(new_id)
                   )

                   callModule(my_module, new_id)

                   tab_list <<- c(tab_list, tab_title)

                 }
                 updateTabsetPanel(session, "test_tabs", selected = tab_title)
               })
}

shinyApp(ui, server)

Answer 1

This is an interesting exercise in modules.

1. carousel_module simply renders the carousel
2. my_tab module, creates a tab and an observeEvent for each tab which listens to tab clicks

library(shiny)
library(slickR)

carousel_ui <- function(id){
  ns <- NS(id)
  slickROutput(ns("slickr"), width="100%")
}

carousel_module <- function(input, output, session) {
  output$slickr <- renderSlickR({
    imgs <- list.files("~/Desktop/imgs", pattern=".png", full.names = TRUE)
    slickR(imgs)
  })
}

my_tab <- function(input,output,session,parent_session,tab_element,tab_name){

  ns = session$ns

  appendTab(inputId = "test_tabs",
            tabPanel(
              title = tab_name,
              value = tab_name,
              carousel_ui(ns("carousel")) # Operating in the parent session so explicitly supply the namespace
          ),
          session = parent_session
  )

  updateTabsetPanel(parent_session, "test_tabs", selected = tab_name) # Refer to test_tabs from the parent namespace

  # Need to update the carousel every time the user clicks on a tab
  # Else the carousel is only updated on the latest tab created

  observeEvent(tab_element(),{
    req(tab_element())

    if(tab_element() == tab_name){
      cat("Running\n")
      callModule(carousel_module,"carousel")# This module knows the namespace so no need to supply the namespace
    }
  })

}

ui <- fluidPage(  
      tabsetPanel(id = "test_tabs",
                  tabPanel(
                    title = "First tab",
                    value = "page1",
                    fluidRow(textInput('new_tab_name', 'New tab name'),
                             actionButton('add_tab_button','Add'))
                  )
      )
  )
)

server <- function(input, output, session) {

  tab_list <- NULL

  observeEvent(input$add_tab_button,{

                 tab_title <- input$new_tab_name
                 callModule(my_tab,tab_title,session,reactive(input$test_tabs),input$new_tab_name)

               })
}

shinyApp(ui, server)