diff --git a/DESCRIPTION b/DESCRIPTION index 4bc7c44982..eec199768d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9008 -Date: 2024-03-19 +Version: 0.15.2.9015 +Date: 2024-03-21 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), @@ -50,7 +50,7 @@ Imports: shinyjs, stats, teal.code (>= 0.5.0), - teal.logger (>= 0.1.1), + teal.logger (>= 0.1.3.9013), teal.reporter (>= 0.2.0), teal.widgets (>= 0.4.0), utils diff --git a/NEWS.md b/NEWS.md index 411f9877a3..d05a520160 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9008 +# teal 0.15.2.9015 # teal 0.15.2 diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R index 3be89af970..c075b9c7c8 100644 --- a/R/TealAppDriver.R +++ b/R/TealAppDriver.R @@ -147,6 +147,16 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. sprintf("#%s-%s", self$active_module_ns(), element) }, #' @description + #' Get the text of the active shiny name space bound with a custom `element` name. + #' + #' @param element `character(1)` the text of the custom element name. + #' + #' @return (`string`) The text of the active shiny name space of the component bound with the input `element`. + active_module_element_text = function(element) { + checkmate::assert_string(element) + self$get_text(self$active_module_element(element)) + }, + #' @description #' Get the active shiny name space for interacting with the filter panel. #' #' @return (`string`) The active shiny name space of the component. @@ -198,14 +208,16 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. #' @description #' Get the active datasets that can be accessed via the filter panel of the current active teal module. get_active_filter_vars = function() { - displayed_datasets_index <- self$get_js( - sprintf( - "Array.from( - document.querySelectorAll(\"#%s-active-filter_active_vars_contents > span\") - ).map((el) => window.getComputedStyle(el).display != \"none\");", - self$active_filters_ns() + displayed_datasets_index <- unlist( + self$get_js( + sprintf( + "Array.from( + document.querySelectorAll(\"#%s-active-filter_active_vars_contents > span\") + ).map((el) => window.getComputedStyle(el).display != \"none\");", + self$active_filters_ns() + ) ) - ) |> unlist() + ) available_datasets <- self$get_text( sprintf( @@ -227,45 +239,25 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. active_filters <- lapply( datasets, function(x) { - self$get_text( + var_names <- self$get_text( sprintf( "#%s-active-%s-filters .filter-card-varname", self$active_filters_ns(), x ) - ) |> + ) %>% gsub(pattern = "\\s", replacement = "") + structure( + lapply(var_names, private$get_active_filter_selection, dataset_name = x), + names = var_names + ) } ) names(active_filters) <- datasets - if (!is.null(dataset_name)) { - active_filters <- active_filters[[dataset_name]] + if (is.null(dataset_name)) { + return(active_filters) } - active_filters - }, - #' @description - #' Get the active filter values from the active filter selection of dataset from the filter panel. - #' - #' @param dataset_name (character) The name of the dataset to get the filter values from. - #' @param var_name (character) The name of the variable to get the filter values from. - #' @param is_numeric (logical) If the variable is numeric or not. - #' - #' @return The value of the active filter selection. - get_active_filter_selection = function(dataset_name, var_name, is_numeric = FALSE) { - checkmate::check_string(dataset_name) - checkmate::check_string(var_name) - checkmate::check_flag(is_numeric) - selection_suffix <- ifelse(is_numeric, "selection_manual", "selection") - self$get_value( - input = sprintf( - "%s-active-%s-filter-%s_%s-inputs-%s", - self$active_filters_ns(), - dataset_name, - dataset_name, - var_name, - selection_suffix - ) - ) + active_filters[[dataset_name]] }, #' @description #' Add a new variable from the dataset to be filtered. @@ -330,30 +322,78 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. #' @param dataset_name (character) The name of the dataset to set the filter value for. #' @param var_name (character) The name of the variable to set the filter value for. #' @param input The value to set the filter to. - #' @param is_numeric (logical) If the variable is numeric or not. + #' @param type (character) The type of the filter to get the value from. Default is `categorical`. #' #' @return The `TealAppDriver` object invisibly. - set_active_filter_selection = function(dataset_name, var_name, input, is_numeric = FALSE) { + set_active_filter_selection = function(dataset_name, var_name, input) { checkmate::check_string(dataset_name) checkmate::check_string(var_name) checkmate::check_string(input) - checkmate::check_flag(is_numeric) - selection_suffix <- ifelse(is_numeric, "selection_manual", "selection") - self$set_input( - sprintf( - "%s-active-%s-filter-%s_%s-inputs-%s", - self$active_filters_ns(), - dataset_name, - dataset_name, - var_name, - selection_suffix - ), - input + input_id_prefix <- sprintf( + "%s-active-%s-filter-%s_%s-inputs", + self$active_filters_ns(), + dataset_name, + dataset_name, + var_name + ) + + # Find the type of filter (based on filter panel) + supported_suffix <- c("selection", "selection_manual") + slices_suffix <- supported_suffix[ + match( + TRUE, + vapply( + supported_suffix, + function(suffix) { + !is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix))) + }, + logical(1) + ) + ) + ] + + # Generate correct namespace + slices_input_id <- sprintf( + "%s-active-%s-filter-%s_%s-inputs-%s", + self$active_filters_ns(), + dataset_name, + dataset_name, + var_name, + slices_suffix ) + + if (identical(slices_suffix, "selection_manual")) { + checkmate::assert_numeric(input, len = 2) + self$run_js( + sprintf( + "Shiny.setInputValue('%s:sw.numericRange', [%f, %f], {priority: 'event'})", + slices_input_id, + input[[1]], + input[[2]] + ) + ) + } else if (identical(slices_suffix, "selection")) { + self$set_input(slices_input_id, input) + } else { + stop("Filter selection set not supported for this slice.") + } + invisible(self) }, #' @description + #' Extract `html` attribute (found by a `selector`). + #' + #' @param selector (`character(1)`) specifying the selector to be used to get the content of a specific node. + #' @param attribute (`character(1)`) name of an attribute to retrieve from a node specified by `selector`. + #' + #' @return The `character` vector. + get_attr = function(selector, attribute) { + self$get_html_rvest("html") %>% + rvest::html_nodes(selector) %>% + rvest::html_attr(attribute) + }, + #' @description #' Wrapper around `get_html` that passes the output directly to `rvest::read_html`. #' #' @param selector `(character(1))` passed to `get_html`. @@ -419,6 +459,34 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. } else { private$ns[[component]] <- sprintf("%s-module_%s", active_ns, component) } + }, + # @description + # Get the active filter values from the active filter selection of dataset from the filter panel. + # + # @param dataset_name (character) The name of the dataset to get the filter values from. + # @param var_name (character) The name of the variable to get the filter values from. + # + # @return The value of the active filter selection. + get_active_filter_selection = function(dataset_name, var_name) { + checkmate::check_string(dataset_name) + checkmate::check_string(var_name) + input_id_prefix <- sprintf( + "%s-active-%s-filter-%s_%s-inputs", + self$active_filters_ns(), + dataset_name, + dataset_name, + var_name + ) + + # Find the type of filter (categorical or range) + supported_suffix <- c("selection", "selection_manual") + for (suffix in supported_suffix) { + if (!is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix)))) { + return(self$get_value(input = sprintf("%s-%s", input_id_prefix, suffix))) + } + } + + NULL # If there are not any supported filters } ) ) diff --git a/R/landing_popup_module.R b/R/landing_popup_module.R index 0637d153af..752cb0576c 100644 --- a/R/landing_popup_module.R +++ b/R/landing_popup_module.R @@ -66,7 +66,7 @@ landing_popup_module <- function(label = "Landing Popup", ) checkmate::assert_multi_class(buttons, classes = c("shiny.tag", "shiny.tag.list")) - logger::log_info("Initializing landing_popup_module") + message("Initializing landing_popup_module") module <- module( label = label, diff --git a/R/modules.R b/R/modules.R index 933744cb51..751d34fb74 100644 --- a/R/modules.R +++ b/R/modules.R @@ -206,7 +206,6 @@ module <- function(label = "module", datanames <- filters msg <- "The `filters` argument is deprecated and will be removed in the next release. Please use `datanames` instead." - logger::log_warn(msg) warning(msg) } diff --git a/R/reporter_previewer_module.R b/R/reporter_previewer_module.R index 2ee7560684..eeba694a7f 100644 --- a/R/reporter_previewer_module.R +++ b/R/reporter_previewer_module.R @@ -24,7 +24,7 @@ reporter_previewer_module <- function(label = "Report previewer", server_args = checkmate::assert_list(server_args, names = "named") checkmate::assert_true(all(names(server_args) %in% names(formals(teal.reporter::reporter_previewer_srv)))) - logger::log_info("Initializing reporter_previewer_module") + message("Initializing reporter_previewer_module") srv <- function(id, reporter, ...) { teal.reporter::reporter_previewer_srv(id, reporter, ...) diff --git a/R/zzz.R b/R/zzz.R index cacaf7775b..817f9bae4b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -10,6 +10,7 @@ # Set up the teal logger instance teal.logger::register_logger("teal") + teal.logger::register_handlers("teal") invisible() } diff --git a/man/TealAppDriver.Rd b/man/TealAppDriver.Rd index 0e1d25b585..b2f1521757 100644 --- a/man/TealAppDriver.Rd +++ b/man/TealAppDriver.Rd @@ -28,16 +28,17 @@ driving a teal application for performing interactions for \code{shinytest2} tes \item \href{#method-TealAppDriver-active_ns}{\code{TealAppDriver$active_ns()}} \item \href{#method-TealAppDriver-active_module_ns}{\code{TealAppDriver$active_module_ns()}} \item \href{#method-TealAppDriver-active_module_element}{\code{TealAppDriver$active_module_element()}} +\item \href{#method-TealAppDriver-active_module_element_text}{\code{TealAppDriver$active_module_element_text()}} \item \href{#method-TealAppDriver-active_filters_ns}{\code{TealAppDriver$active_filters_ns()}} \item \href{#method-TealAppDriver-get_active_module_input}{\code{TealAppDriver$get_active_module_input()}} \item \href{#method-TealAppDriver-get_active_module_output}{\code{TealAppDriver$get_active_module_output()}} \item \href{#method-TealAppDriver-set_module_input}{\code{TealAppDriver$set_module_input()}} \item \href{#method-TealAppDriver-get_active_filter_vars}{\code{TealAppDriver$get_active_filter_vars()}} \item \href{#method-TealAppDriver-get_active_data_filters}{\code{TealAppDriver$get_active_data_filters()}} -\item \href{#method-TealAppDriver-get_active_filter_selection}{\code{TealAppDriver$get_active_filter_selection()}} \item \href{#method-TealAppDriver-add_filter_var}{\code{TealAppDriver$add_filter_var()}} \item \href{#method-TealAppDriver-remove_filter_var}{\code{TealAppDriver$remove_filter_var()}} \item \href{#method-TealAppDriver-set_active_filter_selection}{\code{TealAppDriver$set_active_filter_selection()}} +\item \href{#method-TealAppDriver-get_attr}{\code{TealAppDriver$get_attr()}} \item \href{#method-TealAppDriver-get_html_rvest}{\code{TealAppDriver$get_html_rvest()}} \item \href{#method-TealAppDriver-open_url}{\code{TealAppDriver$open_url()}} \item \href{#method-TealAppDriver-wait_for_ouput_value}{\code{TealAppDriver$wait_for_ouput_value()}} @@ -240,6 +241,26 @@ Get the active shiny name space bound with a custom \code{element} name. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-active_module_element_text}{}}} +\subsection{Method \code{active_module_element_text()}}{ +Get the text of the active shiny name space bound with a custom \code{element} name. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$active_module_element_text(element)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{element}}{\code{character(1)} the text of the custom element name.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +(\code{string}) The text of the active shiny name space of the component bound with the input \code{element}. +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TealAppDriver-active_filters_ns}{}}} \subsection{Method \code{active_filters_ns()}}{ @@ -346,34 +367,6 @@ If \code{NULL}, the filter variables for all the datasets will be returned in a } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealAppDriver-get_active_filter_selection}{}}} -\subsection{Method \code{get_active_filter_selection()}}{ -Get the active filter values from the active filter selection of dataset from the filter panel. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealAppDriver$get_active_filter_selection( - dataset_name, - var_name, - is_numeric = FALSE -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataset_name}}{(character) The name of the dataset to get the filter values from.} - -\item{\code{var_name}}{(character) The name of the variable to get the filter values from.} - -\item{\code{is_numeric}}{(logical) If the variable is numeric or not.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -The value of the active filter selection. -} -} -\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TealAppDriver-add_filter_var}{}}} \subsection{Method \code{add_filter_var()}}{ @@ -425,12 +418,7 @@ The \code{TealAppDriver} object invisibly. \subsection{Method \code{set_active_filter_selection()}}{ Set the active filter values for a variable of a dataset in the active filter variable panel. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealAppDriver$set_active_filter_selection( - dataset_name, - var_name, - input, - is_numeric = FALSE -)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{TealAppDriver$set_active_filter_selection(dataset_name, var_name, input)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -442,7 +430,7 @@ Set the active filter values for a variable of a dataset in the active filter va \item{\code{input}}{The value to set the filter to.} -\item{\code{is_numeric}}{(logical) If the variable is numeric or not.} +\item{\code{type}}{(character) The type of the filter to get the value from. Default is \code{categorical}.} } \if{html}{\out{}} } @@ -451,6 +439,28 @@ The \code{TealAppDriver} object invisibly. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-get_attr}{}}} +\subsection{Method \code{get_attr()}}{ +Extract \code{html} attribute (found by a \code{selector}). +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$get_attr(selector, attribute)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{selector}}{(\code{character(1)}) specifying the selector to be used to get the content of a specific node.} + +\item{\code{attribute}}{(\code{character(1)}) name of an attribute to retrieve from a node specified by \code{selector}.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{character} vector. +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TealAppDriver-get_html_rvest}{}}} \subsection{Method \code{get_html_rvest()}}{ diff --git a/tests/testthat/setup-logger.R b/tests/testthat/setup-logger.R index 1a7b3e5c5f..aeb7fb70bb 100644 --- a/tests/testthat/setup-logger.R +++ b/tests/testthat/setup-logger.R @@ -1 +1 @@ -logger::log_appender(function(...) {}, namespace = "teal") +logger::log_appender(function(...) NULL, namespace = "teal") diff --git a/tests/testthat/setup-testing_depth.R b/tests/testthat/setup-testing_depth.R new file mode 100644 index 0000000000..3aa6cf3ec3 --- /dev/null +++ b/tests/testthat/setup-testing_depth.R @@ -0,0 +1,49 @@ +#' Returns testing depth set by session option or by environmental variable. +#' +#' @details Looks for the session option `TESTING_DEPTH` first. +#' If not set, takes the system environmental variable `TESTING_DEPTH`. +#' If neither is set, then returns 3 by default. +#' If the value of `TESTING_DEPTH` is not a numeric of length 1, then returns 3. +#' +#' @return `numeric(1)` the testing depth. +#' +get_testing_depth <- function() { + default_depth <- 3 + depth <- getOption("TESTING_DEPTH", Sys.getenv("TESTING_DEPTH", default_depth)) + depth <- tryCatch( + as.numeric(depth), + error = function(error) default_depth, + warning = function(warning) default_depth + ) + if (length(depth) != 1) depth <- default_depth + depth +} + +#' Skipping tests in the testthat pipeline under specific scope +#' @description This function should be used per each `testthat::test_that` call. +#' Each of the call should specify an appropriate depth value. +#' The depth value will set the appropriate scope so more/less time consuming tests could be recognized. +#' The environment variable `TESTING_DEPTH` is used for changing the scope of `testthat` pipeline. +#' `TESTING_DEPTH` interpretation for each possible value: +#' \itemize{ +#' \item{0}{no tests at all} +#' \item{1}{fast - small scope - executed on every commit} +#' \item{3}{medium - medium scope - daily integration pipeline} +#' \item{5}{slow - all tests - daily package tests} +#' } +#' @param depth `numeric` the depth of the testing evaluation, +#' has opposite interpretation to environment variable `TESTING_DEPTH`. +#' So e.g. `0` means run it always and `5` means a heavy test which should be run rarely. +#' If the `depth` argument is larger than `TESTING_DEPTH` then the test is skipped. +#' @importFrom testthat skip +#' @return `NULL` or invoke an error produced by `testthat::skip` +#' @note By default `TESTING_DEPTH` is equal to 3 if there is no environment variable for it. +#' By default `depth` argument lower or equal to 3 will not be skipped because by default `TESTING_DEPTH` +#' is equal to 3. To skip <= 3 depth tests then the environment variable has to be lower than 3 respectively. +skip_if_too_deep <- function(depth) { # nolintr + checkmate::assert_numeric(depth, len = 1, lower = 0, upper = 5) + testing_depth <- get_testing_depth() # by default 3 if there are no env variable + if (testing_depth < depth) { + testthat::skip(paste("testing depth", testing_depth, "is below current testing specification", depth)) + } +} diff --git a/tests/testthat/test-shinytest2-filter_panel.R b/tests/testthat/test-shinytest2-filter_panel.R index 5cc4ee2112..e2c07884df 100644 --- a/tests/testthat/test-shinytest2-filter_panel.R +++ b/tests/testthat/test-shinytest2-filter_panel.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: module content is updated when a data is filtered in filter panel", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -27,6 +28,7 @@ testthat::test_that("e2e: module content is updated when a data is filtered in f }) testthat::test_that("e2e: filtering a module-specific filter is refected in other shared module", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -69,6 +71,7 @@ testthat::test_that("e2e: filtering a module-specific filter is refected in othe }) testthat::test_that("e2e: filtering a module-specific filter is not refected in other unshared modules", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( diff --git a/tests/testthat/test-shinytest2-init.R b/tests/testthat/test-shinytest2-init.R index 39707c9847..c070d7b539 100644 --- a/tests/testthat/test-shinytest2-init.R +++ b/tests/testthat/test-shinytest2-init.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: teal app initializes with no errors", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = example_module(label = "Example Module") @@ -9,6 +10,7 @@ testthat::test_that("e2e: teal app initializes with no errors", { }) testthat::test_that("e2e: teal app initializes with sessionInfo modal", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = example_module(label = "Example Module") @@ -65,6 +67,7 @@ testthat::test_that("e2e: teal app initializes with sessionInfo modal", { }) testthat::test_that("e2e: init creates UI containing specified title, favicon, header and footer", { + skip_if_too_deep(5) app_title <- "Custom Teal App Title" app_favicon <- "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/teal.png" app_header <- "Custom Teal App Header" diff --git a/tests/testthat/test-shinytest2-landing_popup.R b/tests/testthat/test-shinytest2-landing_popup.R new file mode 100644 index 0000000000..c1d3826dbc --- /dev/null +++ b/tests/testthat/test-shinytest2-landing_popup.R @@ -0,0 +1,168 @@ +testthat::test_that("e2e: teal app with landing_popup_module initializes with no errors", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + landing_popup_module( + title = "Welcome", + content = tags$b("A welcome message!", style = "color: red;") + ), + example_module() + ) + ) + + app$wait_for_idle(timeout = default_idle_timeout) + testthat::expect_equal( + app$get_text("#landingpopup b"), + "A welcome message!" + ) + app$stop() +}) + +testthat::test_that("e2e: app with default landing_popup_module creates modal containing a button", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + landing_popup_module(), + example_module() + ) + ) + app$wait_for_idle(timeout = default_idle_timeout) + + testthat::expect_equal( + app$get_text("#shiny-modal-wrapper button"), + "Accept" + ) + + app$stop() +}) + +testthat::test_that("e2e: when default landing_popup_module is closed, it shows the underlying teal app", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + landing_popup_module(), + example_module() + ) + ) + app$wait_for_idle(timeout = default_idle_timeout) + + # Button is clicked. + app$click(selector = "#shiny-modal-wrapper button[data-dismiss='modal']") + app$wait_for_idle(timeout = default_idle_timeout) + + # There is no more modal displayed. + testthat::expect_null(app$get_html("#shiny-modal-wrapper")) + + app$stop() +}) + + +# customized landing_popup_module --------------------------------------------------------------------------------- + +testthat::test_that( + "e2e: app with customized landing_popup_module creates modal containing specified title, content and buttons", + { + skip_if_too_deep(5) + phash <- function(text) paste0("#", text) + + modal_title <- "Custom Landing Popup Module Title" + modal_content_message <- "A welcome message!" + modal_content <- tags$b(modal_content_message, style = "color: red;") + + modal_btns <- list( + go = list(text = "Proceed"), + more = list(text = "Read more", onclick = "window.open('http://google.com', '_blank')", id = "read"), + reject = list(text = "Reject", onclick = "window.close()", id = "close") + ) + modal_buttons <- + tagList( + shiny::modalButton(modal_btns$go$text), + shiny::actionButton( + modal_btns$more$id, + label = modal_btns$more$text, + onclick = modal_btns$more$onclick + ), + shiny::actionButton( + modal_btns$reject$id, + label = modal_btns$reject$text, + onclick = modal_btns$reject$onclick + ) + ) + + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + landing_popup_module( + title = modal_title, + content = modal_content, + buttons = modal_buttons + ), + example_module() + ) + ) + + app$wait_for_idle(timeout = default_idle_timeout) + + testthat::expect_equal( + app$get_text(".modal-title"), + modal_title + ) + + testthat::expect_equal( + trimws(app$get_text(".modal-body")), + modal_content_message + ) + + testthat::expect_equal( + app$get_text(".btn-default:nth-child(1)"), + modal_btns$go$text + ) + + testthat::expect_equal( + app$get_text(phash(modal_btns$more$id)), + modal_btns$more$text + ) + + testthat::expect_equal( + app$get_attr(phash(modal_btns$more$id), "onclick"), + modal_btns$more$onclick + ) + + testthat::expect_equal( + app$get_text(phash(modal_btns$reject$id)), + modal_btns$reject$text + ) + + testthat::expect_equal( + app$get_attr(phash(modal_btns$reject$id), "onclick"), + modal_btns$reject$onclick + ) + + app$stop() + } +) + +testthat::test_that("e2e: when customized button in landing_popup_module is clicked, it redirects to a certain page", { + skip_if_too_deep(5) + onclick_text <- "window.open('http://google.com', '_blank')" + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + landing_popup_module( + buttons = actionButton("read", "Read more", onclick = onclick_text) + ), + example_module() + ) + ) + app$wait_for_idle(timeout = default_idle_timeout) + + testthat::expect_equal( + app$get_attr("#read", "onclick"), + onclick_text + ) + + app$stop() +}) diff --git a/tests/testthat/test-shinytest2-modules.R b/tests/testthat/test-shinytest2-modules.R index d377b5564d..e547fdd397 100644 --- a/tests/testthat/test-shinytest2-modules.R +++ b/tests/testthat/test-shinytest2-modules.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: the module server logic is only triggered when the teal module becomes active", { + skip_if_too_deep(5) value_export_module <- function(label = "custom module") { module( label = label, @@ -37,6 +38,7 @@ testthat::test_that("e2e: the module server logic is only triggered when the tea testthat::test_that("e2e: filter panel only shows the data supplied using datanames", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -53,6 +55,7 @@ testthat::test_that("e2e: filter panel only shows the data supplied using datana }) testthat::test_that("e2e: filter panel shows all the datasets when datanames is all", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -69,6 +72,7 @@ testthat::test_that("e2e: filter panel shows all the datasets when datanames is }) testthat::test_that("e2e: filter panel is not displayed when datanames is NULL", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -88,6 +92,7 @@ testthat::test_that("e2e: filter panel is not displayed when datanames is NULL", }) testthat::test_that("e2e: all the nested teal modules are initiated as expected", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( diff --git a/tests/testthat/test-shinytest2-reporter.R b/tests/testthat/test-shinytest2-reporter.R index ddb3617713..46ba6f9bc9 100644 --- a/tests/testthat/test-shinytest2-reporter.R +++ b/tests/testthat/test-shinytest2-reporter.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: reporter tab is created when a module has reporter", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = report_module(label = "Module with Reporter") @@ -19,6 +20,7 @@ testthat::test_that("e2e: reporter tab is created when a module has reporter", { }) testthat::test_that("e2e: reporter tab is not created when a module has no reporter", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = example_module(label = "Example Module") @@ -39,6 +41,7 @@ testthat::test_that("e2e: reporter tab is not created when a module has no repor }) testthat::test_that("e2e: adding a report card in a module adds it in the report previewer tab", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = report_module(label = "Module with Reporter") diff --git a/tests/testthat/test-shinytest2-show-rcode.R b/tests/testthat/test-shinytest2-show-rcode.R index 5c1b031f56..09cc122080 100644 --- a/tests/testthat/test-shinytest2-show-rcode.R +++ b/tests/testthat/test-shinytest2-show-rcode.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: teal app initializes with Show R Code modal", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = example_module(label = "Example Module") diff --git a/tests/testthat/test-shinytest2-teal_data_module.R b/tests/testthat/test-shinytest2-teal_data_module.R new file mode 100644 index 0000000000..3c90248e0c --- /dev/null +++ b/tests/testthat/test-shinytest2-teal_data_module.R @@ -0,0 +1,128 @@ +testthat::test_that("e2e: teal_data_module will have a delayed load of datasets", { + skip_if_too_deep(5) + tdm <- teal_data_module( + ui = function(id) { + ns <- shiny::NS(id) + shiny::actionButton(ns("submit"), label = "Load data") + }, + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::eventReactive(input$submit, { + data <- within( + teal_data(), + { + dataset1 <- iris + dataset2 <- mtcars + } + ) + datanames(data) <- c("dataset1", "dataset2") + + data + }) + }) + } + ) + + app <- TealAppDriver$new( + data = tdm, + modules = example_module(label = "Example Module"), + timeout = default_idle_timeout + ) + + app$click("teal_data_module-submit") + app$wait_for_idle() + testthat::expect_setequal(app$get_active_filter_vars(), c("dataset1", "dataset2")) + + app$stop() +}) + +testthat::test_that("e2e: teal_data_module shows validation errors", { + skip_if_too_deep(5) + tdm <- teal_data_module( + ui = function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::textInput(ns("new_column"), label = "New column name"), + shiny::actionButton(ns("submit"), label = "Load data") + ) + }, + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::eventReactive(input$submit, { + shiny::validate( + shiny::need(input$new_column, "Please provide a new column name") + ) + data <- within(teal_data(), dataset1 <- iris) + datanames(data) <- c("dataset1") + data + }) + }) + } + ) + + app <- TealAppDriver$new( + data = tdm, + modules = example_module(label = "Example Module"), + timeout = default_idle_timeout + ) + app$wait_for_idle() + + app$click("teal_data_module-submit") + + app$expect_validation_error() + + app$stop() +}) + +testthat::test_that("e2e: teal_data_module inputs change teal_data object that is passed to teal main UI", { + skip_if_too_deep(5) + tdm <- teal_data_module( + ui = function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::textInput(ns("new_column"), label = "New column name"), + shiny::actionButton(ns("submit"), label = "Load data") + ) + }, + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::eventReactive(input$submit, { + shiny::validate( + shiny::need(input$new_column, "Please provide a new column name") + ) + data <- within( + teal_data(), + { + dataset1 <- iris + dataset1[[new_column]] <- sprintf("%s new", dataset1$Species) + }, + new_column = input$new_column + ) + datanames(data) <- c("dataset1") + + data + }) + }) + } + ) + + app <- TealAppDriver$new( + data = tdm, + modules = example_module(label = "Example Module"), + timeout = default_idle_timeout + ) + app$wait_for_idle() + app$set_input("teal_data_module-new_column", "A_New_Column") + app$click("teal_data_module-submit") + + # This may fail if teal_data_module does not perform the transformation + testthat::expect_no_error(app$add_filter_var("dataset1", "A_New_Column")) + + app$wait_for_idle() + testthat::expect_setequal( + app$get_active_filter_selection("dataset1", "A_New_Column"), + unique(sprintf("%s new", iris$Species)) + ) + + app$stop() +}) diff --git a/tests/testthat/test-shinytest2-teal_slices.R b/tests/testthat/test-shinytest2-teal_slices.R index c065d563b6..119bd7526a 100644 --- a/tests/testthat/test-shinytest2-teal_slices.R +++ b/tests/testthat/test-shinytest2-teal_slices.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: teal_slices filters are initialized when global filters are created", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -15,28 +16,35 @@ testthat::test_that("e2e: teal_slices filters are initialized when global filter app$wait_for_idle(timeout = default_idle_timeout) - testthat::expect_identical(app$get_active_data_filters("iris"), "Species") - testthat::expect_identical(app$get_active_data_filters("mtcars"), c("cyl", "drat", "gear")) testthat::expect_identical( - app$get_active_filter_selection("iris", "Species"), + names(app$get_active_data_filters("iris")), + "Species" + ) + testthat::expect_identical( + names(app$get_active_data_filters("mtcars")), + c("cyl", "drat", "gear") + ) + testthat::expect_identical( + app$get_active_data_filters("iris")$Species, c("setosa", "versicolor", "virginica") ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "cyl"), + app$get_active_data_filters("mtcars")$cyl, c("4", "6") ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "drat", is_numeric = TRUE), + app$get_active_data_filters("mtcars")$drat, c(3, 4) ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "gear"), + app$get_active_data_filters("mtcars")$gear, c("3", "4", "5") ) app$stop() }) testthat::test_that("e2e: teal_slices filters are initialized when module specific filters are created", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -57,45 +65,50 @@ testthat::test_that("e2e: teal_slices filters are initialized when module specif ) app$wait_for_idle(timeout = default_idle_timeout) - testthat::expect_identical(app$get_active_data_filters("iris"), "Species") - testthat::expect_identical(app$get_active_data_filters("mtcars"), "cyl") testthat::expect_identical( - app$get_active_filter_selection("iris", "Species"), + names(app$get_active_data_filters("iris")), + "Species" + ) + testthat::expect_identical( + names(app$get_active_data_filters("mtcars")), + "cyl" + ) + testthat::expect_identical( + app$get_active_data_filters("iris")$Species, c("setosa", "versicolor", "virginica") ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "cyl"), + app$get_active_data_filters("mtcars")$cyl, c("4", "6") ) - testthat::expect_null(app$get_active_filter_selection("mtcars", "drat", is_numeric = TRUE)) - testthat::expect_null(app$get_active_filter_selection("mtcars", "gear")) + + testthat::expect_null(app$get_active_data_filters("mtcars")$drat) + testthat::expect_null(app$get_active_data_filters("mtcars")$gear) app$navigate_teal_tab("Module_2") app$wait_for_idle(timeout = default_idle_timeout) - testthat::expect_identical(app$get_active_data_filters("iris"), "Species") - testthat::expect_identical(app$get_active_data_filters("mtcars"), c("drat", "gear")) testthat::expect_identical( - app$get_active_filter_selection("iris", "Species"), + names(app$get_active_data_filters("iris")), + "Species" + ) + testthat::expect_identical( + names(app$get_active_data_filters("mtcars")), + c("drat", "gear") + ) + testthat::expect_identical( + app$get_active_data_filters("iris")$Species, c("setosa", "versicolor", "virginica") ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "drat", is_numeric = TRUE), + app$get_active_data_filters("mtcars")$drat, c(3, 4) ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "gear"), + app$get_active_data_filters("mtcars")$gear, c("3", "4", "5") ) - testthat::expect_null(app$get_active_filter_selection("mtcars", "cyl")) + testthat::expect_null(app$get_active_data_filters("mtcars")$cyl) - app$set_active_filter_selection("iris", "Species", "setosa") - app$navigate_teal_tab("Module_1") - app$wait_for_idle(timeout = default_idle_timeout) - - testthat::expect_identical( - app$get_active_filter_selection("iris", "Species"), - "setosa" - ) app$stop() }) diff --git a/tests/testthat/test-shinytest2-utils.R b/tests/testthat/test-shinytest2-utils.R index 99ef2a0bf9..20b3e9d0d3 100644 --- a/tests/testthat/test-shinytest2-utils.R +++ b/tests/testthat/test-shinytest2-utils.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: show/hide hamburger works as expected", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = example_module() diff --git a/vignettes/bootstrap-themes-in-teal.Rmd b/vignettes/bootstrap-themes-in-teal.Rmd index 8fe61a2bc9..e491821c53 100644 --- a/vignettes/bootstrap-themes-in-teal.Rmd +++ b/vignettes/bootstrap-themes-in-teal.Rmd @@ -44,7 +44,7 @@ Available Bootstrap versions could be checked with `bslib::versions()` and Boots ``` # bslib::versions() # bslib::bootswatch_themes(version = "5") -options("teal.bs_theme" = bslib::bs_theme(version = "5", bootswatch = "lux") +options("teal.bs_theme" = bslib::bs_theme(version = "5", bootswatch = "lux")) # or options("teal.bs_theme" = bslib::bs_theme_update(bslib::bs_theme(version = "5"), bootswatch = "lux")) ```