rstudio · gadenbuie · May 9, 2023 · Mar 20, 2023 · Mar 20, 2023 · Mar 20, 2023
diff --git a/R/data-apps-deps.R b/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"
-    ))
+    ), `309-flexdashboard-tabs-navs` = "rmarkdown")
diff --git a/inst/apps/309-flexdashboard-tabs-navs/index.Rmd b/inst/apps/309-flexdashboard-tabs-navs/index.Rmd
@@ -0,0 +1,73 @@
+---
+title: 309
+output:
+  flexdashboard::flex_dashboard:
+    theme:
+      version: 3  #<< set to 3, 4, 5, ...
+    orientation: row
+    resize_reload: false
+params:
+  bs_version: ""
+runtime: shiny
+---
+
+Page 1 {data-test-id="Page 1"}
+===================================
+
+## Box 1-1 {.tabset data-test-id="Box 1-1"}
+
+### Tab 1-1a {data-test-id="Tab 1-1a"}
+
+**About this test**: This app tests our usage of Bootstrap's Tab plugin.
+Test this app in all major versions of Bootstrap.
+
+1. Change the active tabs on this page.
+2. Switch to Page 2 under "Other"
+3. Switch to Page 3 under "Other"
+
+Verify that only the expected pages are visible
+and that the active navbar menu state is correctly shown.
+
+This is Bootstrap `r params$bs_version`.
+
+### Tab 1-1b {data-test-id="Tab 1-1b"}
+
+Tab content, page 1, box 1, tab b
+
+## Box 1-2 {.tabset data-test-id="Box 1-2"}
+
+### Tab 1-2a {data-test-id="Tab 1-2a"}
+
+Tab content, page 1, box 2, tab a
+
+### Tab 1-2b {data-test-id="Tab 1-2b"}
+
+Tab content, page 1, box 2, tab b
+
+
+Page 2 {data-navmenu="Other" data-test-id="Page 2"}
+===================================
+
+## Row
+
+### Box 2-1 {data-test-id="Box 2-1"}
+
+Content, page 2, box 1
+
+### Box 2-2 {data-test-id="Box 2-2"}
+
+Content, page 2, box 2
+
+
+Page 3 {data-navmenu="Other" data-test-id="Page 3"}
+===================================
+
+## Row
+
+### Box 3-1 {data-test-id="Box 3-1"}
+
+Content, page 3, box 1
+
+### Box 3-2 {data-test-id="Box 3-2"}
+
+Content, page 3, box 2
diff --git a/inst/apps/309-flexdashboard-tabs-navs/tests/testthat.R b/inst/apps/309-flexdashboard-tabs-navs/tests/testthat.R
@@ -0,0 +1 @@
+shinytest2::test_app()
diff --git a/inst/apps/309-flexdashboard-tabs-navs/tests/testthat/setup-shinytest2.R b/inst/apps/309-flexdashboard-tabs-navs/tests/testthat/setup-shinytest2.R
@@ -0,0 +1,2 @@
+# Load application support files into testing environment
+shinytest2::load_app_env()
diff --git a/inst/apps/309-flexdashboard-tabs-navs/tests/testthat/test-shinytest2.R b/inst/apps/309-flexdashboard-tabs-navs/tests/testthat/test-shinytest2.R
@@ -0,0 +1,118 @@
+library(shinytest2)
+
+is_element_visible <- function(selector) {
+  sprintf("$('%s:visible').length > 0", selector)
+}
+
+is_test_element_visible <- function(test_id) {
+  is_element_visible(sprintf('[data-test-id="%s"]', test_id))
+}
+
+expect_test_element_visible <- function(app, test_id) {
+  expect_true(app$get_js(is_test_element_visible(!!test_id)))
+  return(invisible(app))
+}
+
+expect_test_element_hidden <- function(app, test_id) {
+  expect_false(app$get_js(is_test_element_visible(!!test_id)))
 jster <- shinyjster::shinyjster_js( 
   " 
     var jst = jster(0); 
     jst.add(Jster.shiny.waitUntilStable); 
     jst.add(function() { 
        var toggle = $('.navbar-toggle:visible'); 
        var nav    = $('.navbar-collapse:visible'); 
        Jster.assert.isEqual(toggle.length, 1, 'Failed to find collapsible menu, does the window need to be resized?'); 
        Jster.assert.isEqual(nav.length, 0, 'The collapsible navbar should not be visible by default'); 
        toggle.click(); 
     }); 
     // wait for nav to open 
     jst.add(function(done) { 
       var wait = function() { 
         if ($('.navbar-collapse:visible').length > 0) { 
           done(); 
         } else { 
           setTimeout(wait, 5); 
         } 
       } 
       wait(); 
     }); 
     jst.add(function() { 
       Jster.assert.isEqual( 
         $('.navbar-collapse:visible').length, 1, 
         'Clicking the navbar toggle should make the navbar appear.' 
       ); 
     }); 
     jst.test(); 
     " 
 ) 
 ```{r} 
 ## `{shinyjster}` note: 
 # From https://github.com/rstudio/shiny/issues/3780, we must delay the underlying initial 
 # call to `Shiny.setInputValue("jster_initialized", true)` due to changes in https://github.com/rstudio/shiny/pull/3666. 
 # Current stance is that https://github.com/rstudio/shiny/issues/3780 will not be resolved, so we must make a work around. 
 # This is done by delaying the initial call to `Shiny.setInputValue("jster_initialized", true)` 
 # by using a dynamic UI that is invalidated on the first draw, and then actually rendered on the second draw. 
 renderUI({ 
   shinyjster::shinyjster_js( 
     " 
     var jst = jster(); 
     jst.add(Jster.shiny.waitUntilStable); 
     jst.add(function(done) { 
       var wait = function() { 
         var txt = $('#status').get(0).textContent; 
         if ( 
           typeof txt == 'string' && 
           txt.length > 0 && 
           (txt.match(new RegExp('Pass|Fail')) ?? '').length > 0 
         ) { 
           done(); 
           return; 
         } 
         setTimeout(wait, 100); 
       } 
       wait(); 
     }) 
     jst.add(function() { 
       Jster.assert.isEqual( 
         $('#status').text().trim(), 
         'Pass' 
       ) 
     }) 
     jst.test(); 
     " 
   ) 
 }) 
 shinyjster::shinyjster_server(input, output) 
 ``` 
 jster <- shinyjster::shinyjster_js( 
   " 
     var jst = jster(0); 
     jst.add(Jster.shiny.waitUntilStable); 
  
     jst.add(function() { 
        var toggle = $('.navbar-toggle:visible'); 
        var nav    = $('.navbar-collapse:visible'); 
  
        Jster.assert.isEqual(toggle.length, 1, 'Failed to find collapsible menu, does the window need to be resized?'); 
        Jster.assert.isEqual(nav.length, 0, 'The collapsible navbar should not be visible by default'); 
        toggle.click(); 
     }); 
  
     // wait for nav to open 
     jst.add(function(done) { 
       var wait = function() { 
         if ($('.navbar-collapse:visible').length > 0) { 
           done(); 
         } else { 
           setTimeout(wait, 5); 
         } 
       } 
       wait(); 
     }); 
  
     jst.add(function() { 
       Jster.assert.isEqual( 
         $('.navbar-collapse:visible').length, 1, 
         'Clicking the navbar toggle should make the navbar appear.' 
       ); 
     }); 
  
     jst.test(); 
     " 
 ) 
 ```{r} 
 ## `{shinyjster}` note: 
 # From https://github.com/rstudio/shiny/issues/3780, we must delay the underlying initial 
 # call to `Shiny.setInputValue("jster_initialized", true)` due to changes in https://github.com/rstudio/shiny/pull/3666. 
 # Current stance is that https://github.com/rstudio/shiny/issues/3780 will not be resolved, so we must make a work around. 
 # This is done by delaying the initial call to `Shiny.setInputValue("jster_initialized", true)` 
 # by using a dynamic UI that is invalidated on the first draw, and then actually rendered on the second draw. 
 renderUI({ 
   shinyjster::shinyjster_js( 
     " 
     var jst = jster(); 
     jst.add(Jster.shiny.waitUntilStable); 
     jst.add(function(done) { 
       var wait = function() { 
         var txt = $('#status').get(0).textContent; 
         if ( 
           typeof txt == 'string' && 
           txt.length > 0 && 
           (txt.match(new RegExp('Pass|Fail')) ?? '').length > 0 
         ) { 
           done(); 
           return; 
         } 
         setTimeout(wait, 100); 
       } 
       wait(); 
     }) 
     jst.add(function() { 
       Jster.assert.isEqual( 
         $('#status').text().trim(), 
         'Pass' 
       ) 
     }) 
     jst.test(); 
     " 
   ) 
 }) 
  
 shinyjster::shinyjster_server(input, output) 
 ``` 
+  return(invisible(app))
+}
+
+for (bs_version in 3:5) {
+  test_that(paste0("309-flexdashboard-tabs-navs with BS", bs_version), {
+    app <- AppDriver$new(
+      name = "309-flexdashboard-tabs-navs",
+      seed = 62868,
+      height = 1292,
+      width = 798,
+      view = interactive(),
+      render_args = list(
+        params = list(bs_version = bs_version),
+        output_options = list(theme = list(version = bs_version))
+      )
+    )
+
+    app$wait_for_idle()
+    app$wait_for_js(is_test_element_visible("Page 1"))
+
+    # ---- Page 1 ----
+    # Page 1 and its boxes are visible
+    expect_test_element_visible(app, "Page 1")
+    expect_test_element_visible(app, "Box 1-1")
+    expect_test_element_visible(app, "Box 1-2")
+
+    # Check tab state on Page 1 (first tabs are visible)
+    expect_test_element_visible(app, "Tab 1-1a")
+    expect_test_element_visible(app, "Tab 1-2a")
+    # second tabs are hidden
+    expect_test_element_hidden(app, "Tab 1-1b")
+    expect_test_element_hidden(app, "Tab 1-2b")
+
+    # Pages 2 and 3 and their elements are hidden
+    expect_test_element_hidden(app, "Page 2")
+    expect_test_element_hidden(app, "Box 2-1")
+    expect_test_element_hidden(app, "Box 2-2")
+    expect_test_element_hidden(app, "Page 3")
+    expect_test_element_hidden(app, "Box 3-1")
+    expect_test_element_hidden(app, "Box 3-2")
+
+    # ---- Page 1: Change Tabs ----
+    # activate second tabs and check that visibility has switched
+    app$
+      click(selector = '[data-test-id="Page 1"] .nav-tabs [href$="tab-1-1b"]')$
+      wait_for_js(is_test_element_visible("Tab 1-1b"))
+
+    app$
+      click(selector = '[data-test-id="Page 1"] .nav-tabs [href$="tab-1-2b"]')$
+      wait_for_js(is_test_element_visible("Tab 1-2b"))
+
+    # now first tabs are hidden
+    expect_test_element_hidden(app, "Tab 1-1a")
+    expect_test_element_hidden(app, "Tab 1-2a")
+    # second tabs are visible
+    expect_test_element_visible(app, "Tab 1-1b")
+    expect_test_element_visible(app, "Tab 1-2b")
+
+    # ---- Page 2 ----
+    app$
+      click(selector = ".nav .dropdown .dropdown-toggle")$
+      wait_for_js(is_element_visible(".nav .dropdown .dropdown-menu"))$
+      click(selector = '.nav .dropdown-item[href$="page-2"]')$
+      wait_for_js(is_test_element_visible("Page 2"))
+
+    # Page 2 is visible
+    expect_test_element_visible(app, "Page 2")
+    expect_test_element_visible(app, "Box 2-1")
+    expect_test_element_visible(app, "Box 2-2")
+
+    # Pages 1 and 3 and their elements are hidden
+    expect_test_element_hidden(app, "Page 1")
+    expect_test_element_hidden(app, "Box 1-1")
+    expect_test_element_hidden(app, "Box 1-2")
+    expect_test_element_hidden(app, "Page 3")
+    expect_test_element_hidden(app, "Box 3-1")
+    expect_test_element_hidden(app, "Box 3-2")
+
+    # ---- Page 3 ----
+    app$
+      click(selector = ".nav .dropdown .dropdown-toggle")$
+      wait_for_js(is_element_visible(".nav .dropdown .dropdown-menu"))$
+      click(selector = '.nav .dropdown-item[href$="page-3"]')$
+      wait_for_js(is_test_element_visible("Page 3"))
+
+    # Page 3 is visible
+    expect_test_element_visible(app, "Page 3")
+    expect_test_element_visible(app, "Box 3-1")
+    expect_test_element_visible(app, "Box 3-2")
+
+    # Pages 1 and 2 and their elements are hidden
+    expect_test_element_hidden(app, "Page 1")
+    expect_test_element_hidden(app, "Box 1-1")
+    expect_test_element_hidden(app, "Box 1-2")
+    expect_test_element_hidden(app, "Page 2")
+    expect_test_element_hidden(app, "Box 2-1")
+    expect_test_element_hidden(app, "Box 2-2")
+
+    app$stop()
+  })
+}
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1,2 @@
		# Load application support files into testing environment
		shinytest2::load_app_env()