Fixes integrations tests using wait_for_js implementation for visibility

.lintr

@@ -1,4 +1,5 @@
 linters: linters_with_defaults(
   line_length_linter = line_length_linter(120),
-  object_usage_linter = NULL
+  object_usage_linter = NULL,
+  pipe_consistency_linter = NULL
   )

tests/testthat/helpers-shinytest2.R

@@ -1,26 +1,91 @@
 default_idle_timeout <- 20000 # Wait (ms) at most until idle
 default_idle_duration <- 200 # Time (ms) it is idle
 
-# Check visibility (borrowed from teal.widgets/tests/testthat/helpers-utils.R)
-is_visible <- function(app_driver, element) {
-  js_script <- sprintf("
-    Array.from(document.querySelectorAll('%s')).map(el => {
-      return el.checkVisibility() && (el.textContent.trim().length > 0 || el.children.length > 0);
-    });
-  ", element)
+#' Function to check if an selector is visible in a shiny app
+#'
+#' The [shinytest2::AppDriver$wait_for_js()] method is used to check if the selector
+#' throws an error when the selector is not visible.
+#'
+#' @param selector `character(1)` CSS selector of the element to check visibility for.
+#' @param app_driver `shinytest2::AppDriver` AppDriver object of
+#' the shiny app.
+#' @param timeout `numeric(1)` maximum time to wait for the element to be
+#' visible. The default is the timeout set in the [shinytest2::AppDriver] object.
+#' @param expectation_fun `function` expectation function to use for checking
+#' visibility.
+#' @return `logical(1)` whether the selector is visible.
+#' @keywords internal
+expect_visible <- function(selector, app_driver, timeout) {
+  checkmate::assert_string(selector)
+  selector <- jsonlite::toJSON(selector, auto_unbox = TRUE)
+  checkmate::assert_r6(app_driver, "AppDriver")
 
-  any(unlist(app_driver$get_js(js_script)))
+  tryCatch(
+    {
+      app_driver$wait_for_js(
+        sprintf(
+          paste0(
+            "Array.from(document.querySelectorAll(%s))",
+            ".map(el => el.checkVisibility() && (el.textContent.trim().length > 0 || el.children.length > 0))",
+            ".some(Boolean)"
+          ),
+          selector
+        ),
+        timeout
+      )
+      testthat::succeed()
+    },
+    error = function(err) {
+      testthat::fail(sprintf("CSS selector '%s' does not produce any visible elements.", selector))
+    }
+  )
+}
+
+#' @describeIn expect_visible Check if an selector is hidden for a given timeout.
+expect_hidden <- function(selector, app_driver, timeout) {
+  checkmate::assert_string(selector)
+  selector <- jsonlite::toJSON(selector, auto_unbox = TRUE)
+  checkmate::assert_r6(app_driver, "AppDriver")
+  tryCatch(
+    {
+      app_driver$wait_for_js(
+        sprintf(
+          paste0(
+            "!Array.from(document.querySelectorAll(%s))",
+            ".map(el => el.checkVisibility() && (el.textContent.trim().length > 0 || el.children.length > 0))",
+            ".some(Boolean)"
+          ),
+          selector
+        ),
+        timeout
+      )
+      testthat::succeed()
+    },
+    error = function(err) {
+      testthat::fail(sprintf("CSS selector '%s' produces visible elements.", selector))
+    }
+  )
 }
 
 # Write a js code to extract the classes
 get_attribute <- function(selector, attribute) {
+  checkmate::assert_string(selector)
+  checkmate::assert_string(attribute)
+  selector <- jsonlite::toJSON(selector, auto_unbox = TRUE)
   sprintf(
-    "Array.from(document.querySelectorAll('%s')).map(el => el.getAttribute('%s'))",
+    "Array.from(document.querySelectorAll(%s)).map(el => el.getAttribute(\"%s\"))",
     selector, attribute
   )
 }
 
-is_existing <- function(app_driver, element) {
-  js_script <- sprintf("document.querySelectorAll('%s').length > 0;", element)
-  app_driver$get_js(js_script)
+expect_existing <- function(app_driver, selector) {
+  checkmate::assert_string(selector)
+  selector <- jsonlite::toJSON(selector, auto_unbox = TRUE)
+  app_driver$wait_for_js(sprintf("document.querySelectorAll(%s).length > 0", selector))
+}
+
+expect_not_existing <- function(app_driver, selector) {
+  checkmate::assert_string(selector)
+  selector <- jsonlite::toJSON(selector, auto_unbox = TRUE)
+  app_driver$wait_for_js(sprintf("document.querySelectorAll(%s).length == 0", selector))
 }

tests/testthat/test-shinytest2_DataframeFilteredDataset.R

@@ -69,17 +69,17 @@ local_app_driver <- function(...,
 testthat::describe("Toggle button shows and hide", {
   it("'Active Filter Summary' panel", {
     app_driver <- local_app_driver()
-    testthat::expect_true(is_visible(app_driver, "#filter_panel-overview-table"))
+    expect_visible("#filter_panel-overview-table", app_driver)
     app_driver$click(selector = "#filter_panel-overview-main_filter_accordion * button")
     app_driver$wait_for_idle(timeout = default_idle_timeout * 8)
-    testthat::expect_false(is_visible(app_driver, "#filter_panel-overview-table"))
+    expect_hidden("#filter_panel-overview-table", app_driver)
   })
   it("'Filter Data' panel", {
     app_driver <- local_app_driver()
-    testthat::expect_true(is_visible(app_driver, "#filter_panel-active-filter_active_vars_contents"))
+    expect_visible("#filter_panel-active-filter_active_vars_contents", app_driver)
     app_driver$click(selector = "#filter_panel-active-main_filter_accordion > div > div.accordion-header > button")
     app_driver$wait_for_idle(timeout = default_idle_timeout * 8)
-    testthat::expect_false(is_visible(app_driver, "#filter_panel-active-filter_active_vars_contents"))
+    expect_hidden("#filter_panel-active-filter_active_vars_contents", app_driver)
   })
 })
 
@@ -125,11 +125,11 @@ testthat::describe("teal_slice objects pass to filter data", {
 
 testthat::test_that("Clicking add button on the datasets shows add filter panel", {
   app_driver <- local_app_driver()
-  testthat::expect_true(is_existing(app_driver, "#filter_panel-active-mtcars-add_filter_icon"))
+  expect_existing(app_driver, "#filter_panel-active-mtcars-add_filter_icon")
   app_driver$click(selector = "#filter_panel-active-mtcars-add_filter_icon")
   app_driver$wait_for_idle(duration = default_idle_duration * 8) # Wait for the panel open animation
-  testthat::expect_true(is_existing(app_driver, "#filter_panel-active-mtcars-mtcars-filter-var_to_add > option"))
-  testthat::expect_true(is_visible(app_driver, "#filter_panel-active-mtcars-mtcars-filter-var_to_add > option"))
+  expect_existing(app_driver, "#filter_panel-active-mtcars-mtcars-filter-var_to_add > option")
+  expect_visible("#filter_panel-active-mtcars-mtcars-filter-var_to_add > option", app_driver)
 })
 
 testthat::test_that("Clicking add and selecting a variable adds the card for a given variable", {
@@ -187,7 +187,7 @@ testthat::test_that("Remove filter button removes a specific filter card", {
     teal_slice(dataname = "mtcars", varname = "mpg", selected = c(20.0, 25.0))
   )
   selector <- "#filter_panel-active-mtcars-filter-mtcars_mpg-remove"
-  testthat::expect_true(is_visible(app_driver, selector))
+  expect_visible(selector, app_driver)
   filters_before <- app_driver$get_text("div.filter-card-varname > strong")
   app_driver$click(selector = selector)
   app_driver$wait_for_idle(default_idle_duration * 8)
@@ -204,7 +204,7 @@ testthat::test_that("Remove datasets filters removes all cards.", {
   )
 
   selector <- "#filter_panel-active-mtcars-remove_filters"
-  testthat::expect_true(is_visible(app_driver, selector))
+  expect_visible(selector, app_driver)
   filters_before <- app_driver$get_text("div.filter-card-varname > strong")
   app_driver$click(selector = selector)
   app_driver$wait_for_idle(default_idle_duration * 8)
@@ -219,7 +219,7 @@ testthat::test_that("Remove all filters button removes all cards for all dataset
     teal_slice(dataname = "mtcars", varname = "mpg", selected = c(20.0, 25.0))
   )
   selector <- "#filter_panel-active-remove_all_filters"
-  testthat::expect_true(is_visible(app_driver, selector))
+  expect_visible(selector, app_driver)
   app_driver$click(selector = selector)
   app_driver$wait_for_idle(default_idle_duration * 8)
   filters_after <- app_driver$get_text("div.filter-card-varname > strong")
@@ -235,11 +235,11 @@ testthat::test_that("Expanding a card shows filter choices.", {
   select_4_cyl <- "#filter_panel-active-mtcars-filter-4_cyl  > div.filter-card-header"
   app_driver$click(selector = select_4_cyl)
   app_driver$wait_for_idle(default_idle_duration * 8)
-  testthat::expect_false(is_existing(app_driver, "#filter_panel-active-mtcars-filter-4_cyl-body"))
+  expect_not_existing(app_driver, "#filter_panel-active-mtcars-filter-4_cyl-body")
 
   select_mpg <- "#filter_panel-active-mtcars-filter-mtcars_mpg > div.filter-card-header"
   app_driver$click(selector = select_mpg)
   app_driver$wait_for_idle(default_idle_duration * 8)
-  testthat::expect_true(is_existing(app_driver, "#filter_panel-active-mtcars-filter-mtcars_mpg-body"))
-  testthat::expect_true(is_visible(app_driver, "#filter_panel-active-mtcars-filter-mtcars_mpg-body"))
+  expect_existing(app_driver, "#filter_panel-active-mtcars-filter-mtcars_mpg-body")
+  expect_visible("#filter_panel-active-mtcars-filter-mtcars_mpg-body", app_driver)
 })