diff --git a/DESCRIPTION b/DESCRIPTION index b575a039ea..ba74cc30b0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data Version: 0.15.2.9004 -Date: 2024-03-15 +Date: 2024-03-18 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), @@ -60,6 +60,8 @@ Suggests: MultiAssayExperiment, R6, rmarkdown (>= 2.19), + rvest, + shinytest2, shinyvalidate, testthat (>= 3.1.5), withr (>= 2.1.0), @@ -84,6 +86,7 @@ LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.1 Collate: + 'TealAppDriver.R' 'dummy_functions.R' 'get_rcode_utils.R' 'include_css_js.R' diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R new file mode 100644 index 0000000000..fa30051e4c --- /dev/null +++ b/R/TealAppDriver.R @@ -0,0 +1,408 @@ +# FilteredData ------ + +#' Drive a `teal` application +#' +#' Extension of the `shinytest2::AppDriver` class with methods for +#' driving a teal application for performing interactions for `shinytest2` tests. +#' +#' @keywords internal +#' +TealAppDriver <- R6::R6Class( # nolint: object_name. + "TealAppDriver", + inherit = shinytest2::AppDriver, + # public methods ---- + public = list( + #' @description + #' Initialize a `TealAppDriver` object for testing a `teal` application. + #' + #' @param data,modules,filter,title,header,footer arguments passed to `init` + #' @param ... Additional arguments to be passed to `shinytest2::AppDriver$new` + #' + #' @return Object of class `TealAppDriver` + initialize = function(data, + modules, + filter = teal_slices(), + title = build_app_title(), + header = tags$p(), + footer = tags$p(), + ...) { + private$data <- data + private$modules <- modules + private$filter <- filter + app <- init( + data = data, + modules = modules, + filter = filter, + title = title, + header = header, + footer = footer + ) + suppressWarnings( + super$initialize( + shinyApp(app$ui, app$server), + name = "teal", + variant = platform_variant(), + ... + ) + ) + + private$set_active_ns() + }, + #' @description + #' Check if the app has shiny errors. This checks for global shiny errors. + #' Note that any shiny errors dependent on shiny server render will only be captured after the teal module tab + #' is visited because shiny will not trigger server computations when the tab is invisible. + #' So, navigate to the module tab you want to test before calling this function. + #' Although, this catches errors hidden in the other module tabs if they are already rendered. + expect_no_shiny_error = function() { + testthat::expect_null( + self$get_html(".shiny-output-error:not(.shiny-output-error-validation)"), + info = "Shiny error is observed" + ) + }, + #' @description + #' Check if the app has no validation errors. This checks for global shiny validation errors. + expect_no_validation_error = function() { + testthat::expect_null( + self$get_html(".shiny-output-error-validation"), + info = "No validation error is observed" + ) + }, + #' @description + #' Check if the app has validation errors. This checks for global shiny validation errors. + expect_validation_error = function() { + testthat::expect_false( + is.null(self$get_html(".shiny-output-error-validation")), + info = "Validation error is not observed" + ) + }, + #' @description + #' Set the input in the `teal` app. + #' + #' @param input_id (character) The shiny input id with it's complete name space. + #' @param value The value to set the input to. + #' @param ... Additional arguments to be passed to `shinytest2::AppDriver$set_inputs` + #' + #' @return The `TealAppDriver` object invisibly. + set_input = function(input_id, value, ...) { + do.call( + self$set_inputs, + c(setNames(list(value), input_id), list(...)) + ) + invisible(self) + }, + #' @description + #' Navigate the teal tabs in the `teal` app. + #' + #' @param tabs (character) Labels of tabs to navigate to. The order of the tabs is important, + #' and it should start with the most parent level tab. + #' Note: In case the teal tab group has duplicate names, the first tab will be selected, + #' If you wish to select the second tab with the same name, use the suffix "_1". + #' If you wish to select the third tab with the same name, use the suffix "_2" and so on. + #' + #' @return The `TealAppDriver` object invisibly. + navigate_teal_tab = function(tabs) { + checkmate::check_character(tabs, min.len = 1) + for (tab in tabs) { + root <- "root" + self$set_input( + sprintf("teal-main_ui-%s-active_tab", root), + get_unique_labels(tab), + wait_ = FALSE + ) + root <- sprintf("%s-%s", private$modules$label, get_unique_labels(tab)) + } + self$wait_for_idle(timeout = private$idle_timeout) + private$set_active_ns() + invisible(self) + }, + #' @description + #' Get the active shiny name space for different components of the teal app. + #' + #' @return (`list`) The list of active shiny name space of the teal components. + active_ns = function() { + if (identical(private$ns$module, character(0))) { + private$set_active_ns() + } + private$ns + }, + #' @description + #' Get the active shiny name space for interacting with the module content. + #' + #' @return (`string`) The active shiny name space of the component. + active_module_ns = function() { + if (identical(private$ns$module, character(0))) { + private$set_active_ns() + } + private$ns$module + }, + #' @description + #' Get the active shiny name space bound with a custom `element` name. + #' + #' @param element `character(1)` custom element name. + #' + #' @return (`string`) The active shiny name space of the component bound with the input `element`. + active_module_element = function(element) { + checkmate::assert_string(element) + sprintf("#%s-%s", self$active_module_ns(), element) + }, + #' @description + #' Get the active shiny name space for interacting with the filter panel. + #' + #' @return (`string`) The active shiny name space of the component. + active_filters_ns = function() { + if (identical(private$ns$filter_panel, character(0))) { + private$set_active_ns() + } + private$ns$filter_panel + }, + #' @description + #' Get the input from the module in the `teal` app. + #' This function will only access inputs from the name space of the current active teal module. + #' + #' @param input_id (character) The shiny input id to get the value from. + #' + #' @return The value of the shiny input. + get_active_module_input = function(input_id) { + checkmate::check_string(input_id) + self$get_value(input = sprintf("%s-%s", self$active_module_ns(), input_id)) + }, + #' @description + #' Get the output from the module in the `teal` app. + #' This function will only access outputs from the name space of the current active teal module. + #' + #' @param output_id (character) The shiny output id to get the value from. + #' + #' @return The value of the shiny output. + get_active_module_output = function(output_id) { + checkmate::check_string(output_id) + self$get_value(output = sprintf("%s-%s", self$active_module_ns(), output_id)) + }, + #' @description + #' Set the input in the module in the `teal` app. + #' This function will only set inputs in the name space of the current active teal module. + #' + #' @param input_id (character) The shiny input id to get the value from. + #' @param value The value to set the input to. + #' + #' @return The `TealAppDriver` object invisibly. + set_module_input = function(input_id, value) { + checkmate::check_string(input_id) + checkmate::check_string(value) + self$set_input( + sprintf("%s-%s", self$active_module_ns(), input_id), + value + ) + invisible(self) + }, + #' @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() + ) + ) |> unlist() + + available_datasets <- self$get_text( + sprintf( + "#%s-active-filter_active_vars_contents .filter_panel_dataname", + self$active_filters_ns() + ) + ) + available_datasets[displayed_datasets_index] + }, + #' @description + #' Get the active filter variables from a dataset in the `teal` app. + #' + #' @param dataset_name (character) The name of the dataset to get the filter variables from. + #' If `NULL`, the filter variables for all the datasets will be returned in a list. + get_active_data_filters = function(dataset_name = NULL) { + checkmate::check_string(dataset_name, null.ok = TRUE) + datasets <- self$get_active_filter_vars() + checkmate::assert_subset(dataset_name, datasets) + active_filters <- lapply( + datasets, + function(x) { + self$get_text( + sprintf( + "#%s-active-%s-filters .filter-card-varname", + self$active_filters_ns(), + x + ) + ) |> + gsub(pattern = "\\s", replacement = "") + } + ) + names(active_filters) <- datasets + if (!is.null(dataset_name)) { + active_filters <- active_filters[[dataset_name]] + } + 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 + ) + ) + }, + #' @description + #' Add a new variable from the dataset to be filtered. + #' + #' @param dataset_name (character) The name of the dataset to add the filter variable to. + #' @param var_name (character) The name of the variable to add to the filter panel. + #' + #' @return The `TealAppDriver` object invisibly. + add_filter_var = function(dataset_name, var_name) { + checkmate::check_string(dataset_name) + checkmate::check_string(var_name) + self$set_input( + sprintf( + "%s-add-%s-filter-var_to_add", + self$active_filters_ns(), + dataset_name + ), + var_name + ) + invisible(self) + }, + #' @description + #' Remove an active filter variable of a dataset from the active filter variables panel. + #' + #' @param dataset_name (character) The name of the dataset to remove the filter variable from. + #' If `NULL`, all the filter variables will be removed. + #' @param var_name (character) The name of the variable to remove from the filter panel. + #' If `NULL`, all the filter variables of the dataset will be removed. + #' + #' @return The `TealAppDriver` object invisibly. + remove_filter_var = function(dataset_name = NULL, var_name = NULL) { + checkmate::check_string(dataset_name, null.ok = TRUE) + checkmate::check_string(var_name, null.ok = TRUE) + if (is.null(dataset_name)) { + remove_selector <- sprintf( + "#%s-active-remove_all_filters", + self$active_filters_ns() + ) + } else if (is.null(var_name)) { + remove_selector <- sprintf( + "#%s-active-%s-remove_filters", + self$active_filters_ns(), + dataset_name + ) + } else { + remove_selector <- sprintf( + "#%s-active-%s-filter-%s_%s-remove", + self$active_filters_ns(), + dataset_name, + dataset_name, + var_name + ) + } + self$click( + selector = remove_selector + ) + invisible(self) + }, + #' @description + #' Set the active filter values for a variable of a dataset in the active filter variable panel. + #' + #' @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. + #' + #' @return The `TealAppDriver` object invisibly. + set_active_filter_selection = function(dataset_name, var_name, input, is_numeric = FALSE) { + 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 + ) + invisible(self) + }, + #' @description + #' Wrapper around `get_url()` method that opens the app in the browser. + #' + #' @return Nothing. Opens the underlying teal app in the browser. + open_url = function() { + browseURL(self$get_url()) + } + ), + # private members ---- + private = list( + # private attributes ---- + data = NULL, + modules = NULL, + filter = teal_slices(), + ns = list( + module = character(0), + filter_panel = character(0) + ), + idle_timeout = 20000, # 20 seconds + load_timeout = 100000, # 100 seconds + # private methods ---- + set_active_ns = function() { + all_inputs <- self$get_values()$input + active_tab_inputs <- all_inputs[grepl("-active_tab$", names(all_inputs))] + + tab_ns <- lapply(names(active_tab_inputs), function(name) { + gsub( + pattern = "-active_tab$", + replacement = sprintf("-%s", active_tab_inputs[[name]]), + name + ) + }) %>% + unlist() + active_ns <- tab_ns[1] + if (length(tab_ns) > 1) { + for (i in 2:length(tab_ns)) { + next_ns <- tab_ns[i] + if (grepl(pattern = active_ns, next_ns)) { + active_ns <- next_ns + } + } + } + private$ns$module <- sprintf("%s-%s", active_ns, "module") + + component <- "filter_panel" + if (!is.null(self$get_html(sprintf("#teal-main_ui-%s", component)))) { + private$ns[[component]] <- sprintf("teal-main_ui-%s", component) + } else { + private$ns[[component]] <- sprintf("%s-module_%s", active_ns, component) + } + } + ) +) diff --git a/R/modules.R b/R/modules.R index 820be2b474..933744cb51 100644 --- a/R/modules.R +++ b/R/modules.R @@ -267,7 +267,7 @@ modules <- function(..., label = "root") { # name them so we can more easily access the children # beware however that the label of the submodules should not be changed as it must be kept synced labels <- vapply(submodules, function(submodule) submodule$label, character(1)) - names(submodules) <- make.unique(gsub("[^[:alnum:]]+", "_", labels), sep = "_") + names(submodules) <- get_unique_labels(labels) structure( list( label = label, @@ -325,7 +325,7 @@ append_module <- function(modules, module) { checkmate::assert_class(module, "teal_module") modules$children <- c(modules$children, list(module)) labels <- vapply(modules$children, function(submodule) submodule$label, character(1)) - names(modules$children) <- make.unique(gsub("[^[:alnum:]]", "_", tolower(labels)), sep = "_") + names(modules$children) <- get_unique_labels(labels) modules } diff --git a/R/utils.R b/R/utils.R index 7bb091dc27..1a1c13c676 100644 --- a/R/utils.R +++ b/R/utils.R @@ -367,3 +367,16 @@ defunction <- function(x) { x } } + +#' Get unique labels +#' +#' Get unique labels for the modules to avoid namespace conflicts. +#' +#' @param labels (`character`) vector of labels +#' +#' @return (`character`) vector of unique labels +#' +#' @keywords internal +get_unique_labels <- function(labels) { + make.unique(gsub("[^[:alnum:]]", "_", tolower(labels)), sep = "_") +} diff --git a/man/TealAppDriver.Rd b/man/TealAppDriver.Rd new file mode 100644 index 0000000000..46a38b097f --- /dev/null +++ b/man/TealAppDriver.Rd @@ -0,0 +1,481 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/TealAppDriver.R +\name{TealAppDriver} +\alias{TealAppDriver} +\title{Drive a \code{teal} application} +\description{ +Drive a \code{teal} application + +Drive a \code{teal} application +} +\details{ +Extension of the \code{shinytest2::AppDriver} class with methods for +driving a teal application for performing interactions for \code{shinytest2} tests. +} +\keyword{internal} +\section{Super class}{ +\code{\link[shinytest2:AppDriver]{shinytest2::AppDriver}} -> \code{TealAppDriver} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-TealAppDriver-new}{\code{TealAppDriver$new()}} +\item \href{#method-TealAppDriver-expect_no_shiny_error}{\code{TealAppDriver$expect_no_shiny_error()}} +\item \href{#method-TealAppDriver-expect_no_validation_error}{\code{TealAppDriver$expect_no_validation_error()}} +\item \href{#method-TealAppDriver-expect_validation_error}{\code{TealAppDriver$expect_validation_error()}} +\item \href{#method-TealAppDriver-set_input}{\code{TealAppDriver$set_input()}} +\item \href{#method-TealAppDriver-navigate_teal_tab}{\code{TealAppDriver$navigate_teal_tab()}} +\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_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-open_url}{\code{TealAppDriver$open_url()}} +\item \href{#method-TealAppDriver-clone}{\code{TealAppDriver$clone()}} +} +} +\if{html}{\out{ +
Inherited methods + +
+}} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-new}{}}} +\subsection{Method \code{new()}}{ +Initialize a \code{TealAppDriver} object for testing a \code{teal} application. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$new( + data, + modules, + filter = teal_slices(), + title = build_app_title(), + header = tags$p(), + footer = tags$p(), + ... +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data, modules, filter, title, header, footer}}{arguments passed to \code{init}} + +\item{\code{...}}{Additional arguments to be passed to \code{shinytest2::AppDriver$new}} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +Object of class \code{TealAppDriver} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-expect_no_shiny_error}{}}} +\subsection{Method \code{expect_no_shiny_error()}}{ +Check if the app has shiny errors. This checks for global shiny errors. +Note that any shiny errors dependent on shiny server render will only be captured after the teal module tab +is visited because shiny will not trigger server computations when the tab is invisible. +So, navigate to the module tab you want to test before calling this function. +Although, this catches errors hidden in the other module tabs if they are already rendered. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$expect_no_shiny_error()}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-expect_no_validation_error}{}}} +\subsection{Method \code{expect_no_validation_error()}}{ +Check if the app has no validation errors. This checks for global shiny validation errors. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$expect_no_validation_error()}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-expect_validation_error}{}}} +\subsection{Method \code{expect_validation_error()}}{ +Check if the app has validation errors. This checks for global shiny validation errors. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$expect_validation_error()}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-set_input}{}}} +\subsection{Method \code{set_input()}}{ +Set the input in the \code{teal} app. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$set_input(input_id, value, ...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{input_id}}{(character) The shiny input id with it's complete name space.} + +\item{\code{value}}{The value to set the input to.} + +\item{\code{...}}{Additional arguments to be passed to \code{shinytest2::AppDriver$set_inputs}} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{TealAppDriver} object invisibly. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-navigate_teal_tab}{}}} +\subsection{Method \code{navigate_teal_tab()}}{ +Navigate the teal tabs in the \code{teal} app. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$navigate_teal_tab(tabs)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{tabs}}{(character) Labels of tabs to navigate to. The order of the tabs is important, +and it should start with the most parent level tab. +Note: In case the teal tab group has duplicate names, the first tab will be selected, +If you wish to select the second tab with the same name, use the suffix "_1". +If you wish to select the third tab with the same name, use the suffix "_2" and so on.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{TealAppDriver} object invisibly. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-active_ns}{}}} +\subsection{Method \code{active_ns()}}{ +Get the active shiny name space for different components of the teal app. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$active_ns()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\code{list}) The list of active shiny name space of the teal components. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-active_module_ns}{}}} +\subsection{Method \code{active_module_ns()}}{ +Get the active shiny name space for interacting with the module content. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$active_module_ns()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\code{string}) The active shiny name space of the component. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-active_module_element}{}}} +\subsection{Method \code{active_module_element()}}{ +Get the active shiny name space bound with a custom \code{element} name. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$active_module_element(element)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{element}}{\code{character(1)} custom element name.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +(\code{string}) 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()}}{ +Get the active shiny name space for interacting with the filter panel. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$active_filters_ns()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +(\code{string}) The active shiny name space of the component. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-get_active_module_input}{}}} +\subsection{Method \code{get_active_module_input()}}{ +Get the input from the module in the \code{teal} app. +This function will only access inputs from the name space of the current active teal module. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$get_active_module_input(input_id)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{input_id}}{(character) The shiny input id to get the value from.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The value of the shiny input. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-get_active_module_output}{}}} +\subsection{Method \code{get_active_module_output()}}{ +Get the output from the module in the \code{teal} app. +This function will only access outputs from the name space of the current active teal module. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$get_active_module_output(output_id)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{output_id}}{(character) The shiny output id to get the value from.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The value of the shiny output. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-set_module_input}{}}} +\subsection{Method \code{set_module_input()}}{ +Set the input in the module in the \code{teal} app. +This function will only set inputs in the name space of the current active teal module. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$set_module_input(input_id, value)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{input_id}}{(character) The shiny input id to get the value from.} + +\item{\code{value}}{The value to set the input to.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{TealAppDriver} object invisibly. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-get_active_filter_vars}{}}} +\subsection{Method \code{get_active_filter_vars()}}{ +Get the active datasets that can be accessed via the filter panel of the current active teal module. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$get_active_filter_vars()}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-get_active_data_filters}{}}} +\subsection{Method \code{get_active_data_filters()}}{ +Get the active filter variables from a dataset in the \code{teal} app. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$get_active_data_filters(dataset_name = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{dataset_name}}{(character) The name of the dataset to get the filter variables from. +If \code{NULL}, the filter variables for all the datasets will be returned in a list.} +} +\if{html}{\out{
}} +} +} +\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()}}{ +Add a new variable from the dataset to be filtered. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$add_filter_var(dataset_name, var_name)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{dataset_name}}{(character) The name of the dataset to add the filter variable to.} + +\item{\code{var_name}}{(character) The name of the variable to add to the filter panel.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{TealAppDriver} object invisibly. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-remove_filter_var}{}}} +\subsection{Method \code{remove_filter_var()}}{ +Remove an active filter variable of a dataset from the active filter variables panel. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$remove_filter_var(dataset_name = NULL, var_name = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{dataset_name}}{(character) The name of the dataset to remove the filter variable from. +If \code{NULL}, all the filter variables will be removed.} + +\item{\code{var_name}}{(character) The name of the variable to remove from the filter panel. +If \code{NULL}, all the filter variables of the dataset will be removed.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{TealAppDriver} object invisibly. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-set_active_filter_selection}{}}} +\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{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{dataset_name}}{(character) The name of the dataset to set the filter value for.} + +\item{\code{var_name}}{(character) The name of the variable to set the filter value for.} + +\item{\code{input}}{The value to set the filter to.} + +\item{\code{is_numeric}}{(logical) If the variable is numeric or not.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{TealAppDriver} object invisibly. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-open_url}{}}} +\subsection{Method \code{open_url()}}{ +Wrapper around \code{get_url()} method that opens the app in the browser. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$open_url()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +Nothing. Opens the underlying teal app in the browser. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/get_unique_labels.Rd b/man/get_unique_labels.Rd new file mode 100644 index 0000000000..2791901a56 --- /dev/null +++ b/man/get_unique_labels.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{get_unique_labels} +\alias{get_unique_labels} +\title{Get unique labels} +\usage{ +get_unique_labels(labels) +} +\arguments{ +\item{labels}{(\code{character}) vector of labels} +} +\value{ +(\code{character}) vector of unique labels +} +\description{ +Get unique labels for the modules to avoid namespace conflicts. +} +\keyword{internal} diff --git a/tests/testthat/helper-shinytest2.R b/tests/testthat/helper-shinytest2.R new file mode 100644 index 0000000000..bf90d956f8 --- /dev/null +++ b/tests/testthat/helper-shinytest2.R @@ -0,0 +1,43 @@ +library(shinytest2) +library(rvest) + +default_idle_timeout <- 20000 + +simple_teal_data <- function() { + data <- within(teal_data(), { + iris <- iris + mtcars <- mtcars + }) + datanames(data) <- c("iris", "mtcars") + data +} + +report_module <- function(label = "example teal module") { + module( + label = label, + server = function(id, data, reporter) { + moduleServer(id, function(input, output, session) { + teal.reporter::simple_reporter_srv( + id = "reporter", + reporter = reporter, + card_fun = function(card) card + ) + updateSelectInput(session, "dataname", choices = isolate(datanames(data()))) + output$dataset <- renderPrint({ + req(input$dataname) + data()[[input$dataname]] + }) + }) + }, + ui = function(id) { + ns <- NS(id) + sidebarLayout( + sidebarPanel( + teal.reporter::simple_reporter_ui(ns("reporter")), + selectInput(ns("dataname"), "Choose a dataset", choices = NULL) + ), + mainPanel(verbatimTextOutput(ns("dataset"))) + ) + } + ) +} diff --git a/tests/testthat/test-shinytest2-filter_panel.R b/tests/testthat/test-shinytest2-filter_panel.R new file mode 100644 index 0000000000..5cc4ee2112 --- /dev/null +++ b/tests/testthat/test-shinytest2-filter_panel.R @@ -0,0 +1,111 @@ +testthat::test_that("e2e: module content is updated when a data is filtered in filter panel", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "Module_1"), + example_module(label = "Module_2") + ), + filter = teal_slices( + teal_slice(id = "iris_species", dataname = "iris", varname = "Species", multiple = TRUE), + teal_slice(id = "mtcars_cyl", dataname = "mtcars", varname = "cyl", selected = c(4, 6)), + teal_slice(id = "mtcars_drat", dataname = "mtcars", varname = "drat", selected = c(3, 4)), + teal_slice(id = "mtcars_gear", dataname = "mtcars", varname = "gear") + ) + ) + + app$wait_for_idle(timeout = default_idle_timeout) + + old_output <- app$get_active_module_output("text") + + app$set_active_filter_selection("iris", "Species", c("setosa", "versicolor")) + + testthat::expect_false( + identical(old_output, app$get_active_module_output("text")) + ) + + app$stop() +}) + +testthat::test_that("e2e: filtering a module-specific filter is refected in other shared module", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "Module_1"), + example_module(label = "Module_2") + ), + filter = teal_slices( + teal_slice(id = "iris_species", dataname = "iris", varname = "Species", multiple = TRUE), + teal_slice(id = "mtcars_cyl_1", dataname = "mtcars", varname = "cyl", selected = c(4, 6)), + teal_slice(id = "mtcars_cyl_2", dataname = "mtcars", varname = "cyl", selected = c(4, 6)), + module_specific = TRUE, + mapping = list( + "Module_1" = c("iris_species", "mtcars_cyl_1"), + "Module_2" = c("iris_species", "mtcars_cyl_2") + ) + ) + ) + + app$wait_for_idle(timeout = default_idle_timeout) + + expect_equal( + app$get_active_filter_selection("iris", "Species"), + c("setosa", "versicolor", "virginica") + ) + + app$navigate_teal_tab("Module_2") + app$wait_for_idle(timeout = default_idle_timeout) + + app$set_active_filter_selection("iris", "Species", c("setosa")) + + app$navigate_teal_tab("Module_1") + app$wait_for_idle(timeout = default_idle_timeout) + + expect_equal( + app$get_active_filter_selection("iris", "Species"), + c("setosa") + ) + + app$stop() +}) + +testthat::test_that("e2e: filtering a module-specific filter is not refected in other unshared modules", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "Module_1"), + example_module(label = "Module_2") + ), + filter = teal_slices( + teal_slice(id = "iris_species", dataname = "iris", varname = "Species", multiple = TRUE), + teal_slice(id = "mtcars_cyl_1", dataname = "mtcars", varname = "cyl", selected = c(4, 6)), + teal_slice(id = "mtcars_cyl_2", dataname = "mtcars", varname = "cyl", selected = c(4, 6)), + module_specific = TRUE, + mapping = list( + "Module_1" = c("iris_species", "mtcars_cyl_1"), + "Module_2" = c("iris_species", "mtcars_cyl_2") + ) + ) + ) + + app$wait_for_idle(timeout = default_idle_timeout) + + expect_equal( + app$get_active_filter_selection("mtcars", "cyl"), + c("4", "6") + ) + + app$navigate_teal_tab("Module_2") + app$wait_for_idle(timeout = default_idle_timeout) + + app$set_active_filter_selection("mtcars", "cyl", c("4")) + + app$navigate_teal_tab("Module_1") + app$wait_for_idle(timeout = default_idle_timeout) + + expect_equal( + app$get_active_filter_selection("mtcars", "cyl"), + c("4", "6") + ) + + app$stop() +}) diff --git a/tests/testthat/test-shinytest2-init.R b/tests/testthat/test-shinytest2-init.R new file mode 100644 index 0000000000..8141e1df0b --- /dev/null +++ b/tests/testthat/test-shinytest2-init.R @@ -0,0 +1,48 @@ +testthat::test_that("e2e: teal app initializes with no errors", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module") + ) + app$wait_for_idle(timeout = default_idle_timeout) + app$expect_no_shiny_error() + app$stop() +}) + +testthat::test_that("e2e: init creates UI containing specified title, favicon, header and footer", { + 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" + app_footer <- "Custom Teal App Footer" + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module"), + title = build_app_title( + app_title, + app_favicon + ), + header = app_header, + footer = app_footer + ) + app$wait_for_idle(timeout = default_idle_timeout) + + testthat::expect_equal( + app$get_text("head > title")[1], + app_title + ) + testthat::expect_equal( + app$get_html("head > link[rel='icon']") %>% + rvest::read_html() %>% + rvest::html_elements("link") %>% + rvest::html_attr("href"), + app_favicon + ) + testthat::expect_match( + app$get_text("header"), + app_header + ) + testthat::expect_match( + app$get_text("footer"), + app_footer + ) + app$stop() +}) diff --git a/tests/testthat/test-shinytest2-modules.R b/tests/testthat/test-shinytest2-modules.R new file mode 100644 index 0000000000..5c5233b226 --- /dev/null +++ b/tests/testthat/test-shinytest2-modules.R @@ -0,0 +1,117 @@ +testthat::test_that("e2e: the module server logic is only triggered when the teal module becomes active", { + value_export_module <- function(label = "custom module") { + module( + label = label, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + shiny::exportTestValues( + value = rnorm(1) + ) + }) + }, + ui = function(id) { + ns <- NS(id) + h1("Module that exports a random value for testing") + } + ) + } + + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + value_export_module(label = "Module 1"), + value_export_module(label = "Module 2") + ) + ) + app$wait_for_idle(timeout = default_idle_timeout) + test_exports <- app$get_values()$export + + expect_equal(length(test_exports), 1) + + app$navigate_teal_tab("Module 2") + test_exports <- app$get_values()$export + + expect_equal(length(test_exports), 2) + app$stop() +}) + + +testthat::test_that("e2e: filter panel only shows the data supplied using datanames", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "mtcars", datanames = "mtcars") + ) + ) + app$wait_for_idle(timeout = default_idle_timeout) + + testthat::expect_identical( + app$get_active_filter_vars(), + "mtcars" + ) + app$stop() +}) + +testthat::test_that("e2e: filter panel shows all the datasets when datanames is all", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "all", datanames = "all") + ) + ) + app$wait_for_idle(timeout = default_idle_timeout) + + testthat::expect_identical( + app$get_active_filter_vars(), + c("iris", "mtcars") + ) + app$stop() +}) + +testthat::test_that("e2e: filter panel is not displayed when datanames is NULL", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "NULL", datanames = NULL) + ) + ) + app$wait_for_idle(timeout = default_idle_timeout) + + testthat::expect_identical( + app$get_html(".teal_secondary_col") %>% + rvest::read_html() %>% + rvest::html_element("div") %>% + rvest::html_attr("style"), + "display: none;" + ) + + app$stop() +}) + +testthat::test_that("e2e: all the nested teal modules are initiated as expected", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "Example Module"), + modules( + label = "Nested Modules", + example_module(label = "Nested 1"), + example_module(label = "Nested 2"), + modules( + label = "Sub Nested Modules", + example_module(label = "Nested 1"), + example_module(label = "Nested 1") + ) + ) + ) + ) + app_modules <- app$get_text(selector = "ul.shiny-bound-input li a") + testthat::expect_identical( + app_modules, + c( + "Example Module", "Nested Modules", "Nested 1", "Nested 2", + "Sub Nested Modules", "Nested 1", "Nested 1" + ) + ) + app$stop() +}) diff --git a/tests/testthat/test-shinytest2-reporter.R b/tests/testthat/test-shinytest2-reporter.R new file mode 100644 index 0000000000..af5305ba4c --- /dev/null +++ b/tests/testthat/test-shinytest2-reporter.R @@ -0,0 +1,85 @@ +testthat::test_that("e2e: reporter tab is created when a module has reporter", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = report_module(label = "Module with Reporter") + ) + + teal_tabs <- app$get_html(selector = "#teal-main_ui-root-active_tab") %>% + rvest::read_html() %>% + rvest::html_elements("a") + tab_names <- setNames( + rvest::html_attr(teal_tabs, "data-value"), + rvest::html_text(teal_tabs) + ) + testthat::expect_identical( + tab_names, + c("Module with Reporter" = "module_with_reporter", "Report previewer" = "report_previewer") + ) + + app$stop() +}) + +testthat::test_that("e2e: reporter tab is not created when a module has no reporter", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module") + ) + teal_tabs <- app$get_html(selector = "#teal-main_ui-root-active_tab") %>% + rvest::read_html() %>% + rvest::html_elements("a") + tab_names <- setNames( + rvest::html_attr(teal_tabs, "data-value"), + rvest::html_text(teal_tabs) + ) + + testthat::expect_identical( + tab_names, + c("Example Module" = "example_module") + ) + + app$stop() +}) + +testthat::test_that("e2e: adding a report card in a module adds it in the report previewer tab", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = report_module(label = "Module with Reporter") + ) + app$wait_for_idle(timeout = default_idle_timeout) + + app$click(NS(app$active_module_ns(), "reporter-add_report_card_simple-add_report_card_button")) + app$wait_for_idle(timeout = default_idle_timeout) + + app$set_input( + NS(app$active_module_ns(), "reporter-add_report_card_simple-label"), + "Card name" + ) + app$set_input( + NS(app$active_module_ns(), "reporter-add_report_card_simple-label"), + "Card name" + ) + app$set_input( + NS(app$active_module_ns(), "reporter-add_report_card_simple-comment"), + "Card comment" + ) + + app$click(NS(app$active_module_ns(), "reporter-add_report_card_simple-add_card_ok")) + + app$navigate_teal_tab("Report previewer") + + accordian_selector <- sprintf("#%s-pcards .accordion-toggle", app$active_module_ns()) + app$click(selector = accordian_selector) + + + testthat::expect_match( + app$get_text(selector = accordian_selector), + "Card 1: Card name" + ) + + testthat::expect_match( + app$get_text(selector = "#card1 pre"), + "Card comment" + ) + + app$stop() +}) diff --git a/tests/testthat/test-shinytest2-teal_slices.R b/tests/testthat/test-shinytest2-teal_slices.R new file mode 100644 index 0000000000..c065d563b6 --- /dev/null +++ b/tests/testthat/test-shinytest2-teal_slices.R @@ -0,0 +1,101 @@ +testthat::test_that("e2e: teal_slices filters are initialized when global filters are created", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "Module_1"), + example_module(label = "Module_2") + ), + filter = teal_slices( + teal_slice(id = "iris_species", dataname = "iris", varname = "Species", multiple = TRUE), + teal_slice(id = "mtcars_cyl", dataname = "mtcars", varname = "cyl", selected = c(4, 6)), + teal_slice(id = "mtcars_drat", dataname = "mtcars", varname = "drat", selected = c(3, 4)), + teal_slice(id = "mtcars_gear", dataname = "mtcars", varname = "gear") + ) + ) + + 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"), + c("setosa", "versicolor", "virginica") + ) + testthat::expect_identical( + app$get_active_filter_selection("mtcars", "cyl"), + c("4", "6") + ) + testthat::expect_identical( + app$get_active_filter_selection("mtcars", "drat", is_numeric = TRUE), + c(3, 4) + ) + testthat::expect_identical( + app$get_active_filter_selection("mtcars", "gear"), + c("3", "4", "5") + ) + app$stop() +}) + +testthat::test_that("e2e: teal_slices filters are initialized when module specific filters are created", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "Module_1"), + example_module(label = "Module_2") + ), + filter = teal_slices( + teal_slice(id = "iris_species", dataname = "iris", varname = "Species", multiple = TRUE), + teal_slice(id = "mtcars_cyl", dataname = "mtcars", varname = "cyl", selected = c(4, 6)), + teal_slice(id = "mtcars_drat", dataname = "mtcars", varname = "drat", selected = c(3, 4)), + teal_slice(id = "mtcars_gear", dataname = "mtcars", varname = "gear"), + module_specific = TRUE, + mapping = list( + "Module_1" = c("iris_species", "mtcars_cyl"), + "Module_2" = c("iris_species", "mtcars_drat", "mtcars_gear") + ) + ) + ) + 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"), + c("setosa", "versicolor", "virginica") + ) + testthat::expect_identical( + app$get_active_filter_selection("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")) + + 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"), + c("setosa", "versicolor", "virginica") + ) + testthat::expect_identical( + app$get_active_filter_selection("mtcars", "drat", is_numeric = TRUE), + c(3, 4) + ) + testthat::expect_identical( + app$get_active_filter_selection("mtcars", "gear"), + c("3", "4", "5") + ) + testthat::expect_null(app$get_active_filter_selection("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 new file mode 100644 index 0000000000..f783360de6 --- /dev/null +++ b/tests/testthat/test-shinytest2-utils.R @@ -0,0 +1,31 @@ +testthat::test_that("e2e: show/hide hamburger works as expected", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module() + ) + + get_class_attributes <- function(app, selector) { + element <- app$get_html(selector = selector) %>% + rvest::read_html() %>% + rvest::html_elements(selector) + list( + class = rvest::html_attr(element, "class"), + style = rvest::html_attr(element, "style") + ) + } + + primary_attrs <- get_class_attributes(app, ".teal_primary_col") + secondary_attrs <- get_class_attributes(app, ".teal_secondary_col") + + testthat::expect_true(grepl("col-sm-9", primary_attrs$class)) + testthat::expect_false(isTruthy(secondary_attrs$style)) + + app$click(selector = ".btn.action-button.filter_hamburger") + app$wait_for_idle(timeout = default_idle_timeout) + primary_attrs <- get_class_attributes(app, ".teal_primary_col") + secondary_attrs <- get_class_attributes(app, ".teal_secondary_col") + + testthat::expect_true(grepl("col-sm-12", primary_attrs$class)) + testthat::expect_true(grepl("display: none;", secondary_attrs$style)) + app$stop() +})