Restoring accordion panels in a modularized shiny app

Question

My previous, related question is here (answered).

Goal

Users dynamically generate a number of accordion panels in a shiny app. The app must bookmark them and restore them upon a page refresh (e.g., if a disconnection happens).

Problem

In a simple app, all the accordion panels and their values are successfully restored, as shown in the related answer linked above. But in the modularized app, only the last panel is restored. I am not sure what I am missing in the code.

Code

mod_form_ui <- function(id) {
  ns <- NS(id)
  tagList(
    uiOutput(ns("event_form"))
  )
}

mod_form_server <- function(id, event_name, Day) {


  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns

      # Event name as a function of day
      sim_event <- reactive(paste0("event_", gsub("\\s", "", event_name), "_", Day))

      output$event_form <- renderUI({

        tagList(
          textAreaInput(
            inputId = ns(paste0(sim_event(), "_eventStart")),
            label = "Event Start",
            placeholder = "Event started at ..."
          )
        )

      })

    }
  )
}



mod_all_events_ui <- function(id) {
  ns <- NS(id)
  tagList(
    actionButton(ns("add"), "New Event"),
    br(),
    accordion(
      id = ns("accord_all_events")
    )
  )
}

mod_all_events_server <- function(id, Day) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns

      # When the 'New Event' button is clicked, a modal pops up asking for event name.
      observeEvent(input$add, {

          showModal(
            modalDialog(
              tagList(
                textInput(
                  inputId = ns("event_name"),
                  label = "Event name:",
                  value = ""
                ),
                ## this button will take to the main modal
                actionButton(ns("create_event"), "Submit")
              ),
              title = "New Event",
              footer = modalButton("Dismiss")
            )
          )

      })

      # Reactive value to store tab names
      events <- reactiveVal(character(0))

      # When Submit button is clicked, a new form is created in an accordion panel
      observeEvent(input$create_event, {

        req(input$event_name)

        removeModal()

        new_event_name <- isolate(input$event_name)

        form_id <- paste0(gsub("\\s", "", new_event_name), "_form")

        accordion_panel_insert(id = "accord_all_events",
                               panel = accordion_panel(title = new_event_name,
                                                       mod_form_ui(ns(form_id))))

        accordion_panel_close(id = "accord_all_events", values = TRUE)


        mod_form_server(form_id, new_event_name, Day)

        # Update reactive value with new tab name
        events(c(events(), list(name = new_event_name, id = form_id)))

      })



      onBookmark(function(state) {
        state$values$Events <- events()
      })

      onRestore(function(state) {
        for(event in head(state$values$Events, -1)) {
          form_id <- event$id
          accordion_panel_insert(
            id = "accord_all_events",
            panel = accordion_panel(
              title = event$name,
              mod_form_ui(ns(form_id))
            )
          )

          mod_form_server(form_id, event$name, Day)
        }
      })

    }
  )
}


create_day_page <- function(x) {
  number <- as.numeric(gsub("[^0-9]", "", x))
  navset_card_pill(
    id = paste0("pill_", number),
    nav_panel(
      title = "All Events",
      mod_all_events_ui(paste0("all_events_", number))
    )
  )
}



library(shiny)
library(bslib)

# Main UI
ui <- function(request) {
  page_navbar(

  title = "CI",

  sidebar = sidebar(
    selectizeInput(
      inputId = "day",
      label = HTML("Select Day: <span style='color:red'>*</span>"),
      choices = c("Day1", "Day2", "Day3", "Day4", "Day5", "Day6", "Day7"),
      options = list(
        placeholder = 'Select day',
        onInitialize = I('function() { this.setValue(""); }')
      )
    )
  ),

  conditionalPanel(
    condition = "input.day !== ''",
    shiny::uiOutput("day_page")
  ),

  nav_item(
    uiOutput("sign_out_button")
  )
)
}

# Server

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

    ## Observe selected day input and then create UI for that day
  observe({
    ## Check if a day is selected
    if (!is.null(input$day) && input$day != "") {
      ## Render the day page
      output$day_page <- renderUI({
        tagList(
          h4(gsub("Day(\\d+)", "Day \\1", input$day)),
          create_day_page(input$day)
        )
      })


      ## All events server
      number <- as.numeric(gsub("[^0-9]", "", input$day))
      Day <- paste0("Day", number)
      mod_all_events_server(id = paste0("all_events_", number), input$day)
    }
  })

  observe({
    reactiveValuesToList(input)
    session$doBookmark()
  })
  onBookmarked(updateQueryString)
}


shinyApp(ui, server)

Answer 1

It works :) I had to do numerous changes. Notably, don't call the module servers in an observer.

library(shiny)
library(bslib)

mod_form_ui <- function(id) {
  ns <- NS(id)
  textAreaInput(
    inputId = ns("eventStart"),
    label = "Event Start",
    placeholder = "Event started at ..."
  )
}

mod_all_events_ui <- function(id) {
  ns <- NS(id)
  tagList(
    actionButton(ns("add"), "New Event"),
    br(),
    accordion(
      id = ns("accord_all_events")
    )
  )
}

mod_all_events_server <- function(id, Day) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns
      # When the 'New Event' button is clicked, a modal pops up asking for event name.
      observeEvent(input$add, {
        
        showModal(
          modalDialog(
            tagList(
              textInput(
                inputId = ns("event_name"),
                label = "Event name:",
                value = ""
              ),
              ## this button will take to the main modal
              actionButton(ns("create_event"), "Submit")
            ),
            title = "New Event",
            footer = modalButton("Dismiss")
          )
        )
        
      }, ignoreInit = TRUE)
      
      # Reactive value to store tab names
      events <- reactiveVal()
      
      # When Submit button is clicked, a new form is created in an accordion panel
      observeEvent(input$create_event, {
        
        req(input$event_name)
        removeModal()
        new_event_name <- input$event_name
        form_id <- paste0(gsub("\\s", "", new_event_name), "_form")
        
        accordion_panel_insert(id = "accord_all_events",
                               panel = accordion_panel(title = new_event_name,
                                                       mod_form_ui(ns(form_id))))
        accordion_panel_close(id = "accord_all_events", values = TRUE)
        
        # Update reactive value with new tab name
        events(
          c(
            events(), 
            list(list(name = new_event_name, id = form_id))
          )
        )
        
      }, ignoreInit = TRUE)
      
      onBookmark(function(state) {
        state$values$Events <- isolate(events())
      })
      
      onRestore(function(state) {
        if(!is.null(state$values$Events)) {
          # note: the list is converted to a dataframe!
          for(i in seq_len(nrow(state$values$Events))) {
            event <- state$values$Events[i, , drop = FALSE]
            form_id <- event$id
            accordion_panel_insert(
              id = "accord_all_events",
              panel = accordion_panel(
                title = event$name,
                mod_form_ui(ns(form_id))
              ),
              session = session
            )
          }
        }
      })
      
      setBookmarkExclude(c("add", "create_event", "event_name", "accord_all_events"))
      
      # we return the reactive value in order to trigger session$doBookmark when it changes 
      return(events) 
    }
  )
}


create_day_page <- function(x) {
  number <- as.numeric(gsub("[^0-9]", "", x))
  navset_card_pill(
    id = paste0("pill_", number),
    nav_panel(
      title = "All Events",
      mod_all_events_ui(paste0("all_events_", number))
    )
  )
}

# Main UI
ui <- function(request) {
  page_fillable(
    
    layout_sidebar(
      sidebar = sidebar(
        selectizeInput(
          inputId = "day",
          label = HTML("Select Day: <span style='color:red'>*</span>"),
          choices = c("Day1", "Day2", "Day3", "Day4", "Day5", "Day6", "Day7"),
          options = list(
            placeholder = 'Select day',
            onInitialize = I('function() { this.setValue(""); }')
          )
        )
      ),
      lapply(paste0("Day", 1:7), function(day) {
        number <- as.numeric(gsub("[^0-9]", "", day))
        conditionalPanel(
          condition = sprintf("input.day == '%s'", day),
          tags$div(
            h4(gsub("Day(\\d+)", "Day \\1", day)),
            navset_card_pill(
              id = paste0("pill_", number),
              nav_panel(
                title = "All Events",
                mod_all_events_ui(paste0("all_events_", number))
              )
            )
          )
        )
      })
      
      # nav_item(
      #   uiOutput("sign_out_button")
      # )
      
    )
  )
}

# Server

server <- function(input, output, session) {
  
  events <- vector("list", length = 7)
  
  lapply(1:7, function(i) {
    day <- paste0("Day", i)
    events[[i]] <<- mod_all_events_server(id = paste0("all_events_", i), day)
  })  
  
  observe({
    lapply(events, function(x) x())
    reactiveValuesToList(input)
    session$doBookmark()
  })
  onBookmarked(updateQueryString)
  
}


shinyApp(ui, server, enableBookmarking = "url")