bslib::accordion() tests

R/data-apps-deps.R

@@ -58,4 +58,4 @@ apps_deps_map <- list(`001-hello` = "rsconnect", `012-datatables` = "ggplot2",
     "rversions", "sf", "withr"), `302-bootswatch-themes` = c("ggplot2", 
     "progress", "rversions", "sf", "withr"), `304-bslib-card` = c("rlang", 
     "rversions"), `305-bslib-value-box` = c("rlang", "rversions"
-    ))
+    ), `306-accordion-add-remove` = "rlang")

inst/apps/306-accordion-add-remove/app.R

@@ -0,0 +1,121 @@
+library(shiny)
+library(bslib)
+
+ui <- page_fill(
+  theme = bs_theme(
+    # Don't transition when collapsing (so screenshot timing is less of an issue)
+    "transition-collapse" = "none",
+    "accordion-bg" = "#1E1E1E",
+    "accordion-color" = "white",
+    "accordion-icon-color" = "white",
+    "accordion-icon-active-color" = "white"
+  ),
+  layout_sidebar(
+    border_radius = FALSE,
+    border = FALSE,
+    bg = "lightgray",
+    sidebar(
+      bg = "#1E1E1E",
+      accordion(
+        open = TRUE,
+        accordion_panel(
+          "Selected section(s)",
+          selectInput("selected", NULL, LETTERS, multiple = TRUE, selected = "A"),
+        ),
+        accordion_panel(
+          "Displayed section(s)",
+          selectInput("displayed", NULL, LETTERS, multiple = TRUE, selected = LETTERS)
+        ),
+        accordion_panel(
+          "Parameters",
+          checkboxInput("multiple", "Allow multiple panels to be open", TRUE),
+          checkboxInput("open_on_insert", "Open on insert", FALSE)
+        )
+      )
+    ),
+    uiOutput("accordion")
+  )
+)
+
+server <- function(input, output, session) {
+
+  make_panel <- function(x) {
+    accordion_panel(
+      paste("Section", x),
+      paste("Some narrative for section", x),
+      value = x
+    )
+  }
+
+  # Allows us to track which panels are entering/exiting
+  # (when input$displayed changes)
+  displayed <- reactiveVal(LETTERS)
+
+  output$accordion <- renderUI({
+    displayed(LETTERS)
+
+    accordion(
+      id = "acc", multiple = input$multiple,
+      !!!lapply(LETTERS, make_panel)
+    )
+  })
+
+  observeEvent(input$selected, ignoreInit = TRUE, {
+    accordion_panel_set("acc", input$selected)
+  })
+
+  observeEvent(input$acc, ignoreInit = TRUE, {
+    updateSelectInput(inputId = "selected", selected = input$acc)
+  })
+
+  observeEvent(input$displayed, ignoreInit = TRUE, {
+    exit <- setdiff(displayed(), input$displayed)
+    enter <- setdiff(input$displayed, displayed())
+
+    if (length(exit)) {
+      accordion_panel_remove("acc", target = exit)
+    }
+
+    if (length(enter)) {
+      lapply(enter, function(x) {
+        panel <- make_panel(x)
+        if (identical("A", x)) {
+
+          # Can always be inserted at the top (no target required)
+          accordion_panel_insert("acc", panel = panel, position = "before")
+
+        } else {
+
+          # Other letters require us to find the closest _currently displayed_
+          # letter (to insert after)
+          idx_displayed <- which(LETTERS %in% displayed())
+          idx_insert <- match(x, LETTERS)
+          idx_diff <- idx_insert - idx_displayed
+          idx_diff[idx_diff < 0] <- NA
+          target <- LETTERS[idx_displayed[which.min(idx_diff)]]
+          accordion_panel_insert("acc", panel = panel, target = target, position = "after")
+
+        }
+
+        displayed(c(x, displayed()))
+      })
+
+      if (input$open_on_insert) {
+        accordion_panel_open("acc", enter)
+      }
+    }
+
+    displayed(input$displayed)
+  })
+
+  observeEvent(displayed(), ignoreInit = TRUE, {
+    updateSelectInput(inputId = "displayed", selected = displayed())
+    updateSelectInput(
+      inputId = "selected", choices = displayed(),
+      selected = input$selected
+    )
+  })
+
+}
+
+shinyApp(ui, server)

inst/apps/306-accordion-add-remove/tests/testthat.R

@@ -0,0 +1 @@
+shinytest2::test_app()

inst/apps/306-accordion-add-remove/tests/testthat/setup-shinytest2.R

@@ -0,0 +1,2 @@
+# Load application support files into testing environment
+shinytest2::load_app_env()

inst/apps/306-accordion-add-remove/tests/testthat/test-shinytest2.R

@@ -0,0 +1,50 @@
+library(shinytest2)
+
+test_that("{shinytest2} recording: accordion-select", {
+  width <- 995
+  height <- 1336
+
+  app <- AppDriver$new(
+    variant = platform_variant(), name = "accordion-select",
+    height = height, width = width,
+    view = interactive(),
+    options = list(bslib.precompiled = FALSE)
+  )
+
+  # Make sure the set_input() calls complete in order
+  set_inputs <- function(...) {
+    app$set_inputs(...)
+    app$wait_for_idle()
+  }
+
+  # Test accordion_panel_set()
+  set_inputs(selected = c("A", "D"))
+  set_inputs(selected = c("A", "D", "H"))
+  app$expect_screenshot()
+
+  # Test accordion_panel_remove()
+  set_inputs(displayed = c("D", "F"))
+  # Test accordion_panel_insert()
+  set_inputs(displayed = c("A", "D", "F"))
+  set_inputs(displayed = c("A", "D", "F", "Z"))
+  # Test accordion_panel_insert() + accordion_panel_open()
+  set_inputs(open_on_insert = TRUE)
+  set_inputs(displayed = c("A", "D", "F", "J", "Z"))
+  set_inputs(displayed = c("A", "D", "F", "J", "K", "Z"))
+  app$expect_screenshot()
+
+  # redo tests with accordion(autoclose = TRUE)
+  set_inputs(open_on_insert = FALSE)
+  set_inputs(multiple = FALSE)
+
+  # Last one (D) should be selected
+  set_inputs(selected = "B")
+  set_inputs(selected = c("C", "D"))
+  app$expect_screenshot()
+
+  set_inputs(displayed = c("A", "D", "F", "Z"))
+  set_inputs(open_on_insert = TRUE)
+  set_inputs(displayed = c("A", "D", "F", "J", "Z"))
+  set_inputs(displayed = c("A", "D", "F", "J", "K", "Z"))
+  app$expect_screenshot()
+})

inst/apps/307-accordion-replace/app.R

@@ -0,0 +1,46 @@
+library(shiny)
+library(bslib)
+library(bsicons)
+
+ui <- page_fluid(
+  tags$style(".accordion {--bs-accordion-active-color: #dc3545; --bs-accordion-active-bg: rgba(220, 53, 69, 0.05)}"),
+  accordion(
+    id = "acc",
+    accordion_panel(
+      title = "Test failed",
+      icon = bs_icon("x-circle"),
+      value = "test-message",
+      "Try again"
+    )
+  ),
+  shinyjster::shinyjster_js("
+    var jst = jster(0);
+    jst.add(Jster.shiny.waitUntilStable);
+    jst.add(function() {
+      Jster.assert.isEqual(
+        $('#acc .accordion-button').text().trim(), 'Test passed',
+        'accordion_mutate() did not update the accordion()'
+      );
+    });
+    jst.test();
+  ")
+)
+
+server <- function(input, output, session) {
+
+  shinyjster::shinyjster_server(input, output)
+
+  observe({
+    accordion_panel_update(
+      id = "acc", target = "test-message",
+      title = "Test passed",
+      icon = bs_icon("check-circle"),
+      "Nicely done!"
+    )
+
+    insertUI("body", ui = tags$style(".accordion {--bs-accordion-active-color: #198754; --bs-accordion-active-bg: rgba(25, 135, 84, 0.05) !important}"))
+  })
+
+}
+
+shinyApp(ui, server)

inst/apps/307-accordion-replace/tests/testthat.R

@@ -0,0 +1 @@
+shinytest2::test_app()

inst/apps/307-accordion-replace/tests/testthat/setup.R

@@ -0,0 +1,2 @@
+# Load application support files into testing environment
+shinytest2::load_app_env()

inst/apps/307-accordion-replace/tests/testthat/test-shinyjster.R

@@ -0,0 +1 @@
+shinyjster::testthat_shinyjster("Execute hidden plot")