refactor: use new AppDriver for each variant

inst/apps/317-bslib-preset-shiny-dashboard/app.R

@@ -225,6 +225,8 @@ abs_dark_mode <- input_dark_mode(
 )
 
 ui_flow_dash <- function(enable_dashboard = TRUE) {
+  set.seed(2023*11*15)
+
   p <- page_fluid(
     theme = bs_global_get(),
     h2("Fluid Dashboard Page", class = "my-4"),
@@ -244,6 +246,8 @@ ui_flow_dash <- function(enable_dashboard = TRUE) {
 }
 
 ui_flow_sidebar <- function(enable_dashboard = TRUE) {
+  set.seed(2023*11*15)
+
   p <- page_fixed(
     theme = bs_global_get(),
     h2("Fixed Dashboard Page"),

inst/apps/317-bslib-preset-shiny-dashboard/tests/testthat/test-317-bslib-preset-shiny-dashboard.R

@@ -22,44 +22,48 @@ this_platform <- platform_variant()
 this_platform <- sub(r_release, "release", this_platform, fixed = TRUE)
 
 # Setup App  --------------------------------------------------
-app <- AppDriver$new(
-  name = "317-bslib-preset-shiny-dashboard",
-  variant = this_platform,
+new_app_driver <- function(
+  app_dir = testthat::test_path("../../"),
   height = 800,
   width = 1200,
-  seed = 2023*11*13,
-  view = interactive(),
-  options = list(bslib.precompiled = FALSE),
-  screenshot_args = list(
-    selector = "viewport",
-    delay = 1,
-    options = list(captureBeyondViewport = FALSE)
+  ...
+) {
+  AppDriver$new(
+    app_dir,
+    name = "317-bslib-preset-shiny-dashboard",
+    variant = this_platform,
+    height = height,
+    width = width,
+    seed = 2023 * 11 * 13,
+    view = interactive(),
+    options = list(bslib.precompiled = FALSE),
+    screenshot_args = list(
+      selector = "viewport",
+      delay = 1,
+      options = list(captureBeyondViewport = FALSE)
+    ),
+    ...
   )
-)
+}
+
+app <- new_app_driver()
 withr::defer(app$stop())
 
-shinytest2_js <- local({
-  js_file <- system.file("internal", "js", "shiny-tracer.js", package = "shinytest2")
-  js_content <- readLines(js_file)
-  paste(js_content, collapse = "\n")
-})
+# shinytest2_js <- local({
+#   js_file <- system.file("internal", "js", "shiny-tracer.js", package = "shinytest2")
+#   js_content <- readLines(js_file)
+#   paste(js_content, collapse = "\n")
+# })
 
-nav_to_variant <- function(app, ...) {
+app_for_variant <- function(app, ..., height = 800, width = 1200) {
   params <- list(...)
   params <- purrr::compact(params)
   params <- purrr::imap(params, function(value, name) sprintf("%s=%s", name, value))
   params <- paste0(params, collapse = "&")
 
   url <- sprintf("%s?%s", app$get_url(), params)
-  chrm <- app$get_chromote_session()
 
-  p <- chrm$Page$loadEventFired(wait_ = FALSE)$
-    then(function(...) chrm$Runtime$evaluate(shinytest2_js, wait_ = FALSE))$
-    then(function(...) app$wait_for_idle())
-
-  chrm$Page$navigate(url, wait_ = FALSE)
-  chrm$wait_for(p)
-  invisible(app)
+  new_app_driver(url, height = height, width = width)
 }
 
 app_types <- c(
@@ -118,76 +122,86 @@ variant_settings <- function(
 }
 
 for (app_type in app_types) {
-  screenshot_counter <- 0
-
-  expect_screenshot <- function(variant) {
-    screenshot_counter <<- screenshot_counter + 1
-    count <- sprintf("%02d", screenshot_counter)
-
+  expect_screenshot <- function(app, variant) {
     app$expect_screenshot(
       threshold = 15,
-      name = glue("{app_type}_{count}_{variant}")
+      name = glue("{app_type}_{variant}")
     )
   }
 
   describe(app_type, {
-    loaded <- FALSE
+    app_variant <- NULL
+    is_flow <- grepl("^flow", app_type)
 
     it("loads the app UI variant", {
-      nav_to_variant(app, ui = app_type)
-
-      is_flow <- grepl("^flow", app_type)
-      app$set_window_size(
+      app_variant <<- app_for_variant(
+        app,
+        ui = app_type,
         width = if (is_flow)  1000 else 1200,
         height = if (is_flow) 1200 else 800
       )
 
-      loaded <<- TRUE
-      expect_true(loaded)
+      expect_false(is.null(app_variant))
     })
 
-    skip_if_not(loaded)
+    skip_if(is.null(app_variant), "Failed to load app variant")
+    withr::defer(app_variant$stop())
 
     it("light mode", {
-      variant_settings(app) # ensure toggles are all off
-      expect_screenshot("mode_light")
+      variant_settings(app_variant) # ensure toggles are all off
+      expect_screenshot(app_variant, "01_mode_light")
     })
 
     add_dashboard <- !app_type %in% c("navbar", "sidebar")
 
     if (add_dashboard) {
       it("with bslib-page-dashboard class", {
-        variant_settings(app, dashboard_toggle = add_dashboard)
-        expect_screenshot("class_dashboard")
+        variant_settings(app_variant, dashboard_toggle = add_dashboard)
+        expect_screenshot(app_variant, "02_class_dashboard")
       })
     }
 
     it("no shadows", {
-      variant_settings(app, shadow_toggle = TRUE, dashboard_toggle = add_dashboard)
-      expect_screenshot("class_no-shadow")
+      variant_settings(app_variant, shadow_toggle = TRUE, dashboard_toggle = add_dashboard)
+      expect_screenshot(app_variant, "03_class_no-shadow")
     })
 
     it("small shadows", {
-      variant_settings(app, shadow_sm_toggle = TRUE, dashboard_toggle = add_dashboard)
-      expect_screenshot("class_small-shadow")
+      variant_settings(app_variant, shadow_sm_toggle = TRUE, dashboard_toggle = add_dashboard)
+      expect_screenshot(app_variant, "04_class_small-shadow")
     })
 
     it("dark mode", {
-      variant_settings(app, dashboard_toggle = add_dashboard)
-      app$run_js("document.documentElement.dataset.bsTheme='dark'")
-      app$wait_for_js("document.documentElement.dataset.bsTheme === 'dark'")
+      variant_settings(app_variant, dashboard_toggle = add_dashboard)
+      app_variant$run_js("document.documentElement.dataset.bsTheme='dark'")
+      app_variant$wait_for_js("document.documentElement.dataset.bsTheme === 'dark'")
       Sys.sleep(1) # wait for transition
-      expect_screenshot("mode_dark")
+      expect_screenshot(app_variant, "05_mode_dark")
     })
 
     it("classic mode (default)", {
-      nav_to_variant(app, ui = app_type, dashboard = "false")
-      expect_screenshot("classic")
+      app_classic <- app_for_variant(
+        app,
+        ui = app_type,
+        dashboard = "false",
+        width = if (is_flow)  1000 else 1200,
+        height = if (is_flow) 1200 else 800
+      )
+      withr::defer(app_classic$stop())
+      expect_screenshot(app_classic, "06_classic")
     })
 
     it("classic mode (with shadows)", {
-      nav_to_variant(app, ui = app_type, dashboard = "false", shadows = "true")
-      expect_screenshot("classic_shadows")
+      app_classic_shade <- app_for_variant(
+        app,
+        ui = app_type,
+        dashboard = "false",
+        shadows = "true",
+        width = if (is_flow)  1000 else 1200,
+        height = if (is_flow) 1200 else 800
+      )
+      withr::defer(app_classic_shade$stop())
+      expect_screenshot(app_classic_shade, "07_classic_shadows")
     })
   })
 }