diff --git a/.lintr b/.lintr index 3377b6466..13fa06ef2 100644 --- a/.lintr +++ b/.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 ) diff --git a/tests/testthat/helpers-shinytest2.R b/tests/testthat/helpers-shinytest2.R index 7ecbf739e..8ace5759a 100644 --- a/tests/testthat/helpers-shinytest2.R +++ b/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)) } diff --git a/tests/testthat/test-shinytest2_DataframeFilteredDataset.R b/tests/testthat/test-shinytest2_DataframeFilteredDataset.R index cdd3ce60f..ad5be63f8 100644 --- a/tests/testthat/test-shinytest2_DataframeFilteredDataset.R +++ b/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) })