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()
+})