From 06effc5e5b098eb366334c53d6f47a81ac15e723 Mon Sep 17 00:00:00 2001 From: kartikeya kirar Date: Fri, 15 Mar 2024 15:20:21 +0530 Subject: [PATCH 01/35] 52 standardise optional notation (#1121) part of https://github.com/insightsengineering/nestdevs-tasks/issues/52 --------- Signed-off-by: kartikeya kirar Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> --- R/init.R | 4 ++-- R/modules.R | 2 +- R/show_rcode_modal.R | 4 ++-- R/teal_slices.R | 2 +- R/utils.R | 2 +- man/init.Rd | 4 ++-- man/modules_depth.Rd | 2 +- man/report_card_template.Rd | 2 +- man/show_rcode_modal.Rd | 4 ++-- man/teal_slices.Rd | 2 +- 10 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/init.R b/R/init.R index 9b43ae0397..445d9432b0 100644 --- a/R/init.R +++ b/R/init.R @@ -31,8 +31,8 @@ #' The header of the app. #' @param footer (`shiny.tag` or `character(1)`) #' The footer of the app. -#' @param id (`character`) -#' Optional string specifying the `shiny` module id in cases it is used as a `shiny` module +#' @param id (`character`) optional +#' string specifying the `shiny` module id in cases it is used as a `shiny` module #' rather than a standalone `shiny` app. This is a legacy feature. #' #' @return Named list with server and UI functions. diff --git a/R/modules.R b/R/modules.R index 90fdd62b7f..820be2b474 100644 --- a/R/modules.R +++ b/R/modules.R @@ -395,7 +395,7 @@ is_arg_used <- function(modules, arg) { #' Nesting it increases overall depth by 1. #' #' @inheritParams init -#' @param depth optional, integer determining current depth level +#' @param depth optional integer determining current depth level #' #' @return Depth level for given module. #' @keywords internal diff --git a/R/show_rcode_modal.R b/R/show_rcode_modal.R index 9ef042ed99..762257124a 100644 --- a/R/show_rcode_modal.R +++ b/R/show_rcode_modal.R @@ -8,8 +8,8 @@ #' Title of the modal, displayed in the first comment of the `R` code. #' @param rcode (`character`) #' vector with `R` code to show inside the modal. -#' @param session (`ShinySession` optional) -#' `shiny` session object, if missing then [shiny::getDefaultReactiveDomain()] is used. +#' @param session (`ShinySession`) optional +#' `shiny` session object, defaults to [shiny::getDefaultReactiveDomain()]. #' #' @references [shiny::showModal()] #' @export diff --git a/R/teal_slices.R b/R/teal_slices.R index 6c1235c9bc..f27f339842 100644 --- a/R/teal_slices.R +++ b/R/teal_slices.R @@ -9,7 +9,7 @@ #' #' @inheritParams teal.slice::teal_slices #' -#' @param module_specific optional (`logical(1)`) +#' @param module_specific (`logical(1)`) optional, #' - `FALSE` (default) when one filter panel applied to all modules. #' All filters will be shared by all modules. #' - `TRUE` when filter panel module-specific. diff --git a/R/utils.R b/R/utils.R index 43ad20f4e5..7bb091dc27 100644 --- a/R/utils.R +++ b/R/utils.R @@ -80,7 +80,7 @@ teal_data_to_filtered_data <- function(x, datanames = teal_data_datanames(x)) { #' #' @param title (`character(1)`) title of the card (unless overwritten by label) #' @param label (`character(1)`) label provided by the user when adding the card -#' @param description (`character(1)`) optional additional description +#' @param description (`character(1)`) optional, additional description #' @param with_filter (`logical(1)`) flag indicating to add filter state #' @param filter_panel_api (`FilterPanelAPI`) object with API that allows the generation #' of the filter state in the report diff --git a/man/init.Rd b/man/init.Rd index 89a588328f..991a7db62c 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -38,8 +38,8 @@ The header of the app.} \item{footer}{(\code{shiny.tag} or \code{character(1)}) The footer of the app.} -\item{id}{(\code{character}) -Optional string specifying the \code{shiny} module id in cases it is used as a \code{shiny} module +\item{id}{(\code{character}) optional +string specifying the \code{shiny} module id in cases it is used as a \code{shiny} module rather than a standalone \code{shiny} app. This is a legacy feature.} } \value{ diff --git a/man/modules_depth.Rd b/man/modules_depth.Rd index 37a59c5f7d..4501141cb2 100644 --- a/man/modules_depth.Rd +++ b/man/modules_depth.Rd @@ -13,7 +13,7 @@ nested list of \code{teal_modules} or \code{teal_module} objects or a single will be displayed in the \code{teal} application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for more details.} -\item{depth}{optional, integer determining current depth level} +\item{depth}{optional integer determining current depth level} } \value{ Depth level for given module. diff --git a/man/report_card_template.Rd b/man/report_card_template.Rd index 42a2750800..ac14a9e257 100644 --- a/man/report_card_template.Rd +++ b/man/report_card_template.Rd @@ -17,7 +17,7 @@ report_card_template( \item{label}{(\code{character(1)}) label provided by the user when adding the card} -\item{description}{(\code{character(1)}) optional additional description} +\item{description}{(\code{character(1)}) optional, additional description} \item{with_filter}{(\code{logical(1)}) flag indicating to add filter state} diff --git a/man/show_rcode_modal.Rd b/man/show_rcode_modal.Rd index 66874b9690..b2a407f9a2 100644 --- a/man/show_rcode_modal.Rd +++ b/man/show_rcode_modal.Rd @@ -13,8 +13,8 @@ Title of the modal, displayed in the first comment of the \code{R} code.} \item{rcode}{(\code{character}) vector with \code{R} code to show inside the modal.} -\item{session}{(\code{ShinySession} optional) -\code{shiny} session object, if missing then \code{\link[shiny:domains]{shiny::getDefaultReactiveDomain()}} is used.} +\item{session}{(\code{ShinySession}) optional +\code{shiny} session object, defaults to \code{\link[shiny:domains]{shiny::getDefaultReactiveDomain()}}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} diff --git a/man/teal_slices.Rd b/man/teal_slices.Rd index bf84b842e2..834ba37617 100644 --- a/man/teal_slices.Rd +++ b/man/teal_slices.Rd @@ -44,7 +44,7 @@ Please make sure that adding new filters doesn't fail on target platform before \item{allow_add}{(\code{logical(1)}) logical flag specifying whether the user will be able to add new filters} -\item{module_specific}{optional (\code{logical(1)}) +\item{module_specific}{(\code{logical(1)}) optional, \itemize{ \item \code{FALSE} (default) when one filter panel applied to all modules. All filters will be shared by all modules. From fcc3a5c60338b06cc4638f069023b9a9d00b25c1 Mon Sep 17 00:00:00 2001 From: kartikeyakirar Date: Fri, 15 Mar 2024 09:51:21 +0000 Subject: [PATCH 02/35] [skip actions] Bump version to 0.15.2.9004 --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 729023d073..b575a039ea 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9003 -Date: 2024-03-08 +Version: 0.15.2.9004 +Date: 2024-03-15 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), diff --git a/NEWS.md b/NEWS.md index 2e6fb826dd..1f5f5d51c3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9003 +# teal 0.15.2.9004 # teal 0.15.2 From d612a47e961b70e1abcc03d9597ea56efcc007ec Mon Sep 17 00:00:00 2001 From: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Date: Mon, 18 Mar 2024 17:35:41 +0530 Subject: [PATCH 03/35] Introduce shinytest2 (#1127) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Part of https://github.com/insightsengineering/coredev-tasks/issues/503 --------- Signed-off-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: Dawid Kałędkowski <6959016+gogonzo@users.noreply.github.com> Co-authored-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Co-authored-by: cicdguy <26552821+cicdguy@users.noreply.github.com> Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: m7pr Co-authored-by: m7pr Co-authored-by: vedhav Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> --- DESCRIPTION | 5 +- R/TealAppDriver.R | 408 +++++++++++++++ R/modules.R | 4 +- R/utils.R | 13 + man/TealAppDriver.Rd | 481 ++++++++++++++++++ man/get_unique_labels.Rd | 18 + tests/testthat/helper-shinytest2.R | 43 ++ tests/testthat/test-shinytest2-filter_panel.R | 111 ++++ tests/testthat/test-shinytest2-init.R | 48 ++ tests/testthat/test-shinytest2-modules.R | 117 +++++ tests/testthat/test-shinytest2-reporter.R | 85 ++++ tests/testthat/test-shinytest2-teal_slices.R | 101 ++++ tests/testthat/test-shinytest2-utils.R | 31 ++ 13 files changed, 1462 insertions(+), 3 deletions(-) create mode 100644 R/TealAppDriver.R create mode 100644 man/TealAppDriver.Rd create mode 100644 man/get_unique_labels.Rd create mode 100644 tests/testthat/helper-shinytest2.R create mode 100644 tests/testthat/test-shinytest2-filter_panel.R create mode 100644 tests/testthat/test-shinytest2-init.R create mode 100644 tests/testthat/test-shinytest2-modules.R create mode 100644 tests/testthat/test-shinytest2-reporter.R create mode 100644 tests/testthat/test-shinytest2-teal_slices.R create mode 100644 tests/testthat/test-shinytest2-utils.R 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() +}) From 2227eaba4f85a7e75a9267891d501ddb148baee1 Mon Sep 17 00:00:00 2001 From: vedhav Date: Mon, 18 Mar 2024 12:06:40 +0000 Subject: [PATCH 04/35] [skip actions] Bump version to 0.15.2.9005 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ba74cc30b0..2740d3f1e5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9004 +Version: 0.15.2.9005 Date: 2024-03-18 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 1f5f5d51c3..61e2caacbd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9004 +# teal 0.15.2.9005 # teal 0.15.2 From 55bdd0079617b1a90c8f5b002e6514bc9b6d9391 Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Mon, 18 Mar 2024 18:26:32 +0100 Subject: [PATCH 05/35] 503 `$get_html_rvest` method for `TealAppDriver` (#1158) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit So instead of `app$get_html(selector) %>% rvest::read_html()` we can shortly write `app$read_html(selector)`. --------- Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: vedhav Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/TealAppDriver.R | 8 ++++++++ man/TealAppDriver.Rd | 23 ++++++++++++++++++++++- tests/testthat/test-shinytest2-init.R | 3 +-- tests/testthat/test-shinytest2-modules.R | 3 +-- tests/testthat/test-shinytest2-reporter.R | 6 ++---- tests/testthat/test-shinytest2-utils.R | 3 +-- 6 files changed, 35 insertions(+), 11 deletions(-) diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R index fa30051e4c..2f46b66889 100644 --- a/R/TealAppDriver.R +++ b/R/TealAppDriver.R @@ -354,6 +354,14 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. invisible(self) }, #' @description + #' Wrapper around `get_html` that passes the output directly to `rvest::read_html`. + #' + #' @param selector `(character(1))` passed to `get_html`. + #' + #' @return An XML document. + get_html_rvest = function(selector) { + rvest::read_html(self$get_html(selector)) + }, #' Wrapper around `get_url()` method that opens the app in the browser. #' #' @return Nothing. Opens the underlying teal app in the browser. diff --git a/man/TealAppDriver.Rd b/man/TealAppDriver.Rd index 46a38b097f..17c1c63059 100644 --- a/man/TealAppDriver.Rd +++ b/man/TealAppDriver.Rd @@ -38,6 +38,7 @@ driving a teal application for performing interactions for \code{shinytest2} tes \item \href{#method-TealAppDriver-add_filter_var}{\code{TealAppDriver$add_filter_var()}} \item \href{#method-TealAppDriver-remove_filter_var}{\code{TealAppDriver$remove_filter_var()}} \item \href{#method-TealAppDriver-set_active_filter_selection}{\code{TealAppDriver$set_active_filter_selection()}} +\item \href{#method-TealAppDriver-get_html_rvest}{\code{TealAppDriver$get_html_rvest()}} \item \href{#method-TealAppDriver-open_url}{\code{TealAppDriver$open_url()}} \item \href{#method-TealAppDriver-clone}{\code{TealAppDriver$clone()}} } @@ -449,10 +450,30 @@ The \code{TealAppDriver} object invisibly. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-get_html_rvest}{}}} +\subsection{Method \code{get_html_rvest()}}{ +Wrapper around \code{get_html} that passes the output directly to \code{rvest::read_html}. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$get_html_rvest(selector)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{selector}}{\code{(character(1))} passed to \code{get_html}.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +An XML document. +Wrapper around \code{get_url()} method that opens the app in the browser. +} +} +\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{
}} } diff --git a/tests/testthat/test-shinytest2-init.R b/tests/testthat/test-shinytest2-init.R index 8141e1df0b..c2881249a8 100644 --- a/tests/testthat/test-shinytest2-init.R +++ b/tests/testthat/test-shinytest2-init.R @@ -30,8 +30,7 @@ testthat::test_that("e2e: init creates UI containing specified title, favicon, h app_title ) testthat::expect_equal( - app$get_html("head > link[rel='icon']") %>% - rvest::read_html() %>% + app$get_html_rvest("head > link[rel='icon']") %>% rvest::html_elements("link") %>% rvest::html_attr("href"), app_favicon diff --git a/tests/testthat/test-shinytest2-modules.R b/tests/testthat/test-shinytest2-modules.R index 5c5233b226..d377b5564d 100644 --- a/tests/testthat/test-shinytest2-modules.R +++ b/tests/testthat/test-shinytest2-modules.R @@ -78,8 +78,7 @@ testthat::test_that("e2e: filter panel is not displayed when datanames is NULL", app$wait_for_idle(timeout = default_idle_timeout) testthat::expect_identical( - app$get_html(".teal_secondary_col") %>% - rvest::read_html() %>% + app$get_html_rvest(".teal_secondary_col") %>% rvest::html_element("div") %>% rvest::html_attr("style"), "display: none;" diff --git a/tests/testthat/test-shinytest2-reporter.R b/tests/testthat/test-shinytest2-reporter.R index af5305ba4c..ddb3617713 100644 --- a/tests/testthat/test-shinytest2-reporter.R +++ b/tests/testthat/test-shinytest2-reporter.R @@ -4,8 +4,7 @@ testthat::test_that("e2e: reporter tab is created when a module has reporter", { modules = report_module(label = "Module with Reporter") ) - teal_tabs <- app$get_html(selector = "#teal-main_ui-root-active_tab") %>% - rvest::read_html() %>% + teal_tabs <- app$get_html_rvest(selector = "#teal-main_ui-root-active_tab") %>% rvest::html_elements("a") tab_names <- setNames( rvest::html_attr(teal_tabs, "data-value"), @@ -24,8 +23,7 @@ testthat::test_that("e2e: reporter tab is not created when a module has no repor 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() %>% + teal_tabs <- app$get_html_rvest(selector = "#teal-main_ui-root-active_tab") %>% rvest::html_elements("a") tab_names <- setNames( rvest::html_attr(teal_tabs, "data-value"), diff --git a/tests/testthat/test-shinytest2-utils.R b/tests/testthat/test-shinytest2-utils.R index f783360de6..99ef2a0bf9 100644 --- a/tests/testthat/test-shinytest2-utils.R +++ b/tests/testthat/test-shinytest2-utils.R @@ -5,8 +5,7 @@ testthat::test_that("e2e: show/hide hamburger works as expected", { ) get_class_attributes <- function(app, selector) { - element <- app$get_html(selector = selector) %>% - rvest::read_html() %>% + element <- app$get_html_rvest(selector = selector) %>% rvest::html_elements(selector) list( class = rvest::html_attr(element, "class"), From c41c724ca7a25fdf9c2f7659e03d8c0c02b5491a Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 18 Mar 2024 17:27:36 +0000 Subject: [PATCH 06/35] [skip actions] Bump version to 0.15.2.9006 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2740d3f1e5..0cd77b5394 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9005 +Version: 0.15.2.9006 Date: 2024-03-18 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 61e2caacbd..52fe676bea 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9005 +# teal 0.15.2.9006 # teal 0.15.2 From 1890e0594494a2a25c26ceea1cb706d195b730f2 Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Tue, 19 Mar 2024 10:50:10 +0100 Subject: [PATCH 07/35] 503 shinytest2 for session info link in bottom of the page (#1145) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Part of https://github.com/insightsengineering/coredev-tasks/issues/503 --------- Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- tests/testthat/test-shinytest2-init.R | 56 +++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/tests/testthat/test-shinytest2-init.R b/tests/testthat/test-shinytest2-init.R index c2881249a8..39707c9847 100644 --- a/tests/testthat/test-shinytest2-init.R +++ b/tests/testthat/test-shinytest2-init.R @@ -8,6 +8,62 @@ testthat::test_that("e2e: teal app initializes with no errors", { app$stop() }) +testthat::test_that("e2e: teal app initializes with sessionInfo modal", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module") + ) + app$wait_for_idle(timeout = default_idle_timeout) + + # Check if button exists. + button_selector <- "#teal-sessionInfo-button" + testthat::expect_equal( + app$get_text(button_selector), + "Session Info" + ) + + app$click(selector = button_selector) + app$wait_for_idle(timeout = default_idle_timeout) + + # Check header and title content. + testthat::expect_equal( + app$get_text("#shiny-modal > div > div > div.modal-header > h4"), + "SessionInfo" + ) + + # There are two Copy buttons with similar id and the same label. + testthat::expect_setequal( + testthat::expect_length( + app$get_text( + "#shiny-modal [id^='teal-sessionInfo-copy_button']" + ), + 2 + ), + "Copy to Clipboard" + ) + # There are two Dismiss buttons with similar id and the same label. + testthat::expect_setequal( + testthat::expect_length( + app$get_text("#shiny-modal button[data-dismiss]"), + 2 + ), + "Dismiss" + ) + + # Check session info output. + session_info <- app$get_text("#teal-sessionInfo-verbatim_content") + + testthat::expect_match(session_info, "R version", fixed = TRUE) + testthat::expect_match(session_info, "attached base packages:", fixed = TRUE) + testthat::expect_match(session_info, "loaded via a namespace (and not attached):", fixed = TRUE) + + testthat::expect_match(session_info, "shiny", fixed = TRUE) + testthat::expect_match(session_info, "teal.slice", fixed = TRUE) + testthat::expect_match(session_info, "teal.reporter", fixed = TRUE) + + 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" From d13a73ea2f1c6fd4abca6106a79b4b0b096139cd Mon Sep 17 00:00:00 2001 From: m7pr Date: Tue, 19 Mar 2024 09:51:09 +0000 Subject: [PATCH 08/35] [skip actions] Bump version to 0.15.2.9007 --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0cd77b5394..9b87ce8d94 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9006 -Date: 2024-03-18 +Version: 0.15.2.9007 +Date: 2024-03-19 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), diff --git a/NEWS.md b/NEWS.md index 52fe676bea..8617f01c4e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9006 +# teal 0.15.2.9007 # teal 0.15.2 From ec8fbfc3582d906871a626eb4305960a87c82579 Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Tue, 19 Mar 2024 15:45:00 +0100 Subject: [PATCH 09/35] 503 shinytest2 for `Show R code` modal (#1146) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Part of https://github.com/insightsengineering/coredev-tasks/issues/503 --------- Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> --- tests/testthat/test-shinytest2-show-rcode.R | 54 +++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 tests/testthat/test-shinytest2-show-rcode.R diff --git a/tests/testthat/test-shinytest2-show-rcode.R b/tests/testthat/test-shinytest2-show-rcode.R new file mode 100644 index 0000000000..5c1b031f56 --- /dev/null +++ b/tests/testthat/test-shinytest2-show-rcode.R @@ -0,0 +1,54 @@ +testthat::test_that("e2e: teal app initializes with Show R Code modal", { + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module") + ) + app$wait_for_idle(timeout = default_idle_timeout) + + # Check if button exists. + button_selector <- app$active_module_element("rcode-button") + testthat::expect_equal( + app$get_text(button_selector), + "Show R code" + ) + + app$click(selector = button_selector) + app$wait_for_idle(timeout = default_idle_timeout) + + # Check header and title content. + testthat::expect_equal( + app$get_text("#shiny-modal div.modal-header > h4"), + "Example Code" + ) + + # There are two Dismiss buttons with similar id and the same label. + testthat::expect_setequal( + testthat::expect_length( + app$get_text("#shiny-modal button[data-dismiss]"), + 2 + ), + "Dismiss" + ) + # Check for Copy buttons. + testthat::expect_equal( + app$active_module_element("rcode-copy_button1") %>% + app$get_text(), + "Copy to Clipboard" + ) + testthat::expect_equal( + app$active_module_element("rcode-copy_button2") %>% + app$get_text(), + "Copy to Clipboard" + ) + + # Check R code output. + r_code <- + app$active_module_element("rcode-verbatim_content") %>% + app$get_text() + + testthat::expect_match(r_code, "# Add any code to install/load your NEST environment here", fixed = TRUE) + testthat::expect_match(r_code, "library(teal.code)", fixed = TRUE) + testthat::expect_match(r_code, "stopifnot(rlang::hash(", fixed = TRUE) + + app$stop() +}) From ba4003371853a1abfe4b359532dcc90ba95bac3b Mon Sep 17 00:00:00 2001 From: m7pr Date: Tue, 19 Mar 2024 14:46:05 +0000 Subject: [PATCH 10/35] [skip actions] Bump version to 0.15.2.9008 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9b87ce8d94..4bc7c44982 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9007 +Version: 0.15.2.9008 Date: 2024-03-19 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 8617f01c4e..411f9877a3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9007 +# teal 0.15.2.9008 # teal 0.15.2 From 6779cee732d8bbe17181cc3a011b5feff97b8c69 Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Wed, 20 Mar 2024 10:37:26 +0100 Subject: [PATCH 11/35] `$active_module_element_text` method `TealAppDriver` (#1167) Followu-up after https://github.com/insightsengineering/teal/pull/1156 --- R/TealAppDriver.R | 10 ++++++++++ man/TealAppDriver.Rd | 21 +++++++++++++++++++++ 2 files changed, 31 insertions(+) diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R index 2f46b66889..19da883872 100644 --- a/R/TealAppDriver.R +++ b/R/TealAppDriver.R @@ -147,6 +147,16 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. sprintf("#%s-%s", self$active_module_ns(), element) }, #' @description + #' Get the text of the active shiny name space bound with a custom `element` name. + #' + #' @param element `character(1)` the text of the custom element name. + #' + #' @return (`string`) The text of the active shiny name space of the component bound with the input `element`. + active_module_element_text = function(element) { + checkmate::assert_string(element) + self$get_text(self$active_module_element(element)) + }, + #' @description #' Get the active shiny name space for interacting with the filter panel. #' #' @return (`string`) The active shiny name space of the component. diff --git a/man/TealAppDriver.Rd b/man/TealAppDriver.Rd index 17c1c63059..eef87a8e12 100644 --- a/man/TealAppDriver.Rd +++ b/man/TealAppDriver.Rd @@ -28,6 +28,7 @@ driving a teal application for performing interactions for \code{shinytest2} tes \item \href{#method-TealAppDriver-active_ns}{\code{TealAppDriver$active_ns()}} \item \href{#method-TealAppDriver-active_module_ns}{\code{TealAppDriver$active_module_ns()}} \item \href{#method-TealAppDriver-active_module_element}{\code{TealAppDriver$active_module_element()}} +\item \href{#method-TealAppDriver-active_module_element_text}{\code{TealAppDriver$active_module_element_text()}} \item \href{#method-TealAppDriver-active_filters_ns}{\code{TealAppDriver$active_filters_ns()}} \item \href{#method-TealAppDriver-get_active_module_input}{\code{TealAppDriver$get_active_module_input()}} \item \href{#method-TealAppDriver-get_active_module_output}{\code{TealAppDriver$get_active_module_output()}} @@ -239,6 +240,26 @@ Get the active shiny name space bound with a custom \code{element} name. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-active_module_element_text}{}}} +\subsection{Method \code{active_module_element_text()}}{ +Get the text of the active shiny name space bound with a custom \code{element} name. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$active_module_element_text(element)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{element}}{\code{character(1)} the text of the custom element name.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +(\code{string}) The text of the active shiny name space of the component bound with the input \code{element}. +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TealAppDriver-active_filters_ns}{}}} \subsection{Method \code{active_filters_ns()}}{ From 3c8bbda9188f07b483e572dc928094648eb5d7df Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 20 Mar 2024 09:38:18 +0000 Subject: [PATCH 12/35] [skip actions] Bump version to 0.15.2.9009 --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4bc7c44982..f3a1a77e1c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9008 -Date: 2024-03-19 +Version: 0.15.2.9009 +Date: 2024-03-20 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), diff --git a/NEWS.md b/NEWS.md index 411f9877a3..b6e9ff6788 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9008 +# teal 0.15.2.9009 # teal 0.15.2 From 3a209f318b9cb0f33a7a89e7e8209215e9583cf2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 20 Mar 2024 10:48:50 +0100 Subject: [PATCH 13/35] 503 shinytest2 fixes bug with setting numeric range (#1152) # Pull Request Fixes #1151 #### Changes description - `shinyWidgets::numericRangeInput` uses a custom handler and seems to require a `js: Shiny.setInputValue` call - ~Change of explicit arguments in `{s,g}et_active_filter_selection` to `type` to reflect this logic and allow for further extensions.~ - Removed `is_numeric` argument in favor of auto-detection of slice type (categorical / numerical range) - from `{s,g}et_active_filter_selection` --------- Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> --- R/TealAppDriver.R | 94 ++++++++++++++------ man/TealAppDriver.Rd | 17 +--- tests/testthat/test-shinytest2-teal_slices.R | 14 +-- 3 files changed, 73 insertions(+), 52 deletions(-) diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R index 19da883872..9547aaa46e 100644 --- a/R/TealAppDriver.R +++ b/R/TealAppDriver.R @@ -258,24 +258,28 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. #' #' @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) { + get_active_filter_selection = function(dataset_name, var_name) { 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 - ) + input_id_prefix <- sprintf( + "%s-active-%s-filter-%s_%s-inputs", + self$active_filters_ns(), + dataset_name, + dataset_name, + var_name ) + + # Find the type of filter (categorical or range) + supported_suffix <- c("selection", "selection_manual") + for (suffix in supported_suffix) { + if (!is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix)))) { + return(self$get_value(input = sprintf("%s-%s", input_id_prefix, suffix))) + } + } + + NULL # If there are not any supported filters }, #' @description #' Add a new variable from the dataset to be filtered. @@ -340,27 +344,63 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. #' @param dataset_name (character) The name of the dataset to set the filter value for. #' @param var_name (character) The name of the variable to set the filter value for. #' @param input The value to set the filter to. - #' @param is_numeric (logical) If the variable is numeric or not. + #' @param type (character) The type of the filter to get the value from. Default is `categorical`. #' #' @return The `TealAppDriver` object invisibly. - set_active_filter_selection = function(dataset_name, var_name, input, is_numeric = FALSE) { + set_active_filter_selection = function(dataset_name, var_name, input) { checkmate::check_string(dataset_name) checkmate::check_string(var_name) checkmate::check_string(input) - checkmate::check_flag(is_numeric) - selection_suffix <- ifelse(is_numeric, "selection_manual", "selection") - self$set_input( - sprintf( - "%s-active-%s-filter-%s_%s-inputs-%s", - self$active_filters_ns(), - dataset_name, - dataset_name, - var_name, - selection_suffix - ), - input + input_id_prefix <- sprintf( + "%s-active-%s-filter-%s_%s-inputs", + self$active_filters_ns(), + dataset_name, + dataset_name, + var_name + ) + + # Find the type of filter (based on filter panel) + supported_suffix <- c("selection", "selection_manual") + slices_suffix <- supported_suffix[ + match( + TRUE, + vapply( + supported_suffix, + function(suffix) { + !is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix))) + }, + logical(1) + ) + ) + ] + + # Generate correct namespace + slices_input_id <- sprintf( + "%s-active-%s-filter-%s_%s-inputs-%s", + self$active_filters_ns(), + dataset_name, + dataset_name, + var_name, + slices_suffix ) + + if (identical(slices_suffix, "selection_manual")) { + checkmate::assert_numeric(input, len = 2) + self$run_js( + sprintf( + "Shiny.setInputValue('%s:sw.numericRange', [%f, %f], {priority: 'event'})", + slices_input_id, + input[[1]], + input[[2]] + ) + ) + } else if (identical(slices_suffix, "selection")) { + self$set_input(slices_input_id, input) + } else { + stop("Filter selection set not supported for this slice.") + } + invisible(self) }, #' @description diff --git a/man/TealAppDriver.Rd b/man/TealAppDriver.Rd index eef87a8e12..9b2afd7a0e 100644 --- a/man/TealAppDriver.Rd +++ b/man/TealAppDriver.Rd @@ -371,11 +371,7 @@ If \code{NULL}, the filter variables for all the datasets will be returned in a \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{
}} +\if{html}{\out{
}}\preformatted{TealAppDriver$get_active_filter_selection(dataset_name, var_name)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -384,8 +380,6 @@ Get the active filter values from the active filter selection of dataset from th \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{}} } @@ -445,12 +439,7 @@ The \code{TealAppDriver} object invisibly. \subsection{Method \code{set_active_filter_selection()}}{ Set the active filter values for a variable of a dataset in the active filter variable panel. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealAppDriver$set_active_filter_selection( - dataset_name, - var_name, - input, - is_numeric = FALSE -)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{TealAppDriver$set_active_filter_selection(dataset_name, var_name, input)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -462,7 +451,7 @@ Set the active filter values for a variable of a dataset in the active filter va \item{\code{input}}{The value to set the filter to.} -\item{\code{is_numeric}}{(logical) If the variable is numeric or not.} +\item{\code{type}}{(character) The type of the filter to get the value from. Default is \code{categorical}.} } \if{html}{\out{}} } diff --git a/tests/testthat/test-shinytest2-teal_slices.R b/tests/testthat/test-shinytest2-teal_slices.R index c065d563b6..67471706bf 100644 --- a/tests/testthat/test-shinytest2-teal_slices.R +++ b/tests/testthat/test-shinytest2-teal_slices.R @@ -26,7 +26,7 @@ testthat::test_that("e2e: teal_slices filters are initialized when global filter c("4", "6") ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "drat", is_numeric = TRUE), + app$get_active_filter_selection("mtcars", "drat"), c(3, 4) ) testthat::expect_identical( @@ -67,7 +67,7 @@ testthat::test_that("e2e: teal_slices filters are initialized when module specif 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", "drat")) testthat::expect_null(app$get_active_filter_selection("mtcars", "gear")) app$navigate_teal_tab("Module_2") @@ -80,7 +80,7 @@ testthat::test_that("e2e: teal_slices filters are initialized when module specif c("setosa", "versicolor", "virginica") ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "drat", is_numeric = TRUE), + app$get_active_filter_selection("mtcars", "drat"), c(3, 4) ) testthat::expect_identical( @@ -89,13 +89,5 @@ testthat::test_that("e2e: teal_slices filters are initialized when module specif ) 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() }) From 04b4e200829c485fcbe2eb588825bb9417e779ee Mon Sep 17 00:00:00 2001 From: averissimo Date: Wed, 20 Mar 2024 09:49:46 +0000 Subject: [PATCH 14/35] [skip actions] Bump version to 0.15.2.9010 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f3a1a77e1c..df376b4fc3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9009 +Version: 0.15.2.9010 Date: 2024-03-20 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index b6e9ff6788..155e8b6985 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9009 +# teal 0.15.2.9010 # teal 0.15.2 From c5ea0dd192cc26a28ee2f90750ff4ea89c07c17d Mon Sep 17 00:00:00 2001 From: Pawel Rucki <12943682+pawelru@users.noreply.github.com> Date: Wed, 20 Mar 2024 15:22:40 +0100 Subject: [PATCH 15/35] register teal.logger handlers; replace few loggers with base (#1081) close https://github.com/insightsengineering/coredev-tasks/issues/502 test with https://github.com/insightsengineering/teal.logger/pull/73 I will keep it as a draft for the time being because this requires (currently) development version of `teal.logger`. This has impact on our release plan as `teal.logger` would have to be released first --------- Signed-off-by: Pawel Rucki <12943682+pawelru@users.noreply.github.com> --- DESCRIPTION | 2 +- R/landing_popup_module.R | 2 +- R/modules.R | 1 - R/reporter_previewer_module.R | 2 +- R/zzz.R | 1 + tests/testthat/setup-logger.R | 2 +- 6 files changed, 5 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index df376b4fc3..10da486f98 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,7 +50,7 @@ Imports: shinyjs, stats, teal.code (>= 0.5.0), - teal.logger (>= 0.1.1), + teal.logger (>= 0.1.3.9013), teal.reporter (>= 0.2.0), teal.widgets (>= 0.4.0), utils diff --git a/R/landing_popup_module.R b/R/landing_popup_module.R index 0637d153af..752cb0576c 100644 --- a/R/landing_popup_module.R +++ b/R/landing_popup_module.R @@ -66,7 +66,7 @@ landing_popup_module <- function(label = "Landing Popup", ) checkmate::assert_multi_class(buttons, classes = c("shiny.tag", "shiny.tag.list")) - logger::log_info("Initializing landing_popup_module") + message("Initializing landing_popup_module") module <- module( label = label, diff --git a/R/modules.R b/R/modules.R index 933744cb51..751d34fb74 100644 --- a/R/modules.R +++ b/R/modules.R @@ -206,7 +206,6 @@ module <- function(label = "module", datanames <- filters msg <- "The `filters` argument is deprecated and will be removed in the next release. Please use `datanames` instead." - logger::log_warn(msg) warning(msg) } diff --git a/R/reporter_previewer_module.R b/R/reporter_previewer_module.R index 2ee7560684..eeba694a7f 100644 --- a/R/reporter_previewer_module.R +++ b/R/reporter_previewer_module.R @@ -24,7 +24,7 @@ reporter_previewer_module <- function(label = "Report previewer", server_args = checkmate::assert_list(server_args, names = "named") checkmate::assert_true(all(names(server_args) %in% names(formals(teal.reporter::reporter_previewer_srv)))) - logger::log_info("Initializing reporter_previewer_module") + message("Initializing reporter_previewer_module") srv <- function(id, reporter, ...) { teal.reporter::reporter_previewer_srv(id, reporter, ...) diff --git a/R/zzz.R b/R/zzz.R index cacaf7775b..817f9bae4b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -10,6 +10,7 @@ # Set up the teal logger instance teal.logger::register_logger("teal") + teal.logger::register_handlers("teal") invisible() } diff --git a/tests/testthat/setup-logger.R b/tests/testthat/setup-logger.R index 1a7b3e5c5f..aeb7fb70bb 100644 --- a/tests/testthat/setup-logger.R +++ b/tests/testthat/setup-logger.R @@ -1 +1 @@ -logger::log_appender(function(...) {}, namespace = "teal") +logger::log_appender(function(...) NULL, namespace = "teal") From 460619a55de78fc9ad12046dbac74b482181beb9 Mon Sep 17 00:00:00 2001 From: pawelru Date: Wed, 20 Mar 2024 14:23:44 +0000 Subject: [PATCH 16/35] [skip actions] Bump version to 0.15.2.9011 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 10da486f98..f40efd05f8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9010 +Version: 0.15.2.9011 Date: 2024-03-20 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 155e8b6985..49dd50b670 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9010 +# teal 0.15.2.9011 # teal 0.15.2 From 443319f59f76ed51ba84fa77a3ac665f391b72ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 20 Mar 2024 16:21:25 +0100 Subject: [PATCH 17/35] 503 shinytest2 for `teal_data_module` (#1148) # Pull Request Part of https://github.com/insightsengineering/coredev-tasks/issues/503 #### Changes description - Adds tests for `teal_data_module` 1. Loads `iris` and `mtcars` 2. Fails to load `teal` app if required input is not available 3. Integrates input on `teal_data()` object by creating a new dynamic column --------- Signed-off-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Co-authored-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> --- .../test-shinytest2-teal_data_module.R | 125 ++++++++++++++++++ 1 file changed, 125 insertions(+) create mode 100644 tests/testthat/test-shinytest2-teal_data_module.R diff --git a/tests/testthat/test-shinytest2-teal_data_module.R b/tests/testthat/test-shinytest2-teal_data_module.R new file mode 100644 index 0000000000..7773e634a4 --- /dev/null +++ b/tests/testthat/test-shinytest2-teal_data_module.R @@ -0,0 +1,125 @@ +testthat::test_that("e2e: teal_data_module will have a delayed load of datasets", { + tdm <- teal_data_module( + ui = function(id) { + ns <- shiny::NS(id) + shiny::actionButton(ns("submit"), label = "Load data") + }, + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::eventReactive(input$submit, { + data <- within( + teal_data(), + { + dataset1 <- iris + dataset2 <- mtcars + } + ) + datanames(data) <- c("dataset1", "dataset2") + + data + }) + }) + } + ) + + app <- TealAppDriver$new( + data = tdm, + modules = example_module(label = "Example Module"), + timeout = default_idle_timeout + ) + + app$click("teal_data_module-submit") + app$wait_for_idle() + testthat::expect_setequal(app$get_active_filter_vars(), c("dataset1", "dataset2")) + + app$stop() +}) + +testthat::test_that("e2e: teal_data_module shows validation errors", { + tdm <- teal_data_module( + ui = function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::textInput(ns("new_column"), label = "New column name"), + shiny::actionButton(ns("submit"), label = "Load data") + ) + }, + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::eventReactive(input$submit, { + shiny::validate( + shiny::need(input$new_column, "Please provide a new column name") + ) + data <- within(teal_data(), dataset1 <- iris) + datanames(data) <- c("dataset1") + data + }) + }) + } + ) + + app <- TealAppDriver$new( + data = tdm, + modules = example_module(label = "Example Module"), + timeout = default_idle_timeout + ) + app$wait_for_idle() + + app$click("teal_data_module-submit") + + app$expect_validation_error() + + app$stop() +}) + +testthat::test_that("e2e: teal_data_module inputs change teal_data object that is passed to teal main UI", { + tdm <- teal_data_module( + ui = function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::textInput(ns("new_column"), label = "New column name"), + shiny::actionButton(ns("submit"), label = "Load data") + ) + }, + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::eventReactive(input$submit, { + shiny::validate( + shiny::need(input$new_column, "Please provide a new column name") + ) + data <- within( + teal_data(), + { + dataset1 <- iris + dataset1[[new_column]] <- sprintf("%s new", dataset1$Species) + }, + new_column = input$new_column + ) + datanames(data) <- c("dataset1") + + data + }) + }) + } + ) + + app <- TealAppDriver$new( + data = tdm, + modules = example_module(label = "Example Module"), + timeout = default_idle_timeout + ) + app$wait_for_idle() + app$set_input("teal_data_module-new_column", "A_New_Column") + app$click("teal_data_module-submit") + + # This may fail if teal_data_module does not perform the transformation + testthat::expect_no_error(app$add_filter_var("dataset1", "A_New_Column")) + + app$wait_for_idle() + testthat::expect_setequal( + app$get_active_filter_selection("dataset1", "A_New_Column"), + unique(sprintf("%s new", iris$Species)) + ) + + app$stop() +}) From fb2e7427c29fb3e3d3dabcefbe94f15fb0d0d327 Mon Sep 17 00:00:00 2001 From: averissimo Date: Wed, 20 Mar 2024 15:22:39 +0000 Subject: [PATCH 18/35] [skip actions] Bump version to 0.15.2.9012 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f40efd05f8..1d375ceeb8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9011 +Version: 0.15.2.9012 Date: 2024-03-20 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 49dd50b670..2ea9baff45 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9011 +# teal 0.15.2.9012 # teal 0.15.2 From d1b99d5fa6ab96028ea1f0ac1e743be1497d03a3 Mon Sep 17 00:00:00 2001 From: Agota Bodoni <148207853+abodoni@users.noreply.github.com> Date: Thu, 21 Mar 2024 02:43:14 +0000 Subject: [PATCH 19/35] Update bootstrap-themes-in-teal.Rmd (#1170) Fixed one line by adding needed bracket Signed-off-by: Agota Bodoni <148207853+abodoni@users.noreply.github.com> --- vignettes/bootstrap-themes-in-teal.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/bootstrap-themes-in-teal.Rmd b/vignettes/bootstrap-themes-in-teal.Rmd index 8fe61a2bc9..e491821c53 100644 --- a/vignettes/bootstrap-themes-in-teal.Rmd +++ b/vignettes/bootstrap-themes-in-teal.Rmd @@ -44,7 +44,7 @@ Available Bootstrap versions could be checked with `bslib::versions()` and Boots ``` # bslib::versions() # bslib::bootswatch_themes(version = "5") -options("teal.bs_theme" = bslib::bs_theme(version = "5", bootswatch = "lux") +options("teal.bs_theme" = bslib::bs_theme(version = "5", bootswatch = "lux")) # or options("teal.bs_theme" = bslib::bs_theme_update(bslib::bs_theme(version = "5"), bootswatch = "lux")) ``` From 4ca17657ba7cfd2d1e77a3eb945eab97660d5099 Mon Sep 17 00:00:00 2001 From: gogonzo Date: Thu, 21 Mar 2024 02:44:14 +0000 Subject: [PATCH 20/35] [skip actions] Bump version to 0.15.2.9013 --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1d375ceeb8..8ed7c64853 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9012 -Date: 2024-03-20 +Version: 0.15.2.9013 +Date: 2024-03-21 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), diff --git a/NEWS.md b/NEWS.md index 2ea9baff45..b47684f8ab 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9012 +# teal 0.15.2.9013 # teal 0.15.2 From 2f22ed51d0919895b248739216266cf6d63abb44 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 21 Mar 2024 08:09:55 +0100 Subject: [PATCH 21/35] 503 Applying suggestions (#1161) # Pull Request Part of https://github.com/insightsengineering/coredev-tasks/issues/503 ### Changes description: - [x] Implement `TESTING_DEPTH - [x] Refactor `get_active_data_filters` to return active selection value - [x] Remove pipe operator on `TealAppDriver` --------- Signed-off-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Co-authored-by: vedhav Co-authored-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Co-authored-by: m7pr Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> --- R/TealAppDriver.R | 86 ++++++++++--------- man/TealAppDriver.Rd | 23 ----- tests/testthat/setup-testing_depth.R | 49 +++++++++++ tests/testthat/test-shinytest2-filter_panel.R | 3 + tests/testthat/test-shinytest2-init.R | 3 + tests/testthat/test-shinytest2-modules.R | 5 ++ tests/testthat/test-shinytest2-reporter.R | 3 + tests/testthat/test-shinytest2-show-rcode.R | 1 + .../test-shinytest2-teal_data_module.R | 3 + tests/testthat/test-shinytest2-teal_slices.R | 57 ++++++++---- tests/testthat/test-shinytest2-utils.R | 1 + 11 files changed, 153 insertions(+), 81 deletions(-) create mode 100644 tests/testthat/setup-testing_depth.R diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R index 9547aaa46e..986a2073a8 100644 --- a/R/TealAppDriver.R +++ b/R/TealAppDriver.R @@ -208,14 +208,16 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. #' @description #' Get the active datasets that can be accessed via the filter panel of the current active teal module. get_active_filter_vars = function() { - displayed_datasets_index <- self$get_js( - sprintf( - "Array.from( - document.querySelectorAll(\"#%s-active-filter_active_vars_contents > span\") - ).map((el) => window.getComputedStyle(el).display != \"none\");", - self$active_filters_ns() + displayed_datasets_index <- unlist( + self$get_js( + sprintf( + "Array.from( + document.querySelectorAll(\"#%s-active-filter_active_vars_contents > span\") + ).map((el) => window.getComputedStyle(el).display != \"none\");", + self$active_filters_ns() + ) ) - ) |> unlist() + ) available_datasets <- self$get_text( sprintf( @@ -237,49 +239,25 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. active_filters <- lapply( datasets, function(x) { - self$get_text( + var_names <- self$get_text( sprintf( "#%s-active-%s-filters .filter-card-varname", self$active_filters_ns(), x ) - ) |> + ) %>% gsub(pattern = "\\s", replacement = "") + structure( + lapply(var_names, private$get_active_filter_selection, dataset_name = x), + names = var_names + ) } ) names(active_filters) <- datasets - if (!is.null(dataset_name)) { - active_filters <- active_filters[[dataset_name]] - } - 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. - #' - #' @return The value of the active filter selection. - get_active_filter_selection = function(dataset_name, var_name) { - checkmate::check_string(dataset_name) - checkmate::check_string(var_name) - input_id_prefix <- sprintf( - "%s-active-%s-filter-%s_%s-inputs", - self$active_filters_ns(), - dataset_name, - dataset_name, - var_name - ) - - # Find the type of filter (categorical or range) - supported_suffix <- c("selection", "selection_manual") - for (suffix in supported_suffix) { - if (!is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix)))) { - return(self$get_value(input = sprintf("%s-%s", input_id_prefix, suffix))) - } + if (is.null(dataset_name)) { + return(active_filters) } - - NULL # If there are not any supported filters + active_filters[[dataset_name]] }, #' @description #' Add a new variable from the dataset to be filtered. @@ -461,6 +439,34 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. } else { private$ns[[component]] <- sprintf("%s-module_%s", active_ns, component) } + }, + # @description + # Get the active filter values from the active filter selection of dataset from the filter panel. + # + # @param dataset_name (character) The name of the dataset to get the filter values from. + # @param var_name (character) The name of the variable to get the filter values from. + # + # @return The value of the active filter selection. + get_active_filter_selection = function(dataset_name, var_name) { + checkmate::check_string(dataset_name) + checkmate::check_string(var_name) + input_id_prefix <- sprintf( + "%s-active-%s-filter-%s_%s-inputs", + self$active_filters_ns(), + dataset_name, + dataset_name, + var_name + ) + + # Find the type of filter (categorical or range) + supported_suffix <- c("selection", "selection_manual") + for (suffix in supported_suffix) { + if (!is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix)))) { + return(self$get_value(input = sprintf("%s-%s", input_id_prefix, suffix))) + } + } + + NULL # If there are not any supported filters } ) ) diff --git a/man/TealAppDriver.Rd b/man/TealAppDriver.Rd index 9b2afd7a0e..355bc547d3 100644 --- a/man/TealAppDriver.Rd +++ b/man/TealAppDriver.Rd @@ -35,7 +35,6 @@ driving a teal application for performing interactions for \code{shinytest2} tes \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()}} @@ -366,28 +365,6 @@ If \code{NULL}, the filter variables for all the datasets will be returned in a } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealAppDriver-get_active_filter_selection}{}}} -\subsection{Method \code{get_active_filter_selection()}}{ -Get the active filter values from the active filter selection of dataset from the filter panel. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealAppDriver$get_active_filter_selection(dataset_name, var_name)}\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.} -} -\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()}}{ diff --git a/tests/testthat/setup-testing_depth.R b/tests/testthat/setup-testing_depth.R new file mode 100644 index 0000000000..3aa6cf3ec3 --- /dev/null +++ b/tests/testthat/setup-testing_depth.R @@ -0,0 +1,49 @@ +#' Returns testing depth set by session option or by environmental variable. +#' +#' @details Looks for the session option `TESTING_DEPTH` first. +#' If not set, takes the system environmental variable `TESTING_DEPTH`. +#' If neither is set, then returns 3 by default. +#' If the value of `TESTING_DEPTH` is not a numeric of length 1, then returns 3. +#' +#' @return `numeric(1)` the testing depth. +#' +get_testing_depth <- function() { + default_depth <- 3 + depth <- getOption("TESTING_DEPTH", Sys.getenv("TESTING_DEPTH", default_depth)) + depth <- tryCatch( + as.numeric(depth), + error = function(error) default_depth, + warning = function(warning) default_depth + ) + if (length(depth) != 1) depth <- default_depth + depth +} + +#' Skipping tests in the testthat pipeline under specific scope +#' @description This function should be used per each `testthat::test_that` call. +#' Each of the call should specify an appropriate depth value. +#' The depth value will set the appropriate scope so more/less time consuming tests could be recognized. +#' The environment variable `TESTING_DEPTH` is used for changing the scope of `testthat` pipeline. +#' `TESTING_DEPTH` interpretation for each possible value: +#' \itemize{ +#' \item{0}{no tests at all} +#' \item{1}{fast - small scope - executed on every commit} +#' \item{3}{medium - medium scope - daily integration pipeline} +#' \item{5}{slow - all tests - daily package tests} +#' } +#' @param depth `numeric` the depth of the testing evaluation, +#' has opposite interpretation to environment variable `TESTING_DEPTH`. +#' So e.g. `0` means run it always and `5` means a heavy test which should be run rarely. +#' If the `depth` argument is larger than `TESTING_DEPTH` then the test is skipped. +#' @importFrom testthat skip +#' @return `NULL` or invoke an error produced by `testthat::skip` +#' @note By default `TESTING_DEPTH` is equal to 3 if there is no environment variable for it. +#' By default `depth` argument lower or equal to 3 will not be skipped because by default `TESTING_DEPTH` +#' is equal to 3. To skip <= 3 depth tests then the environment variable has to be lower than 3 respectively. +skip_if_too_deep <- function(depth) { # nolintr + checkmate::assert_numeric(depth, len = 1, lower = 0, upper = 5) + testing_depth <- get_testing_depth() # by default 3 if there are no env variable + if (testing_depth < depth) { + testthat::skip(paste("testing depth", testing_depth, "is below current testing specification", depth)) + } +} diff --git a/tests/testthat/test-shinytest2-filter_panel.R b/tests/testthat/test-shinytest2-filter_panel.R index 5cc4ee2112..e2c07884df 100644 --- a/tests/testthat/test-shinytest2-filter_panel.R +++ b/tests/testthat/test-shinytest2-filter_panel.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: module content is updated when a data is filtered in filter panel", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -27,6 +28,7 @@ testthat::test_that("e2e: module content is updated when a data is filtered in f }) testthat::test_that("e2e: filtering a module-specific filter is refected in other shared module", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -69,6 +71,7 @@ testthat::test_that("e2e: filtering a module-specific filter is refected in othe }) testthat::test_that("e2e: filtering a module-specific filter is not refected in other unshared modules", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( diff --git a/tests/testthat/test-shinytest2-init.R b/tests/testthat/test-shinytest2-init.R index 39707c9847..c070d7b539 100644 --- a/tests/testthat/test-shinytest2-init.R +++ b/tests/testthat/test-shinytest2-init.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: teal app initializes with no errors", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = example_module(label = "Example Module") @@ -9,6 +10,7 @@ testthat::test_that("e2e: teal app initializes with no errors", { }) testthat::test_that("e2e: teal app initializes with sessionInfo modal", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = example_module(label = "Example Module") @@ -65,6 +67,7 @@ testthat::test_that("e2e: teal app initializes with sessionInfo modal", { }) testthat::test_that("e2e: init creates UI containing specified title, favicon, header and footer", { + skip_if_too_deep(5) app_title <- "Custom Teal App Title" app_favicon <- "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/teal.png" app_header <- "Custom Teal App Header" diff --git a/tests/testthat/test-shinytest2-modules.R b/tests/testthat/test-shinytest2-modules.R index d377b5564d..e547fdd397 100644 --- a/tests/testthat/test-shinytest2-modules.R +++ b/tests/testthat/test-shinytest2-modules.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: the module server logic is only triggered when the teal module becomes active", { + skip_if_too_deep(5) value_export_module <- function(label = "custom module") { module( label = label, @@ -37,6 +38,7 @@ testthat::test_that("e2e: the module server logic is only triggered when the tea testthat::test_that("e2e: filter panel only shows the data supplied using datanames", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -53,6 +55,7 @@ testthat::test_that("e2e: filter panel only shows the data supplied using datana }) testthat::test_that("e2e: filter panel shows all the datasets when datanames is all", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -69,6 +72,7 @@ testthat::test_that("e2e: filter panel shows all the datasets when datanames is }) testthat::test_that("e2e: filter panel is not displayed when datanames is NULL", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -88,6 +92,7 @@ testthat::test_that("e2e: filter panel is not displayed when datanames is NULL", }) testthat::test_that("e2e: all the nested teal modules are initiated as expected", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( diff --git a/tests/testthat/test-shinytest2-reporter.R b/tests/testthat/test-shinytest2-reporter.R index ddb3617713..46ba6f9bc9 100644 --- a/tests/testthat/test-shinytest2-reporter.R +++ b/tests/testthat/test-shinytest2-reporter.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: reporter tab is created when a module has reporter", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = report_module(label = "Module with Reporter") @@ -19,6 +20,7 @@ testthat::test_that("e2e: reporter tab is created when a module has reporter", { }) testthat::test_that("e2e: reporter tab is not created when a module has no reporter", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = example_module(label = "Example Module") @@ -39,6 +41,7 @@ testthat::test_that("e2e: reporter tab is not created when a module has no repor }) testthat::test_that("e2e: adding a report card in a module adds it in the report previewer tab", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = report_module(label = "Module with Reporter") diff --git a/tests/testthat/test-shinytest2-show-rcode.R b/tests/testthat/test-shinytest2-show-rcode.R index 5c1b031f56..09cc122080 100644 --- a/tests/testthat/test-shinytest2-show-rcode.R +++ b/tests/testthat/test-shinytest2-show-rcode.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: teal app initializes with Show R Code modal", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = example_module(label = "Example Module") diff --git a/tests/testthat/test-shinytest2-teal_data_module.R b/tests/testthat/test-shinytest2-teal_data_module.R index 7773e634a4..3c90248e0c 100644 --- a/tests/testthat/test-shinytest2-teal_data_module.R +++ b/tests/testthat/test-shinytest2-teal_data_module.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: teal_data_module will have a delayed load of datasets", { + skip_if_too_deep(5) tdm <- teal_data_module( ui = function(id) { ns <- shiny::NS(id) @@ -36,6 +37,7 @@ testthat::test_that("e2e: teal_data_module will have a delayed load of datasets" }) testthat::test_that("e2e: teal_data_module shows validation errors", { + skip_if_too_deep(5) tdm <- teal_data_module( ui = function(id) { ns <- shiny::NS(id) @@ -73,6 +75,7 @@ testthat::test_that("e2e: teal_data_module shows validation errors", { }) testthat::test_that("e2e: teal_data_module inputs change teal_data object that is passed to teal main UI", { + skip_if_too_deep(5) tdm <- teal_data_module( ui = function(id) { ns <- shiny::NS(id) diff --git a/tests/testthat/test-shinytest2-teal_slices.R b/tests/testthat/test-shinytest2-teal_slices.R index 67471706bf..119bd7526a 100644 --- a/tests/testthat/test-shinytest2-teal_slices.R +++ b/tests/testthat/test-shinytest2-teal_slices.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: teal_slices filters are initialized when global filters are created", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -15,28 +16,35 @@ testthat::test_that("e2e: teal_slices filters are initialized when global filter app$wait_for_idle(timeout = default_idle_timeout) - testthat::expect_identical(app$get_active_data_filters("iris"), "Species") - testthat::expect_identical(app$get_active_data_filters("mtcars"), c("cyl", "drat", "gear")) testthat::expect_identical( - app$get_active_filter_selection("iris", "Species"), + names(app$get_active_data_filters("iris")), + "Species" + ) + testthat::expect_identical( + names(app$get_active_data_filters("mtcars")), + c("cyl", "drat", "gear") + ) + testthat::expect_identical( + app$get_active_data_filters("iris")$Species, c("setosa", "versicolor", "virginica") ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "cyl"), + app$get_active_data_filters("mtcars")$cyl, c("4", "6") ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "drat"), + app$get_active_data_filters("mtcars")$drat, c(3, 4) ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "gear"), + app$get_active_data_filters("mtcars")$gear, c("3", "4", "5") ) app$stop() }) testthat::test_that("e2e: teal_slices filters are initialized when module specific filters are created", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = modules( @@ -57,37 +65,50 @@ testthat::test_that("e2e: teal_slices filters are initialized when module specif ) app$wait_for_idle(timeout = default_idle_timeout) - testthat::expect_identical(app$get_active_data_filters("iris"), "Species") - testthat::expect_identical(app$get_active_data_filters("mtcars"), "cyl") testthat::expect_identical( - app$get_active_filter_selection("iris", "Species"), + names(app$get_active_data_filters("iris")), + "Species" + ) + testthat::expect_identical( + names(app$get_active_data_filters("mtcars")), + "cyl" + ) + testthat::expect_identical( + app$get_active_data_filters("iris")$Species, c("setosa", "versicolor", "virginica") ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "cyl"), + app$get_active_data_filters("mtcars")$cyl, c("4", "6") ) - testthat::expect_null(app$get_active_filter_selection("mtcars", "drat")) - testthat::expect_null(app$get_active_filter_selection("mtcars", "gear")) + + testthat::expect_null(app$get_active_data_filters("mtcars")$drat) + testthat::expect_null(app$get_active_data_filters("mtcars")$gear) app$navigate_teal_tab("Module_2") app$wait_for_idle(timeout = default_idle_timeout) - testthat::expect_identical(app$get_active_data_filters("iris"), "Species") - testthat::expect_identical(app$get_active_data_filters("mtcars"), c("drat", "gear")) testthat::expect_identical( - app$get_active_filter_selection("iris", "Species"), + names(app$get_active_data_filters("iris")), + "Species" + ) + testthat::expect_identical( + names(app$get_active_data_filters("mtcars")), + c("drat", "gear") + ) + testthat::expect_identical( + app$get_active_data_filters("iris")$Species, c("setosa", "versicolor", "virginica") ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "drat"), + app$get_active_data_filters("mtcars")$drat, c(3, 4) ) testthat::expect_identical( - app$get_active_filter_selection("mtcars", "gear"), + app$get_active_data_filters("mtcars")$gear, c("3", "4", "5") ) - testthat::expect_null(app$get_active_filter_selection("mtcars", "cyl")) + testthat::expect_null(app$get_active_data_filters("mtcars")$cyl) app$stop() }) diff --git a/tests/testthat/test-shinytest2-utils.R b/tests/testthat/test-shinytest2-utils.R index 99ef2a0bf9..20b3e9d0d3 100644 --- a/tests/testthat/test-shinytest2-utils.R +++ b/tests/testthat/test-shinytest2-utils.R @@ -1,4 +1,5 @@ testthat::test_that("e2e: show/hide hamburger works as expected", { + skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), modules = example_module() From 90cf513ddc06ac256266e12c19781be34872382b Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 21 Mar 2024 07:10:57 +0000 Subject: [PATCH 22/35] [skip actions] Bump version to 0.15.2.9014 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8ed7c64853..d582da50ab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9013 +Version: 0.15.2.9014 Date: 2024-03-21 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index b47684f8ab..fa82a97e5f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9013 +# teal 0.15.2.9014 # teal 0.15.2 From 05c06a7dc023e49c0bb5bc41e433ca4b6be9b189 Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Thu, 21 Mar 2024 12:55:02 +0100 Subject: [PATCH 23/35] 503 shinytest2 for `landing_popup_module` (#1138) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Part of https://github.com/insightsengineering/coredev-tasks/issues/503 Just a warm-up. Trying to understand `shinytest2` tests in action. Took `landing_popup_module` to the battlefield. --------- Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Co-authored-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> --- R/TealAppDriver.R | 12 ++ man/TealAppDriver.Rd | 23 +++ man/teal_slices.Rd | 3 +- .../testthat/test-shinytest2-landing_popup.R | 168 ++++++++++++++++++ 4 files changed, 204 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/test-shinytest2-landing_popup.R diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R index 986a2073a8..2a1b5bbf5c 100644 --- a/R/TealAppDriver.R +++ b/R/TealAppDriver.R @@ -382,6 +382,18 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. invisible(self) }, #' @description + #' Extract `html` attribute (found by a `selector`). + #' + #' @param selector (`character(1)`) specifying the selector to be used to get the content of a specific node. + #' @param attribute (`character(1)`) name of an attribute to retrieve from a node specified by `selector`. + #' + #' @return The `character` vector. + get_attr = function(selector, attribute) { + self$get_html_rvest("html") %>% + rvest::html_nodes(selector) %>% + rvest::html_attr(attribute) + }, + #' @description #' Wrapper around `get_html` that passes the output directly to `rvest::read_html`. #' #' @param selector `(character(1))` passed to `get_html`. diff --git a/man/TealAppDriver.Rd b/man/TealAppDriver.Rd index 355bc547d3..a2f2db3ef2 100644 --- a/man/TealAppDriver.Rd +++ b/man/TealAppDriver.Rd @@ -38,6 +38,7 @@ driving a teal application for performing interactions for \code{shinytest2} tes \item \href{#method-TealAppDriver-add_filter_var}{\code{TealAppDriver$add_filter_var()}} \item \href{#method-TealAppDriver-remove_filter_var}{\code{TealAppDriver$remove_filter_var()}} \item \href{#method-TealAppDriver-set_active_filter_selection}{\code{TealAppDriver$set_active_filter_selection()}} +\item \href{#method-TealAppDriver-get_attr}{\code{TealAppDriver$get_attr()}} \item \href{#method-TealAppDriver-get_html_rvest}{\code{TealAppDriver$get_html_rvest()}} \item \href{#method-TealAppDriver-open_url}{\code{TealAppDriver$open_url()}} \item \href{#method-TealAppDriver-clone}{\code{TealAppDriver$clone()}} @@ -437,6 +438,28 @@ The \code{TealAppDriver} object invisibly. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-get_attr}{}}} +\subsection{Method \code{get_attr()}}{ +Extract \code{html} attribute (found by a \code{selector}). +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$get_attr(selector, attribute)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{selector}}{(\code{character(1)}) specifying the selector to be used to get the content of a specific node.} + +\item{\code{attribute}}{(\code{character(1)}) name of an attribute to retrieve from a node specified by \code{selector}.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{character} vector. +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TealAppDriver-get_html_rvest}{}}} \subsection{Method \code{get_html_rvest()}}{ diff --git a/man/teal_slices.Rd b/man/teal_slices.Rd index 834ba37617..b24cc9a5a3 100644 --- a/man/teal_slices.Rd +++ b/man/teal_slices.Rd @@ -22,8 +22,7 @@ as.teal_slices(x) \method{c}{teal_slices}(...) } \arguments{ -\item{...}{any number of \code{teal_slice} objects. For \code{print} and \code{format}, -additional arguments passed to other functions.} +\item{...}{any number of \code{teal_slice} objects.} \item{include_varnames, exclude_varnames}{(\verb{named list}s of \code{character}) where list names match names of data sets and vector elements match variable names in respective data sets; diff --git a/tests/testthat/test-shinytest2-landing_popup.R b/tests/testthat/test-shinytest2-landing_popup.R new file mode 100644 index 0000000000..c1d3826dbc --- /dev/null +++ b/tests/testthat/test-shinytest2-landing_popup.R @@ -0,0 +1,168 @@ +testthat::test_that("e2e: teal app with landing_popup_module initializes with no errors", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + landing_popup_module( + title = "Welcome", + content = tags$b("A welcome message!", style = "color: red;") + ), + example_module() + ) + ) + + app$wait_for_idle(timeout = default_idle_timeout) + testthat::expect_equal( + app$get_text("#landingpopup b"), + "A welcome message!" + ) + app$stop() +}) + +testthat::test_that("e2e: app with default landing_popup_module creates modal containing a button", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + landing_popup_module(), + example_module() + ) + ) + app$wait_for_idle(timeout = default_idle_timeout) + + testthat::expect_equal( + app$get_text("#shiny-modal-wrapper button"), + "Accept" + ) + + app$stop() +}) + +testthat::test_that("e2e: when default landing_popup_module is closed, it shows the underlying teal app", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + landing_popup_module(), + example_module() + ) + ) + app$wait_for_idle(timeout = default_idle_timeout) + + # Button is clicked. + app$click(selector = "#shiny-modal-wrapper button[data-dismiss='modal']") + app$wait_for_idle(timeout = default_idle_timeout) + + # There is no more modal displayed. + testthat::expect_null(app$get_html("#shiny-modal-wrapper")) + + app$stop() +}) + + +# customized landing_popup_module --------------------------------------------------------------------------------- + +testthat::test_that( + "e2e: app with customized landing_popup_module creates modal containing specified title, content and buttons", + { + skip_if_too_deep(5) + phash <- function(text) paste0("#", text) + + modal_title <- "Custom Landing Popup Module Title" + modal_content_message <- "A welcome message!" + modal_content <- tags$b(modal_content_message, style = "color: red;") + + modal_btns <- list( + go = list(text = "Proceed"), + more = list(text = "Read more", onclick = "window.open('http://google.com', '_blank')", id = "read"), + reject = list(text = "Reject", onclick = "window.close()", id = "close") + ) + modal_buttons <- + tagList( + shiny::modalButton(modal_btns$go$text), + shiny::actionButton( + modal_btns$more$id, + label = modal_btns$more$text, + onclick = modal_btns$more$onclick + ), + shiny::actionButton( + modal_btns$reject$id, + label = modal_btns$reject$text, + onclick = modal_btns$reject$onclick + ) + ) + + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + landing_popup_module( + title = modal_title, + content = modal_content, + buttons = modal_buttons + ), + example_module() + ) + ) + + app$wait_for_idle(timeout = default_idle_timeout) + + testthat::expect_equal( + app$get_text(".modal-title"), + modal_title + ) + + testthat::expect_equal( + trimws(app$get_text(".modal-body")), + modal_content_message + ) + + testthat::expect_equal( + app$get_text(".btn-default:nth-child(1)"), + modal_btns$go$text + ) + + testthat::expect_equal( + app$get_text(phash(modal_btns$more$id)), + modal_btns$more$text + ) + + testthat::expect_equal( + app$get_attr(phash(modal_btns$more$id), "onclick"), + modal_btns$more$onclick + ) + + testthat::expect_equal( + app$get_text(phash(modal_btns$reject$id)), + modal_btns$reject$text + ) + + testthat::expect_equal( + app$get_attr(phash(modal_btns$reject$id), "onclick"), + modal_btns$reject$onclick + ) + + app$stop() + } +) + +testthat::test_that("e2e: when customized button in landing_popup_module is clicked, it redirects to a certain page", { + skip_if_too_deep(5) + onclick_text <- "window.open('http://google.com', '_blank')" + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + landing_popup_module( + buttons = actionButton("read", "Read more", onclick = onclick_text) + ), + example_module() + ) + ) + app$wait_for_idle(timeout = default_idle_timeout) + + testthat::expect_equal( + app$get_attr("#read", "onclick"), + onclick_text + ) + + app$stop() +}) From 4e4628eb08ff523a4824e1406034ab010d8aab6b Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 21 Mar 2024 11:56:00 +0000 Subject: [PATCH 24/35] [skip actions] Bump version to 0.15.2.9015 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d582da50ab..eec199768d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9014 +Version: 0.15.2.9015 Date: 2024-03-21 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index fa82a97e5f..d05a520160 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9014 +# teal 0.15.2.9015 # teal 0.15.2 From 3793de0607a118bfdb3bb99839e4e9c27e4c641e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 21 Mar 2024 17:18:22 +0100 Subject: [PATCH 25/35] Migrate to new API calls on `TealAppDriver` (#1174) # Pull Request Fixes #1173 ### Changes description: - Migrate `TealAppDriver$get_active_data_filters()` to `TealAppDriver$get_active_data_filters()$` ### Follow-up - Add `TESTING_DEPTH=5` to R CMD check CI --------- Co-authored-by: vedhav --- .github/workflows/check.yaml | 1 + tests/testthat/test-shinytest2-filter_panel.R | 8 ++++---- tests/testthat/test-shinytest2-teal_data_module.R | 2 +- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 0b9fc4d244..e868f7023c 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -27,6 +27,7 @@ jobs: with: additional-env-vars: | _R_CHECK_CRAN_INCOMING_REMOTE_=false + TESTING_DEPTH=5 additional-r-cmd-check-params: --as-cran enforce-note-blocklist: true note-blocklist: | diff --git a/tests/testthat/test-shinytest2-filter_panel.R b/tests/testthat/test-shinytest2-filter_panel.R index e2c07884df..6af0a4bb89 100644 --- a/tests/testthat/test-shinytest2-filter_panel.R +++ b/tests/testthat/test-shinytest2-filter_panel.R @@ -50,7 +50,7 @@ testthat::test_that("e2e: filtering a module-specific filter is refected in othe app$wait_for_idle(timeout = default_idle_timeout) expect_equal( - app$get_active_filter_selection("iris", "Species"), + app$get_active_data_filters("iris")$Species, c("setosa", "versicolor", "virginica") ) @@ -63,7 +63,7 @@ testthat::test_that("e2e: filtering a module-specific filter is refected in othe app$wait_for_idle(timeout = default_idle_timeout) expect_equal( - app$get_active_filter_selection("iris", "Species"), + app$get_active_data_filters("iris")$Species, c("setosa") ) @@ -93,7 +93,7 @@ testthat::test_that("e2e: filtering a module-specific filter is not refected in app$wait_for_idle(timeout = default_idle_timeout) expect_equal( - app$get_active_filter_selection("mtcars", "cyl"), + app$get_active_data_filters("mtcars")$cyl, c("4", "6") ) @@ -106,7 +106,7 @@ testthat::test_that("e2e: filtering a module-specific filter is not refected in app$wait_for_idle(timeout = default_idle_timeout) expect_equal( - app$get_active_filter_selection("mtcars", "cyl"), + app$get_active_data_filters("mtcars")$cyl, c("4", "6") ) diff --git a/tests/testthat/test-shinytest2-teal_data_module.R b/tests/testthat/test-shinytest2-teal_data_module.R index 3c90248e0c..e830183981 100644 --- a/tests/testthat/test-shinytest2-teal_data_module.R +++ b/tests/testthat/test-shinytest2-teal_data_module.R @@ -120,7 +120,7 @@ testthat::test_that("e2e: teal_data_module inputs change teal_data object that i app$wait_for_idle() testthat::expect_setequal( - app$get_active_filter_selection("dataset1", "A_New_Column"), + app$get_active_data_filters("dataset1")$A_New_Column, unique(sprintf("%s new", iris$Species)) ) From e03bf26658e0a344b85894f3a6ced0497ced3051 Mon Sep 17 00:00:00 2001 From: averissimo Date: Thu, 21 Mar 2024 16:19:19 +0000 Subject: [PATCH 26/35] [skip actions] Bump version to 0.15.2.9016 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index eec199768d..4ac7521f8c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9015 +Version: 0.15.2.9016 Date: 2024-03-21 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index d05a520160..84f45eaefa 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9015 +# teal 0.15.2.9016 # teal 0.15.2 From 72a81dab84a603608e80cd0f6b9e2c1898035965 Mon Sep 17 00:00:00 2001 From: kartikeya kirar Date: Wed, 27 Mar 2024 21:28:38 +0530 Subject: [PATCH 27/35] add wrapper for wait_for_value for output value. (#1172) This PR introduces a wrapper for the wait_for_value method, specifically designed for output values. --------- Signed-off-by: kartikeya kirar Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> --- R/TealAppDriver.R | 25 +++++++++++++++++++++++++ man/TealAppDriver.Rd | 29 +++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R index 2a1b5bbf5c..3130b78a58 100644 --- a/R/TealAppDriver.R +++ b/R/TealAppDriver.R @@ -407,6 +407,31 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. #' @return Nothing. Opens the underlying teal app in the browser. open_url = function() { browseURL(self$get_url()) + }, + #' @description + #' Waits until a specified input, output, or export value. + #' This function serves as a wrapper around the `wait_for_value` method, + #' providing a more flexible interface for waiting on different types of values within the active module namespace. + #' @param input,output,export A name of an input, output, or export value. + #' Only one of these parameters may be used. + #' @param ... Must be empty. Allows for parameter expansion. + #' Parameter with additional value to passed in `wait_for_value`. + wait_for_active_module_value = function(input = rlang::missing_arg(), + output = rlang::missing_arg(), + export = rlang::missing_arg(), + ...) { + ns <- shiny::NS(self$active_module_ns()) + + if (!rlang::is_missing(input) && checkmate::test_string(input, min.chars = 1)) input <- ns(input) + if (!rlang::is_missing(output) && checkmate::test_string(output, min.chars = 1)) output <- ns(output) + if (!rlang::is_missing(export) && checkmate::test_string(export, min.chars = 1)) export <- ns(export) + + self$wait_for_value( + input = input, + output = output, + export = export, + ... + ) } ), # private members ---- diff --git a/man/TealAppDriver.Rd b/man/TealAppDriver.Rd index a2f2db3ef2..3a3e482dbc 100644 --- a/man/TealAppDriver.Rd +++ b/man/TealAppDriver.Rd @@ -41,6 +41,7 @@ driving a teal application for performing interactions for \code{shinytest2} tes \item \href{#method-TealAppDriver-get_attr}{\code{TealAppDriver$get_attr()}} \item \href{#method-TealAppDriver-get_html_rvest}{\code{TealAppDriver$get_html_rvest()}} \item \href{#method-TealAppDriver-open_url}{\code{TealAppDriver$open_url()}} +\item \href{#method-TealAppDriver-wait_for_active_module_value}{\code{TealAppDriver$wait_for_active_module_value()}} \item \href{#method-TealAppDriver-clone}{\code{TealAppDriver$clone()}} } } @@ -493,6 +494,34 @@ Nothing. Opens the underlying teal app in the browser. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-wait_for_active_module_value}{}}} +\subsection{Method \code{wait_for_active_module_value()}}{ +Waits until a specified input, output, or export value. +This function serves as a wrapper around the \code{wait_for_value} method, +providing a more flexible interface for waiting on different types of values within the active module namespace. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TealAppDriver$wait_for_active_module_value( + input = rlang::missing_arg(), + output = rlang::missing_arg(), + export = rlang::missing_arg(), + ... +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{input, output, export}}{A name of an input, output, or export value. +Only one of these parameters may be used.} + +\item{\code{...}}{Must be empty. Allows for parameter expansion. +Parameter with additional value to passed in \code{wait_for_value}.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TealAppDriver-clone}{}}} \subsection{Method \code{clone()}}{ From 8e3dfa31c098c31b7e898336e5f4483960ff0a01 Mon Sep 17 00:00:00 2001 From: kartikeyakirar Date: Wed, 27 Mar 2024 15:59:42 +0000 Subject: [PATCH 28/35] [skip actions] Bump version to 0.15.2.9017 --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4ac7521f8c..6f3f8b711b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9016 -Date: 2024-03-21 +Version: 0.15.2.9017 +Date: 2024-03-27 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), diff --git a/NEWS.md b/NEWS.md index 84f45eaefa..8eeb7898bb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9016 +# teal 0.15.2.9017 # teal 0.15.2 From 3bdb696392c1ab7d163eb004a5ac10943c5c3072 Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Wed, 27 Mar 2024 17:21:58 +0100 Subject: [PATCH 29/35] 1163 extend `TealAppDriver$new()` and `TealAppDriver$click()` with `$wait_for_idle()` calls (#1171) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Close #1163 - removed all `$wait_for_idle()` calls after `TealAppDrvier$new()` as I extended the method to call `$wait_for_idle()` - removed all `$wait_for_idle()` calls after `app$click()` as I extended the method to call `$wait_for_idle()` - removed all `$wait_for_idle()` calls after `app$navigate_teal_tab()` as it is called inside the method already Questions: - Should we add `timeout` parameter to initialize that will be passed to `self$wait_for_idle()` or add `...` in `self$wait_for_idle(...)` at the end of the call. So that during `TealAppDriver$new()` you can pass `timeout = `. - `app$navigate_teal_tab` uses `private$idle_timeout` (`self$wait_for_idle(timeout = private$idle_timeout)`). Should we use `private$idle_timeout` in `TealAppDrvier$new` where we call `$wait_for_idle()`. Also, should we set `private$idle_timeout` in `TealAppDrvier$new` --------- Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/TealAppDriver.R | 33 +++++++++++++++--- man/TealAppDriver.Rd | 34 ++++++++++++++++++- tests/testthat/helper-shinytest2.R | 2 -- tests/testthat/test-shinytest2-filter_panel.R | 10 ------ tests/testthat/test-shinytest2-init.R | 4 --- .../testthat/test-shinytest2-landing_popup.R | 7 ---- tests/testthat/test-shinytest2-modules.R | 5 +-- tests/testthat/test-shinytest2-reporter.R | 2 -- tests/testthat/test-shinytest2-show-rcode.R | 2 -- .../test-shinytest2-teal_data_module.R | 14 +++----- tests/testthat/test-shinytest2-teal_slices.R | 4 --- tests/testthat/test-shinytest2-utils.R | 1 - 12 files changed, 67 insertions(+), 51 deletions(-) diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R index 3130b78a58..c3426d4965 100644 --- a/R/TealAppDriver.R +++ b/R/TealAppDriver.R @@ -16,8 +16,20 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. #' Initialize a `TealAppDriver` object for testing a `teal` application. #' #' @param data,modules,filter,title,header,footer arguments passed to `init` + #' @param timeout (`numeric`) Default number of milliseconds for any timeout or + #' timeout_ parameter in the `TealAppDriver` class. + #' Defaults to 20s. + #' + #' See [`shinytest2::AppDriver`] `new` method for more details on how to change it + #' via options or environment variables. + #' @param load_timeout (`numeric`) How long to wait for the app to load, in ms. + #' This includes the time to start R. Defaults to 100s. + #' + #' See [`shinytest2::AppDriver`] `new` method for more details on how to change it + #' via options or environment variables #' @param ... Additional arguments to be passed to `shinytest2::AppDriver$new` #' + #' #' @return Object of class `TealAppDriver` initialize = function(data, modules, @@ -25,6 +37,8 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. title = build_app_title(), header = tags$p(), footer = tags$p(), + timeout = rlang::missing_arg(), + load_timeout = rlang::missing_arg(), ...) { private$data <- data private$modules <- modules @@ -37,16 +51,29 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. header = header, footer = footer ) + + # Default timeout is hardcoded to 4s in shinytest2:::resolve_timeout + # It must be set as parameter to the AppDriver suppressWarnings( super$initialize( - shinyApp(app$ui, app$server), + app_dir = shinyApp(app$ui, app$server), name = "teal", variant = platform_variant(), + timeout = rlang::maybe_missing(timeout, 20 * 1000), + load_timeout = rlang::maybe_missing(load_timeout, 100 * 1000), ... ) ) private$set_active_ns() + self$wait_for_idle() + }, + #' @description + #' Append parent [`shinytest2::AppDriver`] `click` method with a call to `waif_for_idle()` method. + #' @param ... arguments passed to parent [`shinytest2::AppDriver`] `click()` method. + click = function(...) { + super$click(...) + self$wait_for_idle() }, #' @description #' Check if the app has shiny errors. This checks for global shiny errors. @@ -112,7 +139,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. ) root <- sprintf("%s-%s", private$modules$label, get_unique_labels(tab)) } - self$wait_for_idle(timeout = private$idle_timeout) + self$wait_for_idle() private$set_active_ns() invisible(self) }, @@ -444,8 +471,6 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. 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 diff --git a/man/TealAppDriver.Rd b/man/TealAppDriver.Rd index 3a3e482dbc..0d2e8bb556 100644 --- a/man/TealAppDriver.Rd +++ b/man/TealAppDriver.Rd @@ -20,6 +20,7 @@ driving a teal application for performing interactions for \code{shinytest2} tes \subsection{Public methods}{ \itemize{ \item \href{#method-TealAppDriver-new}{\code{TealAppDriver$new()}} +\item \href{#method-TealAppDriver-click}{\code{TealAppDriver$click()}} \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()}} @@ -48,7 +49,6 @@ driving a teal application for performing interactions for \code{shinytest2} tes \if{html}{\out{
Inherited methods
    -
  • shinytest2::AppDriver$click()
  • shinytest2::AppDriver$expect_download()
  • shinytest2::AppDriver$expect_html()
  • shinytest2::AppDriver$expect_js()
    • @@ -95,6 +95,8 @@ Initialize a \code{TealAppDriver} object for testing a \code{teal} application. title = build_app_title(), header = tags$p(), footer = tags$p(), + timeout = rlang::missing_arg(), + load_timeout = rlang::missing_arg(), ... )}\if{html}{\out{}} } @@ -104,6 +106,19 @@ Initialize a \code{TealAppDriver} object for testing a \code{teal} application. \describe{ \item{\code{data, modules, filter, title, header, footer}}{arguments passed to \code{init}} +\item{\code{timeout}}{(\code{numeric}) Default number of milliseconds for any timeout or +timeout_ parameter in the \code{TealAppDriver} class. +Defaults to 20s. + +See \code{\link[shinytest2:AppDriver]{shinytest2::AppDriver}} \code{new} method for more details on how to change it +via options or environment variables.} + +\item{\code{load_timeout}}{(\code{numeric}) How long to wait for the app to load, in ms. +This includes the time to start R. Defaults to 100s. + +See \code{\link[shinytest2:AppDriver]{shinytest2::AppDriver}} \code{new} method for more details on how to change it +via options or environment variables} + \item{\code{...}}{Additional arguments to be passed to \code{shinytest2::AppDriver$new}} } \if{html}{\out{}} @@ -113,6 +128,23 @@ Object of class \code{TealAppDriver} } } \if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TealAppDriver-click}{}}} +\subsection{Method \code{click()}}{ +Append parent \code{\link[shinytest2:AppDriver]{shinytest2::AppDriver}} \code{click} method with a call to \code{waif_for_idle()} method. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{TealAppDriver$click(...)}\if{html}{\out{
    }} +} + +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{...}}{arguments passed to parent \code{\link[shinytest2:AppDriver]{shinytest2::AppDriver}} \code{click()} method.} +} +\if{html}{\out{
    }} +} +} +\if{html}{\out{
    }} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TealAppDriver-expect_no_shiny_error}{}}} \subsection{Method \code{expect_no_shiny_error()}}{ diff --git a/tests/testthat/helper-shinytest2.R b/tests/testthat/helper-shinytest2.R index bf90d956f8..f5c298ac40 100644 --- a/tests/testthat/helper-shinytest2.R +++ b/tests/testthat/helper-shinytest2.R @@ -1,8 +1,6 @@ library(shinytest2) library(rvest) -default_idle_timeout <- 20000 - simple_teal_data <- function() { data <- within(teal_data(), { iris <- iris diff --git a/tests/testthat/test-shinytest2-filter_panel.R b/tests/testthat/test-shinytest2-filter_panel.R index 6af0a4bb89..2f65f29b91 100644 --- a/tests/testthat/test-shinytest2-filter_panel.R +++ b/tests/testthat/test-shinytest2-filter_panel.R @@ -14,8 +14,6 @@ testthat::test_that("e2e: module content is updated when a data is filtered in f ) ) - 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")) @@ -47,20 +45,16 @@ testthat::test_that("e2e: filtering a module-specific filter is refected in othe ) ) - app$wait_for_idle(timeout = default_idle_timeout) - expect_equal( app$get_active_data_filters("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_data_filters("iris")$Species, @@ -90,20 +84,16 @@ testthat::test_that("e2e: filtering a module-specific filter is not refected in ) ) - app$wait_for_idle(timeout = default_idle_timeout) - expect_equal( app$get_active_data_filters("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_data_filters("mtcars")$cyl, diff --git a/tests/testthat/test-shinytest2-init.R b/tests/testthat/test-shinytest2-init.R index c070d7b539..9f57bfa904 100644 --- a/tests/testthat/test-shinytest2-init.R +++ b/tests/testthat/test-shinytest2-init.R @@ -4,7 +4,6 @@ testthat::test_that("e2e: teal app initializes with no errors", { 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() }) @@ -15,7 +14,6 @@ testthat::test_that("e2e: teal app initializes with sessionInfo modal", { data = simple_teal_data(), modules = example_module(label = "Example Module") ) - app$wait_for_idle(timeout = default_idle_timeout) # Check if button exists. button_selector <- "#teal-sessionInfo-button" @@ -25,7 +23,6 @@ testthat::test_that("e2e: teal app initializes with sessionInfo modal", { ) app$click(selector = button_selector) - app$wait_for_idle(timeout = default_idle_timeout) # Check header and title content. testthat::expect_equal( @@ -82,7 +79,6 @@ testthat::test_that("e2e: init creates UI containing specified title, favicon, h header = app_header, footer = app_footer ) - app$wait_for_idle(timeout = default_idle_timeout) testthat::expect_equal( app$get_text("head > title")[1], diff --git a/tests/testthat/test-shinytest2-landing_popup.R b/tests/testthat/test-shinytest2-landing_popup.R index c1d3826dbc..adaa82c19a 100644 --- a/tests/testthat/test-shinytest2-landing_popup.R +++ b/tests/testthat/test-shinytest2-landing_popup.R @@ -11,7 +11,6 @@ testthat::test_that("e2e: teal app with landing_popup_module initializes with no ) ) - app$wait_for_idle(timeout = default_idle_timeout) testthat::expect_equal( app$get_text("#landingpopup b"), "A welcome message!" @@ -28,7 +27,6 @@ testthat::test_that("e2e: app with default landing_popup_module creates modal co example_module() ) ) - app$wait_for_idle(timeout = default_idle_timeout) testthat::expect_equal( app$get_text("#shiny-modal-wrapper button"), @@ -47,11 +45,9 @@ testthat::test_that("e2e: when default landing_popup_module is closed, it shows example_module() ) ) - app$wait_for_idle(timeout = default_idle_timeout) # Button is clicked. app$click(selector = "#shiny-modal-wrapper button[data-dismiss='modal']") - app$wait_for_idle(timeout = default_idle_timeout) # There is no more modal displayed. testthat::expect_null(app$get_html("#shiny-modal-wrapper")) @@ -104,8 +100,6 @@ testthat::test_that( ) ) - app$wait_for_idle(timeout = default_idle_timeout) - testthat::expect_equal( app$get_text(".modal-title"), modal_title @@ -157,7 +151,6 @@ testthat::test_that("e2e: when customized button in landing_popup_module is clic example_module() ) ) - app$wait_for_idle(timeout = default_idle_timeout) testthat::expect_equal( app$get_attr("#read", "onclick"), diff --git a/tests/testthat/test-shinytest2-modules.R b/tests/testthat/test-shinytest2-modules.R index e547fdd397..536f09f2b9 100644 --- a/tests/testthat/test-shinytest2-modules.R +++ b/tests/testthat/test-shinytest2-modules.R @@ -24,7 +24,7 @@ testthat::test_that("e2e: the module server logic is only triggered when the tea 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) @@ -45,7 +45,6 @@ testthat::test_that("e2e: filter panel only shows the data supplied using datana example_module(label = "mtcars", datanames = "mtcars") ) ) - app$wait_for_idle(timeout = default_idle_timeout) testthat::expect_identical( app$get_active_filter_vars(), @@ -62,7 +61,6 @@ testthat::test_that("e2e: filter panel shows all the datasets when datanames is example_module(label = "all", datanames = "all") ) ) - app$wait_for_idle(timeout = default_idle_timeout) testthat::expect_identical( app$get_active_filter_vars(), @@ -79,7 +77,6 @@ testthat::test_that("e2e: filter panel is not displayed when datanames is NULL", example_module(label = "NULL", datanames = NULL) ) ) - app$wait_for_idle(timeout = default_idle_timeout) testthat::expect_identical( app$get_html_rvest(".teal_secondary_col") %>% diff --git a/tests/testthat/test-shinytest2-reporter.R b/tests/testthat/test-shinytest2-reporter.R index 46ba6f9bc9..77b6b190d8 100644 --- a/tests/testthat/test-shinytest2-reporter.R +++ b/tests/testthat/test-shinytest2-reporter.R @@ -46,10 +46,8 @@ testthat::test_that("e2e: adding a report card in a module adds it in the report 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"), diff --git a/tests/testthat/test-shinytest2-show-rcode.R b/tests/testthat/test-shinytest2-show-rcode.R index 09cc122080..383ed57b90 100644 --- a/tests/testthat/test-shinytest2-show-rcode.R +++ b/tests/testthat/test-shinytest2-show-rcode.R @@ -4,7 +4,6 @@ testthat::test_that("e2e: teal app initializes with Show R Code modal", { data = simple_teal_data(), modules = example_module(label = "Example Module") ) - app$wait_for_idle(timeout = default_idle_timeout) # Check if button exists. button_selector <- app$active_module_element("rcode-button") @@ -14,7 +13,6 @@ testthat::test_that("e2e: teal app initializes with Show R Code modal", { ) app$click(selector = button_selector) - app$wait_for_idle(timeout = default_idle_timeout) # Check header and title content. testthat::expect_equal( diff --git a/tests/testthat/test-shinytest2-teal_data_module.R b/tests/testthat/test-shinytest2-teal_data_module.R index e830183981..87025f1542 100644 --- a/tests/testthat/test-shinytest2-teal_data_module.R +++ b/tests/testthat/test-shinytest2-teal_data_module.R @@ -25,12 +25,10 @@ testthat::test_that("e2e: teal_data_module will have a delayed load of datasets" app <- TealAppDriver$new( data = tdm, - modules = example_module(label = "Example Module"), - timeout = default_idle_timeout + modules = example_module(label = "Example Module") ) app$click("teal_data_module-submit") - app$wait_for_idle() testthat::expect_setequal(app$get_active_filter_vars(), c("dataset1", "dataset2")) app$stop() @@ -62,10 +60,8 @@ testthat::test_that("e2e: teal_data_module shows validation errors", { app <- TealAppDriver$new( data = tdm, - modules = example_module(label = "Example Module"), - timeout = default_idle_timeout + modules = example_module(label = "Example Module") ) - app$wait_for_idle() app$click("teal_data_module-submit") @@ -108,17 +104,15 @@ testthat::test_that("e2e: teal_data_module inputs change teal_data object that i app <- TealAppDriver$new( data = tdm, - modules = example_module(label = "Example Module"), - timeout = default_idle_timeout + modules = example_module(label = "Example Module") ) - app$wait_for_idle() + app$set_input("teal_data_module-new_column", "A_New_Column") app$click("teal_data_module-submit") # This may fail if teal_data_module does not perform the transformation testthat::expect_no_error(app$add_filter_var("dataset1", "A_New_Column")) - app$wait_for_idle() testthat::expect_setequal( app$get_active_data_filters("dataset1")$A_New_Column, unique(sprintf("%s new", iris$Species)) diff --git a/tests/testthat/test-shinytest2-teal_slices.R b/tests/testthat/test-shinytest2-teal_slices.R index 119bd7526a..3797590074 100644 --- a/tests/testthat/test-shinytest2-teal_slices.R +++ b/tests/testthat/test-shinytest2-teal_slices.R @@ -14,8 +14,6 @@ testthat::test_that("e2e: teal_slices filters are initialized when global filter ) ) - app$wait_for_idle(timeout = default_idle_timeout) - testthat::expect_identical( names(app$get_active_data_filters("iris")), "Species" @@ -63,7 +61,6 @@ testthat::test_that("e2e: teal_slices filters are initialized when module specif ) ) ) - app$wait_for_idle(timeout = default_idle_timeout) testthat::expect_identical( names(app$get_active_data_filters("iris")), @@ -86,7 +83,6 @@ testthat::test_that("e2e: teal_slices filters are initialized when module specif testthat::expect_null(app$get_active_data_filters("mtcars")$gear) app$navigate_teal_tab("Module_2") - app$wait_for_idle(timeout = default_idle_timeout) testthat::expect_identical( names(app$get_active_data_filters("iris")), diff --git a/tests/testthat/test-shinytest2-utils.R b/tests/testthat/test-shinytest2-utils.R index 20b3e9d0d3..30b0d2bef2 100644 --- a/tests/testthat/test-shinytest2-utils.R +++ b/tests/testthat/test-shinytest2-utils.R @@ -21,7 +21,6 @@ testthat::test_that("e2e: show/hide hamburger works as expected", { 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") From ad3ff56525e20bc0910fa3187c31af35becdd5a7 Mon Sep 17 00:00:00 2001 From: averissimo Date: Wed, 27 Mar 2024 16:23:00 +0000 Subject: [PATCH 30/35] [skip actions] Bump version to 0.15.2.9018 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6f3f8b711b..e88e29a11e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9017 +Version: 0.15.2.9018 Date: 2024-03-27 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 8eeb7898bb..afb7101b1c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9017 +# teal 0.15.2.9018 # teal 0.15.2 From f331ffee399dbc1c9de093dc1fcc476a8fc91783 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Date: Thu, 28 Mar 2024 17:15:53 +0100 Subject: [PATCH 31/35] 898 save app state version 3 (#1011) Closes #898 Closes #941 Incorporating bookmarking to `teal` applications. --- DESCRIPTION | 2 + NEWS.md | 3 + R/dummy_functions.R | 10 +- R/init.R | 9 +- R/module_bookmark_manager.R | 313 ++++++++++++++++++ R/module_filter_manager.R | 128 ++++--- R/module_nested_tabs.R | 39 ++- R/module_snapshot_manager.R | 110 ++++-- R/module_tabs_with_filters.R | 6 +- R/module_teal.R | 7 +- R/module_wunder_bar.R | 93 ++++++ R/modules.R | 18 + R/reporter_previewer_module.R | 1 + inst/WORDLIST | 22 +- inst/css/sidebar.css | 37 ++- man/bookmarks_identical.Rd | 37 +++ man/filter_manager_module_srv.Rd | 2 +- man/init.Rd | 2 +- man/module_bookmark_manager.Rd | 61 ++++ man/module_filter_manager.Rd | 22 +- man/module_filter_manager_modal.Rd | 29 -- ...r_module.Rd => module_snapshot_manager.Rd} | 29 +- man/module_wunder_bar.Rd | 49 +++ man/modules_bookmarkable.Rd | 19 ++ man/restoreValue.Rd | 33 ++ tests/testthat/test-filter_manager.R | 8 +- .../test-shinytest2-module_bookmark_manager.R | 57 ++++ tests/testthat/test-shinytest2-wunder_bar.R | 36 ++ tests/testthat/test-snapshot_manager.R | 6 +- 29 files changed, 990 insertions(+), 198 deletions(-) create mode 100644 R/module_bookmark_manager.R create mode 100644 R/module_wunder_bar.R create mode 100644 man/bookmarks_identical.Rd create mode 100644 man/module_bookmark_manager.Rd delete mode 100644 man/module_filter_manager_modal.Rd rename man/{snapshot_manager_module.Rd => module_snapshot_manager.Rd} (84%) create mode 100644 man/module_wunder_bar.Rd create mode 100644 man/modules_bookmarkable.Rd create mode 100644 man/restoreValue.Rd create mode 100644 tests/testthat/test-shinytest2-module_bookmark_manager.R create mode 100644 tests/testthat/test-shinytest2-wunder_bar.R diff --git a/DESCRIPTION b/DESCRIPTION index e88e29a11e..84f77760f8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -93,12 +93,14 @@ Collate: 'modules.R' 'init.R' 'landing_popup_module.R' + 'module_bookmark_manager.R' 'module_filter_manager.R' 'module_nested_tabs.R' 'module_snapshot_manager.R' 'module_tabs_with_filters.R' 'module_teal.R' 'module_teal_with_splash.R' + 'module_wunder_bar.R' 'reporter_previewer_module.R' 'show_rcode_modal.R' 'tdata.R' diff --git a/NEWS.md b/NEWS.md index afb7101b1c..401182f502 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # teal 0.15.2.9018 +### Miscellaneous +* Filter mapping display is no longer coupled to the snapshot manager. + # teal 0.15.2 ### Bug fixes diff --git a/R/dummy_functions.R b/R/dummy_functions.R index 19abbaa16d..4624b783d9 100644 --- a/R/dummy_functions.R +++ b/R/dummy_functions.R @@ -15,12 +15,16 @@ #' @export example_module <- function(label = "example teal module", datanames = "all") { checkmate::assert_string(label) - module( + ans <- module( label, server = function(id, data) { checkmate::assert_class(data(), "teal_data") moduleServer(id, function(input, output, session) { - updateSelectInput(session, "dataname", choices = isolate(teal.data::datanames(data()))) + updateSelectInput( + inputId = "dataname", + choices = isolate(teal.data::datanames(data())), + selected = restoreInput(session$ns("dataname"), NULL) + ) output$text <- renderPrint({ req(input$dataname) data()[[input$dataname]] @@ -44,4 +48,6 @@ example_module <- function(label = "example teal module", datanames = "all") { }, datanames = datanames ) + attr(ans, "teal_bookmarkable") <- TRUE + ans } diff --git a/R/init.R b/R/init.R index 445d9432b0..8bea52b69a 100644 --- a/R/init.R +++ b/R/init.R @@ -35,7 +35,7 @@ #' string specifying the `shiny` module id in cases it is used as a `shiny` module #' rather than a standalone `shiny` app. This is a legacy feature. #' -#' @return Named list with server and UI functions. +#' @return Named list containing server and UI functions. #' #' @export #' @@ -164,8 +164,8 @@ init <- function(data, stop("Only one `landing_popup_module` can be used.") } - ## `filter` - app_id attribute - attr(filter, "app_id") <- create_app_id(data, modules) + ## `filter` - set app_id attribute unless present (when restoring bookmark) + if (is.null(attr(filter, "app_id", exact = TRUE))) attr(filter, "app_id") <- create_app_id(data, modules) ## `filter` - convert teal.slice::teal_slices to teal::teal_slices filter <- as.teal_slices(as.list(filter)) @@ -221,8 +221,9 @@ init <- function(data, # Note regarding case `id = character(0)`: # rather than creating a submodule of this module, we directly modify # the UI and server with `id = character(0)` and calling the server function directly + # Note: UI must be a function to support bookmarking. res <- list( - ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), + ui = function(request) ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), server = function(input, output, session) { if (!is.null(landing_module)) { do.call(landing_module$server, c(list(id = "landing_module_shiny_id"), landing_module$server_args)) diff --git a/R/module_bookmark_manager.R b/R/module_bookmark_manager.R new file mode 100644 index 0000000000..594392ba00 --- /dev/null +++ b/R/module_bookmark_manager.R @@ -0,0 +1,313 @@ +#' App state management. +#' +#' @description +#' `r lifecycle::badge("experimental")` +#' +#' Capture and restore the global (app) input state. +#' +#' @details +#' This module introduces bookmarks into `teal` apps: the `shiny` bookmarking mechanism becomes enabled +#' and server-side bookmarks can be created. +#' +#' The bookmark manager presents a button with the bookmark icon and is placed in the [`wunder_bar`]. +#' When clicked, the button creates a bookmark and opens a modal which displays the bookmark URL. +#' +#' `teal` does not guarantee that all modules (`teal_module` objects) are bookmarkable. +#' Those that are, have a `teal_bookmarkable` attribute set to `TRUE`. If any modules are not bookmarkable, +#' the bookmark manager modal displays a warning and the bookmark button displays a flag. +#' In order to communicate that a external module is bookmarkable, the module developer +#' should set the `teal_bookmarkable` attribute to `TRUE`. +#' +#' @section Server logic: +#' A bookmark is a URL that contains the app address with a `/?_state_id_=` suffix. +#' `` is a directory created on the server, where the state of the application is saved. +#' Accessing the bookmark URL opens a new session of the app that starts in the previously saved state. +#' +#' @section Note: +#' To enable bookmarking use either: +#' - `shiny` app by using `shinyApp(..., enableBookmarking = "server")` (not supported in `shinytest2`) +#' - set `options(shiny.bookmarkStore = "server")` before running the app +#' +#' +#' @inheritParams module_wunder_bar +#' +#' @return Invisible `NULL`. +#' +#' @aliases bookmark bookmark_manager bookmark_manager_module +#' +#' @name module_bookmark_manager +#' @keywords internal +#' +bookmark_manager_ui <- function(id) { + ns <- NS(id) + uiOutput(ns("bookmark_button"), inline = TRUE) +} + +#' @rdname module_bookmark_manager +#' @keywords internal +#' +bookmark_manager_srv <- function(id, modules) { + checkmate::assert_character(id) + checkmate::assert_class(modules, "teal_modules") + moduleServer(id, function(input, output, session) { + logger::log_trace("bookmark_manager_srv initializing") + ns <- session$ns + bookmark_option <- getShinyOption("bookmarkStore") + if (is.null(bookmark_option) && identical(getOption("shiny.bookmarkStore"), "server")) { + bookmark_option <- getOption("shiny.bookmarkStore") + # option alone doesn't activate bookmarking - we need to set shinyOptions + shinyOptions(bookmarkStore = bookmark_option) + } + + is_unbookmarkable <- unlist(rapply2( + modules_bookmarkable(modules), + Negate(isTRUE) + )) + + # Render bookmark warnings count + output$bookmark_button <- renderUI({ + if (!all(is_unbookmarkable) && identical(bookmark_option, "server")) { + tags$button( + id = ns("do_bookmark"), + class = "btn action-button wunder_bar_button bookmark_manager_button", + title = "Add bookmark", + tags$span( + suppressMessages(icon("solid fa-bookmark")), + if (any(is_unbookmarkable)) { + tags$span( + sum(is_unbookmarkable), + class = "badge-warning badge-count text-white bg-danger" + ) + } + ) + ) + } + }) + + # Set up bookmarking callbacks ---- + # Register bookmark exclusions: do_bookmark button to avoid re-bookmarking + setBookmarkExclude(c("do_bookmark")) + # This bookmark can only be used on the app session. + app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") + app_session$onBookmarked(function(url) { + logger::log_trace("bookmark_manager_srv@onBookmarked: bookmark button clicked, registering bookmark") + modal_content <- if (bookmark_option != "server") { + msg <- sprintf( + "Bookmarking has been set to \"%s\".\n%s\n%s", + bookmark_option, + "Only server-side bookmarking is supported.", + "Please contact your app developer." + ) + tags$div( + tags$p(msg, class = "text-warning") + ) + } else { + tags$div( + tags$span( + tags$pre(url) + ), + if (any(is_unbookmarkable)) { + bkmb_summary <- rapply2( + modules_bookmarkable(modules), + function(x) { + if (isTRUE(x)) { + "\u2705" # check mark + } else if (isFALSE(x)) { + "\u274C" # cross mark + } else { + "\u2753" # question mark + } + } + ) + tags$div( + tags$p( + icon("fas fa-exclamation-triangle"), + "Some modules will not be restored when using this bookmark.", + tags$br(), + "Check the list below to see which modules are not bookmarkable.", + class = "text-warning" + ), + tags$pre(yaml::as.yaml(bkmb_summary)) + ) + } + ) + } + + showModal( + modalDialog( + id = ns("bookmark_modal"), + title = "Bookmarked teal app url", + modal_content, + easyClose = TRUE + ) + ) + }) + + # manually trigger bookmarking because of the problems reported on windows with bookmarkButton in teal + observeEvent(input$do_bookmark, { + logger::log_trace("bookmark_manager_srv@1 do_bookmark module clicked.") + session$doBookmark() + }) + + invisible(NULL) + }) +} + +# utilities ---- + +#' Restore value from bookmark. +#' +#' Get value from bookmark or return default. +#' +#' Bookmarks can store not only inputs but also arbitrary values. +#' These values are stored by `onBookmark` callbacks and restored by `onBookmarked` callbacks, +#' and they are placed in the `values` environment in the `session$restoreContext` field. +#' Using `teal_data_module` makes it impossible to run the callbacks +#' because the app becomes ready before modules execute and callbacks are registered. +#' In those cases the stored values can still be recovered from the `session` object directly. +#' +#' Note that variable names in the `values` environment are prefixed with module name space names, +#' therefore, when using this function in modules, `value` must be run through the name space function. +#' +#' @param value (`character(1)`) name of value to restore +#' @param default fallback value +#' +#' @return +#' In an application restored from a server-side bookmark, +#' the variable specified by `value` from the `values` environment. +#' Otherwise `default`. +#' +#' @keywords internal +#' +restoreValue <- function(value, default) { # nolint: object_name. + checkmate::assert_character("value") + session_default <- shiny::getDefaultReactiveDomain() + session_parent <- .subset2(session_default, "parent") + session <- if (is.null(session_parent)) session_default else session_parent + + if (isTRUE(session$restoreContext$active) && exists(value, session$restoreContext$values, inherits = FALSE)) { + session$restoreContext$values[[value]] + } else { + default + } +} + +#' Compare bookmarks. +#' +#' Test if two bookmarks store identical state. +#' +#' `input` environments are compared one variable at a time and if not identical, +#' values in both bookmarks are reported. States of `datatable`s are stripped +#' of the `time` element before comparing because the time stamp is always different. +#' The contents themselves are not printed as they are large and the contents are not informative. +#' Elements present in one bookmark and absent in the other are also reported. +#' Differences are printed as messages. +#' +#' `values` environments are compared with `all.equal`. +#' +#' @section How to use: +#' Open an application, change relevant inputs (typically, all of them), and create a bookmark. +#' Then open that bookmark and immediately create a bookmark of that. +#' If restoring bookmarks occurred properly, the two bookmarks should store the same state. +#' +#' +#' @param book1,book2 bookmark directories stored in `shiny_bookmarks/`; +#' default to the two most recently modified directories +#' +#' @return +#' Invisible `NULL` if bookmarks are identical or if there are no bookmarks to test. +#' `FALSE` if inconsistencies are detected. +#' +#' @keywords internal +#' +bookmarks_identical <- function(book1, book2) { + if (!dir.exists("shiny_bookmarks")) { + message("no bookmark directory") + return(invisible(NULL)) + } + + ans <- TRUE + + if (missing(book1) && missing(book2)) { + dirs <- list.dirs("shiny_bookmarks", recursive = FALSE) + bookmarks_sorted <- basename(rev(dirs[order(file.mtime(dirs))])) + if (length(bookmarks_sorted) < 2L) { + message("no bookmarks to compare") + return(invisible(NULL)) + } + book1 <- bookmarks_sorted[2L] + book2 <- bookmarks_sorted[1L] + } else { + if (!dir.exists(file.path("shiny_bookmarks", book1))) stop(book1, " not found") + if (!dir.exists(file.path("shiny_bookmarks", book2))) stop(book2, " not found") + } + + book1_input <- readRDS(file.path("shiny_bookmarks", book1, "input.rds")) + book2_input <- readRDS(file.path("shiny_bookmarks", book2, "input.rds")) + + elements_common <- intersect(names(book1_input), names(book2_input)) + dt_states <- grepl("_state$", elements_common) + if (any(dt_states)) { + for (el in elements_common[dt_states]) { + book1_input[[el]][["time"]] <- NULL + book2_input[[el]][["time"]] <- NULL + } + } + + identicals <- mapply(identical, book1_input[elements_common], book2_input[elements_common]) + non_identicals <- names(identicals[!identicals]) + compares <- sprintf("$ %s:\t%s --- %s", non_identicals, book1_input[non_identicals], book2_input[non_identicals]) + if (length(compares) != 0L) { + message("common elements not identical: \n", paste(compares, collapse = "\n")) + ans <- FALSE + } + + elements_boook1 <- setdiff(names(book1_input), names(book2_input)) + if (length(elements_boook1) != 0L) { + dt_states <- grepl("_state$", elements_boook1) + if (any(dt_states)) { + for (el in elements_boook1[dt_states]) { + if (is.list(book1_input[[el]])) book1_input[[el]] <- "--- data table state ---" + } + } + excess1 <- sprintf("$ %s:\t%s", elements_boook1, book1_input[elements_boook1]) + message("elements only in book1: \n", paste(excess1, collapse = "\n")) + ans <- FALSE + } + + elements_boook2 <- setdiff(names(book2_input), names(book1_input)) + if (length(elements_boook2) != 0L) { + dt_states <- grepl("_state$", elements_boook1) + if (any(dt_states)) { + for (el in elements_boook1[dt_states]) { + if (is.list(book2_input[[el]])) book2_input[[el]] <- "--- data table state ---" + } + } + excess2 <- sprintf("$ %s:\t%s", elements_boook2, book2_input[elements_boook2]) + message("elements only in book2: \n", paste(excess2, collapse = "\n")) + ans <- FALSE + } + + book1_values <- readRDS(file.path("shiny_bookmarks", book1, "values.rds")) + book2_values <- readRDS(file.path("shiny_bookmarks", book2, "values.rds")) + + if (!isTRUE(all.equal(book1_values, book2_values))) { + message("different values detected") + message("choices for numeric filters MAY be different, see RangeFilterState$set_choices") + ans <- FALSE + } + + if (ans) message("perfect!") + invisible(NULL) +} + + +# Replacement for [base::rapply] which doesn't handle NULL values - skips the evaluation +# of the function and returns NULL for given element. +rapply2 <- function(x, f) { + if (inherits(x, "list")) { + lapply(x, rapply2, f = f) + } else { + f(x) + } +} diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index bf3fbd0c2a..611a1bcc38 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -7,75 +7,47 @@ #' is kept in the `mapping_matrix` object (which is actually a `data.frame`) #' that tracks which filters (rows) are active in which modules (columns). #' -#' @name module_filter_manager -#' #' @param id (`character(1)`) -#' `shiny` module id. -#' @param filtered_data_list (named `list`) +#' `shiny` module instance id. +#' @param datasets (named `list`) #' A list, possibly nested, of `FilteredData` objects. #' Each `FilteredData` will be served to one module in the `teal` application. #' The structure of the list must reflect the nesting of modules in tabs #' and the names of the list must match the labels of their respective modules. #' @inheritParams init -#' @return A list of `reactive`s, each holding a `teal_slices`, as returned by `filter_manager_module_srv`. -#' @keywords internal #' -NULL - -#' Filter manager modal +#' @return +#' A `list` containing: #' -#' Opens a modal containing the filter manager UI. +#' objects used by other manager modules +#' - `datasets_flat`: named list of `FilteredData` objects, +#' - `mapping_matrix`: `reactive` containing a `data.frame`, +#' - `slices_global`: `reactiveVal` containing a `teal_slices` object, #' -#' @name module_filter_manager_modal -#' @inheritParams module_filter_manager -#' @keywords internal +#' objects used for testing +#' - modules_out: `list` of `reactive`s, each holding a `teal_slices`, as returned by `filter_manager_module_srv`. +#' +#' @name module_filter_manager +#' @aliases filter_manager filter_manager_module #' -NULL - -#' @rdname module_filter_manager_modal -filter_manager_modal_ui <- function(id) { - ns <- NS(id) - tags$button( - id = ns("show"), - class = "btn action-button filter_manager_button", - title = "Show filters manager modal", - icon("gear") - ) -} - -#' @rdname module_filter_manager_modal -filter_manager_modal_srv <- function(id, filtered_data_list, filter) { - moduleServer(id, function(input, output, session) { - observeEvent(input$show, { - logger::log_trace("filter_manager_modal_srv@1 show button has been clicked.") - showModal( - modalDialog( - filter_manager_ui(session$ns("filter_manager")), - size = "l", - footer = NULL, - easyClose = TRUE - ) - ) - }) - - filter_manager_srv("filter_manager", filtered_data_list, filter) - }) -} #' @rdname module_filter_manager +#' @keywords internal +#' filter_manager_ui <- function(id) { ns <- NS(id) tags$div( class = "filter_manager_content", - tableOutput(ns("slices_table")), - snapshot_manager_ui(ns("snapshot_manager")) + tableOutput(ns("slices_table")) ) } #' @rdname module_filter_manager -filter_manager_srv <- function(id, filtered_data_list, filter) { +#' @keywords internal +#' +filter_manager_srv <- function(id, datasets, filter) { moduleServer(id, function(input, output, session) { - logger::log_trace("filter_manager_srv initializing for: { paste(names(filtered_data_list), collapse = ', ')}.") + logger::log_trace("filter_manager_srv initializing for: { paste(names(datasets), collapse = ', ')}.") is_module_specific <- isTRUE(attr(filter, "module_specific")) @@ -85,29 +57,18 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # Down there a subset that pertains to the data sets used in that module is applied and displayed. slices_global <- reactiveVal(filter) - filtered_data_list <- + datasets_flat <- if (!is_module_specific) { - # Retrieve the first FilteredData from potentially nested list. - # List of length one is named "global_filters" because that name is forbidden for a module label. - list(global_filters = unlist(filtered_data_list)[[1]]) + flatten_datasets(unlist(datasets)[[1]]) } else { - # Flatten potentially nested list of FilteredData objects while maintaining useful names. - # Simply using `unlist` would result in concatenated names. - flatten_nested <- function(x, name = NULL) { - if (inherits(x, "FilteredData")) { - setNames(list(x), name) - } else { - unlist(lapply(names(x), function(name) flatten_nested(x[[name]], name))) - } - } - flatten_nested(filtered_data_list) + flatten_datasets(datasets) } # Create mapping of filters to modules in matrix form (presented as data.frame). # Modules get NAs for filters that cannot be set for them. mapping_matrix <- reactive({ state_ids_global <- vapply(slices_global(), `[[`, character(1L), "id") - mapping_smooth <- lapply(filtered_data_list, function(x) { + mapping_smooth <- lapply(datasets_flat, function(x) { state_ids_local <- vapply(x$get_filter_state(), `[[`, character(1L), "id") state_ids_allowed <- vapply(x$get_available_teal_slices()(), `[[`, character(1L), "id") states_active <- state_ids_global %in% state_ids_local @@ -123,7 +84,6 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { mm <- mapping_matrix() mm[] <- lapply(mm, ifelse, yes = intToUtf8(9989), no = intToUtf8(10060)) mm[] <- lapply(mm, function(x) ifelse(is.na(x), intToUtf8(128306), x)) - if (!is_module_specific) colnames(mm) <- "Global Filters" # Display placeholder if no filters defined. if (nrow(mm) == 0L) { @@ -134,23 +94,25 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # Report Previewer will not be displayed. mm[names(mm) != "Report previewer"] }, - align = paste(c("l", rep("c", sum(names(filtered_data_list) != "Report previewer"))), collapse = ""), + align = paste(c("l", rep("c", sum(names(datasets_flat) != "Report previewer"))), collapse = ""), rownames = TRUE ) # Create list of module calls. - modules_out <- lapply(names(filtered_data_list), function(module_name) { + modules_out <- lapply(names(datasets_flat), function(module_name) { filter_manager_module_srv( id = module_name, - module_fd = filtered_data_list[[module_name]], + module_fd = datasets_flat[[module_name]], slices_global = slices_global ) }) - # Call snapshot manager. - snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list) - - modules_out # returned for testing purpose + list( + slices_global = slices_global, + mapping_matrix = mapping_matrix, + datasets_flat = datasets_flat, + modules_out = modules_out # returned for testing purpose + ) }) } @@ -173,7 +135,7 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { #' - to disable/enable a specific filter in a module #' - to restore saved filter settings #' - to save current filter panel settings -#' @return A `reactive` expression containing the slices active in this module. +#' @return A `reactive` expression containing a `teal_slices` with the slices active in this module. #' @keywords internal #' filter_manager_module_srv <- function(id, module_fd, slices_global) { @@ -216,3 +178,25 @@ filter_manager_module_srv <- function(id, module_fd, slices_global) { slices_module # returned for testing purpose }) } + + + +# utilities ---- + +#' Flatten potentially nested list of FilteredData objects while maintaining useful names. +#' Simply using `unlist` would result in concatenated names. +#' A single `FilteredData` will result in a list named "Global Filters" +#' because that name used in the mapping matrix display. +#' @param x `FilteredData` or a `list` thereof +#' @param name (`character(1)`) string used to name `x` in the resulting list +#' @return Unnested named list of `FilteredData` objects. +#' @keywords internal +#' @noRd +#' +flatten_datasets <- function(x, name = "Global Filters") { + if (inherits(x, "FilteredData")) { + setNames(list(x), name) + } else { + unlist(lapply(names(x), function(name) flatten_datasets(x[[name]], name))) + } +} diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 07825917ca..71f0cd22fd 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -216,19 +216,34 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi args <- c(args, filter_panel_api = filter_panel_api) } - # observe the trigger_module above to induce the module once the renderUI is triggered - observeEvent( - ignoreNULL = TRUE, - once = TRUE, - eventExpr = trigger_module(), - handlerExpr = { - module_output <- if (is_arg_used(modules$server, "id")) { - do.call(modules$server, args) - } else { - do.call(callModule, c(args, list(module = modules$server))) - } + # This function calls a module server function. + call_module <- function() { + if (is_arg_used(modules$server, "id")) { + do.call(modules$server, args) + } else { + do.call(callModule, c(args, list(module = modules$server))) } - ) + } + + # Call modules. + if (isTRUE(session$restoreContext$active)) { + # When restoring bookmark, all modules must be initialized on app start. + # Delayed module initiation (below) precludes restoring state b/c inputs do not exist when restoring occurs. + call_module() + } else if (inherits(modules, "teal_module_previewer")) { + # Report previewer must be initiated on app start for report cards to be included in bookmarks. + # When previewer is delayed, cards are bookmarked only if previewer has been initiated (visited). + call_module() + } else { + # When app starts normally, modules are initialized only when corresponding tabs are clicked. + # Observing trigger_module() induces the module only when output$data_reactive is triggered (see above). + observeEvent( + ignoreNULL = TRUE, + once = TRUE, + eventExpr = trigger_module(), + handlerExpr = call_module() + ) + } reactive(modules) }) diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 6335b2a69e..bbdfdea2f5 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -7,7 +7,7 @@ #' as well as to save it to file in order to share it with an app developer or other users, #' who in turn can upload it to their own session. #' -#' The snapshot manager is accessed through the filter manager, with the cog icon in the top right corner. +#' The snapshot manager is accessed with the camera icon in the [`wunder_bar`]. #' At the beginning of a session it presents three icons: a camera, an upload, and an circular arrow. #' Clicking the camera captures a snapshot, clicking the upload adds a snapshot from a file #' and applies the filter states therein, and clicking the arrow resets initial application state. @@ -44,7 +44,7 @@ #' This is substituted as the snapshot's `mapping` attribute and the snapshot is added to the snapshot list. #' #' To restore app state, a snapshot is retrieved from storage and rebuilt into a `teal_slices` object. -#' Then state of all `FilteredData` objects (provided in `filtered_data_list`) is cleared +#' Then state of all `FilteredData` objects (provided in `datasets`) is cleared #' and set anew according to the `mapping` attribute of the snapshot. #' The snapshot is then set as the current content of `slices_global`. #' @@ -65,30 +65,38 @@ #' a `teal_slices` object. When a snapshot is restored from file, its `app_id` is compared to that #' of the current app state and only if the match is the snapshot admitted to the session. #' -#' @param id (`character(1)`) `shiny` module id +#' @section Bookmarks: +#' An `onBookmark` callback creates a snapshot of the current filter state. +#' This is done on the app session, not the module session. +#' (The snapshot will be retrieved by `module_teal` in order to set initial app state in a restored app.) +#' Then that snapshot, and the previous snapshot history are dumped into the `values.rds` file in ``. +#' +#' @param id (`character(1)`) `shiny` module instance id. #' @param slices_global (`reactiveVal`) that contains a `teal_slices` object -#' containing all `teal_slice`s existing in the app, both active and inactive +#' containing all `teal_slice`s existing in the app, both active and inactive. #' @param mapping_matrix (`reactive`) that contains a `data.frame` representation #' of the mapping of filter state ids (rows) to modules labels (columns); -#' all columns are `logical` vectors -#' @param filtered_data_list non-nested (named `list`) that contains `FilteredData` objects +#' all columns are `logical` vectors. +#' @param datasets non-nested (named `list`) of `FilteredData` objects. #' -#' @return Nothing is returned. +#' @return `list` containing the snapshot history, where each element is an unlisted `teal_slices` object. #' -#' @name snapshot_manager_module -#' @aliases snapshot snapshot_manager +#' @name module_snapshot_manager +#' @aliases snapshot snapshot_manager snapshot_manager_module #' #' @author Aleksander Chlebowski #' -#' @rdname snapshot_manager_module + + +#' @rdname module_snapshot_manager #' @keywords internal #' snapshot_manager_ui <- function(id) { ns <- NS(id) tags$div( - class = "snapshot_manager_content", + class = "manager_content", tags$div( - class = "snapshot_table_row", + class = "manager_table_row", tags$span(tags$b("Snapshot manager")), actionLink(ns("snapshot_add"), label = NULL, icon = icon("camera"), title = "add snapshot"), actionLink(ns("snapshot_load"), label = NULL, icon = icon("upload"), title = "upload snapshot"), @@ -99,31 +107,56 @@ snapshot_manager_ui <- function(id) { ) } -#' @rdname snapshot_manager_module +#' @rdname module_snapshot_manager #' @keywords internal #' -snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_list) { +snapshot_manager_srv <- function(id, slices_global, mapping_matrix, datasets) { checkmate::assert_character(id) checkmate::assert_true(is.reactive(slices_global)) checkmate::assert_class(isolate(slices_global()), "teal_slices") checkmate::assert_true(is.reactive(mapping_matrix)) checkmate::assert_data_frame(isolate(mapping_matrix()), null.ok = TRUE) - checkmate::assert_list(filtered_data_list, types = "FilteredData", any.missing = FALSE, names = "named") + checkmate::assert_list(datasets, types = "FilteredData", any.missing = FALSE, names = "named") moduleServer(id, function(input, output, session) { + logger::log_trace("snapshot_manager_srv initializing") + + # Set up bookmarking callbacks ---- + # Register bookmark exclusions (all buttons and text fields). + setBookmarkExclude(c( + "snapshot_add", "snapshot_load", "snapshot_reset", + "snapshot_name_accept", "snaphot_file_accept", + "snapshot_name", "snapshot_file" + )) + # Add current filter state to bookmark. + # This is done on the app session because the value is restored in `module_teal` + # and we don't want to have to use this module's name space there. + app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent") + app_session$onBookmark(function(state) { + logger::log_trace("snapshot_manager_srv@onBookmark: storing filter state") + snapshot <- as.list(slices_global(), recursive = TRUE) + attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) + state$values$filter_state_on_bookmark <- snapshot + }) + # Add snapshot history to bookmark. + session$onBookmark(function(state) { + logger::log_trace("snapshot_manager_srv@onBookmark: storing snapshot and bookmark history") + state$values$snapshot_history <- snapshot_history() # isolate this? + }) + ns <- session$ns - # Store global filter states ---- + # Track global filter states ---- filter <- isolate(slices_global()) snapshot_history <- reactiveVal({ - list( - "Initial application state" = as.list(filter, recursive = TRUE) - ) + # Restore directly from bookmarked state, if applicable. + restoreValue(ns("snapshot_history"), list("Initial application state" = as.list(filter, recursive = TRUE))) }) # Snapshot current application state ---- # Name snaphsot. observeEvent(input$snapshot_add, { + logger::log_trace("snapshot_manager_srv: snapshot_add button clicked") showModal( modalDialog( textInput(ns("snapshot_name"), "Name the snapshot", width = "100%", placeholder = "Meaningful, unique name"), @@ -137,20 +170,24 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat }) # Store snaphsot. observeEvent(input$snapshot_name_accept, { + logger::log_trace("snapshot_manager_srv: snapshot_name_accept button clicked") snapshot_name <- trimws(input$snapshot_name) if (identical(snapshot_name, "")) { + logger::log_trace("snapshot_manager_srv: snapshot name rejected") showNotification( "Please name the snapshot.", type = "message" ) updateTextInput(inputId = "snapshot_name", value = "", placeholder = "Meaningful, unique name") } else if (is.element(make.names(snapshot_name), make.names(names(snapshot_history())))) { + logger::log_trace("snapshot_manager_srv: snapshot name rejected") showNotification( "This name is in conflict with other snapshot names. Please choose a different one.", type = "message" ) updateTextInput(inputId = "snapshot_name", value = "", placeholder = "Meaningful, unique name") } else { + logger::log_trace("snapshot_manager_srv: snapshot name accepted, adding snapshot") snapshot <- as.list(slices_global(), recursive = TRUE) attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) snapshot_update <- c(snapshot_history(), list(snapshot)) @@ -158,13 +195,14 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat snapshot_history(snapshot_update) removeModal() # Reopen filter manager modal by clicking button in the main application. - shinyjs::click(id = "teal-main_ui-filter_manager-show", asis = TRUE) + shinyjs::click(id = "teal-main_ui-wunder_bar-show_snapshot_manager", asis = TRUE) } }) # Upload a snapshot file ---- # Select file. observeEvent(input$snapshot_load, { + logger::log_trace("snapshot_manager_srv: snapshot_load button clicked") showModal( modalDialog( fileInput(ns("snapshot_file"), "Choose snapshot file", accept = ".json", width = "100%"), @@ -183,11 +221,14 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat }) # Store new snapshot to list and restore filter states. observeEvent(input$snaphot_file_accept, { + logger::log_trace("snapshot_manager_srv: snapshot_file_accept button clicked") snapshot_name <- trimws(input$snapshot_name) if (identical(snapshot_name, "")) { + logger::log_trace("snapshot_manager_srv: no snapshot name provided, naming after file") snapshot_name <- tools::file_path_sans_ext(input$snapshot_file$name) } if (is.element(make.names(snapshot_name), make.names(names(snapshot_history())))) { + logger::log_trace("snapshot_manager_srv: snapshot name rejected") showNotification( "This name is in conflict with other snapshot names. Please choose a different one.", type = "message" @@ -195,32 +236,37 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat updateTextInput(inputId = "snapshot_name", value = "", placeholder = "Meaningful, unique name") } else { # Restore snapshot and verify app compatibility. + logger::log_trace("snapshot_manager_srv: snapshot name accepted, loading snapshot") snapshot_state <- try(slices_restore(input$snapshot_file$datapath)) if (!inherits(snapshot_state, "modules_teal_slices")) { + logger::log_trace("snapshot_manager_srv: snapshot file corrupt") showNotification( "File appears to be corrupt.", type = "error" ) } else if (!identical(attr(snapshot_state, "app_id"), attr(slices_global(), "app_id"))) { + logger::log_trace("snapshot_manager_srv: snapshot not compatible with app") showNotification( "This snapshot file is not compatible with the app and cannot be loaded.", type = "warning" ) } else { # Add to snapshot history. + logger::log_trace("snapshot_manager_srv: snapshot loaded, adding to history") snapshot <- as.list(snapshot_state, recursive = TRUE) snapshot_update <- c(snapshot_history(), list(snapshot)) names(snapshot_update)[length(snapshot_update)] <- snapshot_name snapshot_history(snapshot_update) ### Begin simplified restore procedure. ### - mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + logger::log_trace("snapshot_manager_srv: restoring snapshot") + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) mapply( function(filtered_data, filter_ids) { filtered_data$clear_filter_states(force = TRUE) slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) filtered_data$set_filter_state(slices) }, - filtered_data = filtered_data_list, + filtered_data = datasets, filter_ids = mapping_unfolded ) slices_global(snapshot_state) @@ -233,18 +279,19 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat # Restore initial state ---- observeEvent(input$snapshot_reset, { + logger::log_trace("snapshot_manager_srv: snapshot_reset button clicked, restoring snapshot") s <- "Initial application state" ### Begin restore procedure. ### snapshot <- snapshot_history()[[s]] snapshot_state <- as.teal_slices(snapshot) - mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) mapply( function(filtered_data, filter_ids) { filtered_data$clear_filter_states(force = TRUE) slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) filtered_data$set_filter_state(slices) }, - filtered_data = filtered_data_list, + filtered_data = datasets, filter_ids = mapping_unfolded ) slices_global(snapshot_state) @@ -261,6 +308,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat divs <- reactiveValues() observeEvent(snapshot_history(), { + logger::log_trace("snapshot_manager_srv: snapshot history modified, updating snapshot list") lapply(names(snapshot_history())[-1L], function(s) { id_pickme <- sprintf("pickme_%s", make.names(s)) id_saveme <- sprintf("saveme_%s", make.names(s)) @@ -272,14 +320,14 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat ### Begin restore procedure. ### snapshot <- snapshot_history()[[s]] snapshot_state <- as.teal_slices(snapshot) - mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(datasets)) mapply( function(filtered_data, filter_ids) { filtered_data$clear_filter_states(force = TRUE) slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state) filtered_data$set_filter_state(slices) }, - filtered_data = filtered_data_list, + filtered_data = datasets, filter_ids = mapping_unfolded ) slices_global(snapshot_state) @@ -304,7 +352,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat # Create a row for the snapshot table. if (!is.element(id_rowme, names(divs))) { divs[[id_rowme]] <- tags$div( - class = "snapshot_table_row", + class = "manager_table_row", tags$span(tags$h5(s)), actionLink(inputId = ns(id_pickme), label = icon("circle-check"), title = "select"), downloadLink(outputId = ns(id_saveme), label = icon("save"), title = "save to file") @@ -315,16 +363,18 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat # Create table to display list of snapshots and their actions. output$snapshot_list <- renderUI({ - rows <- lapply(rev(reactiveValuesToList(divs)), function(d) d) + rows <- rev(reactiveValuesToList(divs)) if (length(rows) == 0L) { tags$div( - class = "snapshot_manager_placeholder", + class = "manager_placeholder", "Snapshots will appear here." ) } else { rows } }) + + snapshot_history }) } @@ -337,6 +387,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat #' @param mapping (named `list`) as stored in mapping parameter of `teal_slices` #' @param module_names (`character`) vector containing names of all modules in the app #' @return A `named_list` with one element per module, each element containing all filters applied to that module. +#' #' @keywords internal #' unfold_mapping <- function(mapping, module_names) { @@ -354,6 +405,7 @@ unfold_mapping <- function(mapping, module_names) { #' @param mapping_matrix (`data.frame`) of logical vectors where #' columns represent modules and row represent `teal_slice`s #' @return Named `list` like that in the `mapping` attribute of a `teal_slices` object. +#' #' @keywords internal #' matrix_to_mapping <- function(mapping_matrix) { diff --git a/R/module_tabs_with_filters.R b/R/module_tabs_with_filters.R index 4cf2f58fdc..a9651c7ff4 100644 --- a/R/module_tabs_with_filters.R +++ b/R/module_tabs_with_filters.R @@ -44,10 +44,10 @@ ui_tabs_with_filters <- function(id, modules, datasets, filter = teal_slices()) class = "btn action-button filter_hamburger", # see sidebar.css for style filter_hamburger href = "javascript:void(0)", onclick = "toggleFilterPanel();", # see sidebar.js - title = "Toggle filter panels", + title = "Toggle filter panel", icon("fas fa-bars") ), - filter_manager_modal_ui(ns("filter_manager")) + wunder_bar_ui(ns("wunder_bar")) ) teal_ui$children[[1]] <- tagAppendChild(teal_ui$children[[1]], filter_panel_btns) @@ -84,7 +84,7 @@ srv_tabs_with_filters <- function(id, logger::log_trace("srv_tabs_with_filters initializing the module.") is_module_specific <- isTRUE(attr(filter, "module_specific")) - manager_out <- filter_manager_modal_srv("filter_manager", filtered_data_list = datasets, filter = filter) + wunder_bar_out <- wunder_bar_srv("wunder_bar", datasets, filter, modules) active_module <- srv_nested_tabs( id = "root", diff --git a/R/module_teal.R b/R/module_teal.R index cb12b09fd8..924077a79f 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -162,8 +162,13 @@ srv_teal <- function(id, modules, teal_data_rv, filter = teal_slices()) { env$progress <- shiny::Progress$new(session) env$progress$set(0.25, message = "Setting data") + # Restore filter from bookmarked state, if applicable. + filter_restored <- restoreValue("filter_state_on_bookmark", filter) + if (!is.teal_slices(filter_restored)) { + filter_restored <- as.teal_slices(filter_restored) + } # Create list of `FilteredData` objects that reflects structure of `modules`. - modules_datasets(teal_data_rv(), modules, filter, teal_data_to_filtered_data(teal_data_rv())) + modules_datasets(teal_data_rv(), modules, filter_restored, teal_data_to_filtered_data(teal_data_rv())) }) # Replace splash / welcome screen once data is loaded ---- diff --git a/R/module_wunder_bar.R b/R/module_wunder_bar.R new file mode 100644 index 0000000000..28b245f7bb --- /dev/null +++ b/R/module_wunder_bar.R @@ -0,0 +1,93 @@ +#' Manager bar module +#' +#' Bar of buttons that open modal dialogs. +#' +#' Creates a bar of buttons that open modal dialogs where manager modules reside. +#' Currently contains three modules: +#' - [`module_filter_manager`] +#' - [`module_snapshot_manager`] +#' - [`module_bookmark_manager`] +#' +#' The bar is placed in the `teal` app UI, next to the filter panel hamburger. +#' +#' @name module_wunder_bar +#' @aliases wunder_bar wunder_bar_module +#' +#' @inheritParams module_tabs_with_filters +#' +#' @return Nothing is returned. + +#' @rdname module_wunder_bar +#' @keywords internal +wunder_bar_ui <- function(id) { + ns <- NS(id) + rev( + tagList( + title = "", + tags$button( + id = ns("show_filter_manager"), + class = "btn action-button wunder_bar_button", + title = "View filter mapping", + suppressMessages(icon("solid fa-grip")) + ), + tags$button( + id = ns("show_snapshot_manager"), + class = "btn action-button wunder_bar_button", + title = "Manage filter state snapshots", + icon("camera") + ), + bookmark_manager_ui(ns("bookmark_manager")) + ) + ) +} + +#' @rdname module_wunder_bar +#' @keywords internal +wunder_bar_srv <- function(id, datasets, filter, modules) { + moduleServer(id, function(input, output, session) { + logger::log_trace("wunder_bar_srv initializing") + + setBookmarkExclude(c("show_filter_manager", "show_bookmark_manager", "show_bookmark_manager")) + + ns <- session$ns + + observeEvent(input$show_filter_manager, { + logger::log_trace("wunder_bar_srv@1 show_filter_manager button has been clicked.") + showModal( + modalDialog( + filter_manager_ui(ns("filter_manager")), + class = "filter_manager_modal", + size = "l", + footer = NULL, + easyClose = TRUE + ) + ) + }) + + observeEvent(input$show_snapshot_manager, { + logger::log_trace("wunder_bar_srv@1 show_snapshot_manager button has been clicked.") + showModal( + modalDialog( + snapshot_manager_ui(ns("snapshot_manager")), + class = "snapshot_manager_modal", + size = "m", + footer = NULL, + easyClose = TRUE + ) + ) + }) + + filter_manager_results <- filter_manager_srv( + id = "filter_manager", + datasets = datasets, + filter = filter + ) + snapshot_history <- snapshot_manager_srv( + id = "snapshot_manager", + slices_global = filter_manager_results$slices_global, + mapping_matrix = filter_manager_results$mapping_matrix, + datasets = filter_manager_results$datasets_flat + ) + bookmark_manager_srv(id = "bookmark_manager", modules = modules) + }) +} diff --git a/R/modules.R b/R/modules.R index 751d34fb74..4ec76a2ca7 100644 --- a/R/modules.R +++ b/R/modules.R @@ -421,3 +421,21 @@ module_labels <- function(modules) { modules$label } } + +#' Retrieve `teal_bookmarkable` attribute from `teal_modules` +#' +#' @param modules (`teal_modules` or `teal_module`) object +#' @return named list of the same structure as `modules` with `TRUE` or `FALSE` values indicating +#' whether the module is bookmarkable. +#' @keywords internal +modules_bookmarkable <- function(modules) { + checkmate::assert_multi_class(modules, c("teal_modules", "teal_module")) + if (inherits(modules, "teal_modules")) { + setNames( + lapply(modules$children, modules_bookmarkable), + vapply(modules$children, `[[`, "label", FUN.VALUE = character(1)) + ) + } else { + attr(modules, "teal_bookmarkable", exact = TRUE) + } +} diff --git a/R/reporter_previewer_module.R b/R/reporter_previewer_module.R index eeba694a7f..ba84f3173f 100644 --- a/R/reporter_previewer_module.R +++ b/R/reporter_previewer_module.R @@ -43,5 +43,6 @@ reporter_previewer_module <- function(label = "Report previewer", server_args = # This is to prevent another module being labeled "Report previewer". class(module) <- c("teal_module_previewer", class(module)) module$label <- label + attr(module, "teal_bookmarkable") <- TRUE module } diff --git a/inst/WORDLIST b/inst/WORDLIST index bfba486c17..20dae96097 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,26 +1,30 @@ Biomarker +bookmarkable CDISC -Forkers -Hoffmann -MAEs -ORCID -Reproducibility -TLG -UI -UIs -UX cloneable customizable +dialog favicon favicons +Forkers funder +Hoffmann +href +JSON +MAEs omics +ORCID pre programmatically repo reproducibility +Reproducibility summarization tabsetted themer theming +TLG +UI +UIs uncheck +UX diff --git a/inst/css/sidebar.css b/inst/css/sidebar.css index f0d30a0677..60a9380f7d 100644 --- a/inst/css/sidebar.css +++ b/inst/css/sidebar.css @@ -1,13 +1,26 @@ /* teal sidebar css */ -.filter_hamburger, .filter_manager_button { +.filter_hamburger, +.wunder_bar_button { font-size: 16px; padding: 8px !important; float: right !important; background-color: transparent !important; } +.badge-count { + padding-left: 1em; + padding-right: 1em; + -webkit-border-radius: 1em; + -moz-border-radius: 1em; + border-radius: 1em; + font-size: 0.7em; + padding: 0 .5em; + vertical-align: top; + margin-left: -1em; +} + /* disable any anchor with the disabled class */ a.disabled { pointer-events: none; @@ -17,29 +30,25 @@ a.disabled { .filter_manager_content { display: flex; - flex-direction: row; flex-wrap: wrap; - align-items: flex-start; justify-content: center; } -.filter_manager_content > * { - flex: 1 1 auto; - padding: 0em 1em; - width: min-content; -} -.snapshot_table_row { +.manager_table_row { display: flex; flex-direction: row; align-items: center; } -.snapshot_table_row *:first-child { + +.manager_table_row *:first-child { flex: 1 1 80%; } -.snapshot_table_row * + * { - flex: 1 0 50px; - padding: 0em 1em; + +.manager_table_row *+* { + flex: 0 0 0px; + padding: 0em 1.5em; } -.snapshot_manager_placeholder { + +.manager_placeholder { margin-top: 1em; } diff --git a/man/bookmarks_identical.Rd b/man/bookmarks_identical.Rd new file mode 100644 index 0000000000..a61169362f --- /dev/null +++ b/man/bookmarks_identical.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_bookmark_manager.R +\name{bookmarks_identical} +\alias{bookmarks_identical} +\title{Compare bookmarks.} +\usage{ +bookmarks_identical(book1, book2) +} +\arguments{ +\item{book1, book2}{bookmark directories stored in \verb{shiny_bookmarks/}; +default to the two most recently modified directories} +} +\value{ +Invisible \code{NULL} if bookmarks are identical or if there are no bookmarks to test. +\code{FALSE} if inconsistencies are detected. +} +\description{ +Test if two bookmarks store identical state. +} +\details{ +\code{input} environments are compared one variable at a time and if not identical, +values in both bookmarks are reported. States of \code{datatable}s are stripped +of the \code{time} element before comparing because the time stamp is always different. +The contents themselves are not printed as they are large and the contents are not informative. +Elements present in one bookmark and absent in the other are also reported. +Differences are printed as messages. + +\code{values} environments are compared with \code{all.equal}. +} +\section{How to use}{ + +Open an application, change relevant inputs (typically, all of them), and create a bookmark. +Then open that bookmark and immediately create a bookmark of that. +If restoring bookmarks occurred properly, the two bookmarks should store the same state. +} + +\keyword{internal} diff --git a/man/filter_manager_module_srv.Rd b/man/filter_manager_module_srv.Rd index e00afd6e38..e00216a5d1 100644 --- a/man/filter_manager_module_srv.Rd +++ b/man/filter_manager_module_srv.Rd @@ -22,7 +22,7 @@ stores \code{teal_slices} with all available filters; allows the following actio }} } \value{ -A \code{reactive} expression containing the slices active in this module. +A \code{reactive} expression containing a \code{teal_slices} with the slices active in this module. } \description{ Tracks filter states in a single module. diff --git a/man/init.Rd b/man/init.Rd index 991a7db62c..2f0e34d2f5 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -43,7 +43,7 @@ string specifying the \code{shiny} module id in cases it is used as a \code{shin rather than a standalone \code{shiny} app. This is a legacy feature.} } \value{ -Named list with server and UI functions. +Named list containing server and UI functions. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} diff --git a/man/module_bookmark_manager.Rd b/man/module_bookmark_manager.Rd new file mode 100644 index 0000000000..ca7a892cb5 --- /dev/null +++ b/man/module_bookmark_manager.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_bookmark_manager.R +\name{module_bookmark_manager} +\alias{module_bookmark_manager} +\alias{bookmark_manager_ui} +\alias{bookmark} +\alias{bookmark_manager} +\alias{bookmark_manager_module} +\alias{bookmark_manager_srv} +\title{App state management.} +\usage{ +bookmark_manager_ui(id) + +bookmark_manager_srv(id, modules) +} +\arguments{ +\item{id}{(\code{character(1)}) +module id} + +\item{modules}{(\code{teal_modules}) object containing the output modules which +will be displayed in the \code{teal} application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for +more details.} +} +\value{ +Invisible \code{NULL}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Capture and restore the global (app) input state. +} +\details{ +This module introduces bookmarks into \code{teal} apps: the \code{shiny} bookmarking mechanism becomes enabled +and server-side bookmarks can be created. + +The bookmark manager presents a button with the bookmark icon and is placed in the \code{\link{wunder_bar}}. +When clicked, the button creates a bookmark and opens a modal which displays the bookmark URL. + +\code{teal} does not guarantee that all modules (\code{teal_module} objects) are bookmarkable. +Those that are, have a \code{teal_bookmarkable} attribute set to \code{TRUE}. If any modules are not bookmarkable, +the bookmark manager modal displays a warning and the bookmark button displays a flag. +In order to communicate that a external module is bookmarkable, the module developer +should set the \code{teal_bookmarkable} attribute to \code{TRUE}. +} +\section{Server logic}{ + +A bookmark is a URL that contains the app address with a \verb{/?_state_id_=} suffix. +\verb{} is a directory created on the server, where the state of the application is saved. +Accessing the bookmark URL opens a new session of the app that starts in the previously saved state. +} + +\section{Note}{ + +To enable bookmarking use either: +\itemize{ +\item \code{shiny} app by using \code{shinyApp(..., enableBookmarking = "server")} (not supported in \code{shinytest2}) +\item set \code{options(shiny.bookmarkStore = "server")} before running the app +} +} + +\keyword{internal} diff --git a/man/module_filter_manager.Rd b/man/module_filter_manager.Rd index 3d487118fd..1d0e5af2ef 100644 --- a/man/module_filter_manager.Rd +++ b/man/module_filter_manager.Rd @@ -3,18 +3,20 @@ \name{module_filter_manager} \alias{module_filter_manager} \alias{filter_manager_ui} +\alias{filter_manager} +\alias{filter_manager_module} \alias{filter_manager_srv} \title{Manage multiple \code{FilteredData} objects} \usage{ filter_manager_ui(id) -filter_manager_srv(id, filtered_data_list, filter) +filter_manager_srv(id, datasets, filter) } \arguments{ \item{id}{(\code{character(1)}) -\code{shiny} module id.} +\code{shiny} module instance id.} -\item{filtered_data_list}{(named \code{list}) +\item{datasets}{(named \code{list}) A list, possibly nested, of \code{FilteredData} objects. Each \code{FilteredData} will be served to one module in the \code{teal} application. The structure of the list must reflect the nesting of modules in tabs @@ -24,7 +26,19 @@ and the names of the list must match the labels of their respective modules.} Specifies the initial filter using \code{\link[=teal_slices]{teal_slices()}}.} } \value{ -A list of \code{reactive}s, each holding a \code{teal_slices}, as returned by \code{filter_manager_module_srv}. +A \code{list} containing: + +objects used by other manager modules +\itemize{ +\item \code{datasets_flat}: named list of \code{FilteredData} objects, +\item \code{mapping_matrix}: \code{reactive} containing a \code{data.frame}, +\item \code{slices_global}: \code{reactiveVal} containing a \code{teal_slices} object, +} + +objects used for testing +\itemize{ +\item modules_out: \code{list} of \code{reactive}s, each holding a \code{teal_slices}, as returned by \code{filter_manager_module_srv}. +} } \description{ Oversee filter states across the entire application. diff --git a/man/module_filter_manager_modal.Rd b/man/module_filter_manager_modal.Rd deleted file mode 100644 index e3f5c5225f..0000000000 --- a/man/module_filter_manager_modal.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_filter_manager.R -\name{module_filter_manager_modal} -\alias{module_filter_manager_modal} -\alias{filter_manager_modal_ui} -\alias{filter_manager_modal_srv} -\title{Filter manager modal} -\usage{ -filter_manager_modal_ui(id) - -filter_manager_modal_srv(id, filtered_data_list, filter) -} -\arguments{ -\item{id}{(\code{character(1)}) -\code{shiny} module id.} - -\item{filtered_data_list}{(named \code{list}) -A list, possibly nested, of \code{FilteredData} objects. -Each \code{FilteredData} will be served to one module in the \code{teal} application. -The structure of the list must reflect the nesting of modules in tabs -and the names of the list must match the labels of their respective modules.} - -\item{filter}{(\code{teal_slices}) -Specifies the initial filter using \code{\link[=teal_slices]{teal_slices()}}.} -} -\description{ -Opens a modal containing the filter manager UI. -} -\keyword{internal} diff --git a/man/snapshot_manager_module.Rd b/man/module_snapshot_manager.Rd similarity index 84% rename from man/snapshot_manager_module.Rd rename to man/module_snapshot_manager.Rd index 307abaf06a..80aa9fb44b 100644 --- a/man/snapshot_manager_module.Rd +++ b/man/module_snapshot_manager.Rd @@ -1,31 +1,32 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/module_snapshot_manager.R -\name{snapshot_manager_module} -\alias{snapshot_manager_module} +\name{module_snapshot_manager} +\alias{module_snapshot_manager} \alias{snapshot_manager_ui} \alias{snapshot} \alias{snapshot_manager} +\alias{snapshot_manager_module} \alias{snapshot_manager_srv} \title{Filter state snapshot management} \usage{ snapshot_manager_ui(id) -snapshot_manager_srv(id, slices_global, mapping_matrix, filtered_data_list) +snapshot_manager_srv(id, slices_global, mapping_matrix, datasets) } \arguments{ -\item{id}{(\code{character(1)}) \code{shiny} module id} +\item{id}{(\code{character(1)}) \code{shiny} module instance id.} \item{slices_global}{(\code{reactiveVal}) that contains a \code{teal_slices} object -containing all \code{teal_slice}s existing in the app, both active and inactive} +containing all \code{teal_slice}s existing in the app, both active and inactive.} \item{mapping_matrix}{(\code{reactive}) that contains a \code{data.frame} representation of the mapping of filter state ids (rows) to modules labels (columns); -all columns are \code{logical} vectors} +all columns are \code{logical} vectors.} -\item{filtered_data_list}{non-nested (named \code{list}) that contains \code{FilteredData} objects} +\item{datasets}{non-nested (named \code{list}) of \code{FilteredData} objects.} } \value{ -Nothing is returned. +\code{list} containing the snapshot history, where each element is an unlisted \code{teal_slices} object. } \description{ Capture and restore snapshots of the global (app) filter state. @@ -36,7 +37,7 @@ Snapshots allow the user to save the current filter state of the application for as well as to save it to file in order to share it with an app developer or other users, who in turn can upload it to their own session. -The snapshot manager is accessed through the filter manager, with the cog icon in the top right corner. +The snapshot manager is accessed with the camera icon in the \code{\link{wunder_bar}}. At the beginning of a session it presents three icons: a camera, an upload, and an circular arrow. Clicking the camera captures a snapshot, clicking the upload adds a snapshot from a file and applies the filter states therein, and clicking the arrow resets initial application state. @@ -76,7 +77,7 @@ when passed to the \code{mapping} argument of \code{\link[=teal_slices]{teal_sli This is substituted as the snapshot's \code{mapping} attribute and the snapshot is added to the snapshot list. To restore app state, a snapshot is retrieved from storage and rebuilt into a \code{teal_slices} object. -Then state of all \code{FilteredData} objects (provided in \code{filtered_data_list}) is cleared +Then state of all \code{FilteredData} objects (provided in \code{datasets}) is cleared and set anew according to the \code{mapping} attribute of the snapshot. The snapshot is then set as the current content of \code{slices_global}. @@ -100,6 +101,14 @@ a \code{teal_slices} object. When a snapshot is restored from file, its \code{ap of the current app state and only if the match is the snapshot admitted to the session. } +\section{Bookmarks}{ + +An \code{onBookmark} callback creates a snapshot of the current filter state. +This is done on the app session, not the module session. +(The snapshot will be retrieved by \code{module_teal} in order to set initial app state in a restored app.) +Then that snapshot, and the previous snapshot history are dumped into the \code{values.rds} file in \verb{}. +} + \author{ Aleksander Chlebowski } diff --git a/man/module_wunder_bar.Rd b/man/module_wunder_bar.Rd new file mode 100644 index 0000000000..6e4f5b8fa1 --- /dev/null +++ b/man/module_wunder_bar.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_wunder_bar.R +\name{module_wunder_bar} +\alias{module_wunder_bar} +\alias{wunder_bar_ui} +\alias{wunder_bar} +\alias{wunder_bar_module} +\alias{wunder_bar_srv} +\title{Manager bar module} +\usage{ +wunder_bar_ui(id) + +wunder_bar_srv(id, datasets, filter, modules) +} +\arguments{ +\item{id}{(\code{character(1)}) +module id} + +\item{datasets}{(named \code{list} of \code{FilteredData}) +object to store filter state and filtered datasets, shared across modules. For more +details see \code{\link[teal.slice:FilteredData]{teal.slice::FilteredData}}. Structure of the list must be the same as structure +of the \code{modules} argument and list names must correspond to the labels in \code{modules}. +When filter is not module-specific then list contains the same object in all elements.} + +\item{filter}{(\code{teal_slices}) +Specifies the initial filter using \code{\link[=teal_slices]{teal_slices()}}.} + +\item{modules}{(\code{teal_modules}) object containing the output modules which +will be displayed in the \code{teal} application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for +more details.} +} +\value{ +Nothing is returned. +} +\description{ +Bar of buttons that open modal dialogs. +} +\details{ +Creates a bar of buttons that open modal dialogs where manager modules reside. +Currently contains three modules: +\itemize{ +\item \code{\link{module_filter_manager}} +\item \code{\link{module_snapshot_manager}} +\item \code{\link{module_bookmark_manager}} +} + +The bar is placed in the \code{teal} app UI, next to the filter panel hamburger. +} +\keyword{internal} diff --git a/man/modules_bookmarkable.Rd b/man/modules_bookmarkable.Rd new file mode 100644 index 0000000000..2b33647a2b --- /dev/null +++ b/man/modules_bookmarkable.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modules.R +\name{modules_bookmarkable} +\alias{modules_bookmarkable} +\title{Retrieve \code{teal_bookmarkable} attribute from \code{teal_modules}} +\usage{ +modules_bookmarkable(modules) +} +\arguments{ +\item{modules}{(\code{teal_modules} or \code{teal_module}) object} +} +\value{ +named list of the same structure as \code{modules} with \code{TRUE} or \code{FALSE} values indicating +whether the module is bookmarkable. +} +\description{ +Retrieve \code{teal_bookmarkable} attribute from \code{teal_modules} +} +\keyword{internal} diff --git a/man/restoreValue.Rd b/man/restoreValue.Rd new file mode 100644 index 0000000000..ebfce5b446 --- /dev/null +++ b/man/restoreValue.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_bookmark_manager.R +\name{restoreValue} +\alias{restoreValue} +\title{Restore value from bookmark.} +\usage{ +restoreValue(value, default) +} +\arguments{ +\item{value}{(\code{character(1)}) name of value to restore} + +\item{default}{fallback value} +} +\value{ +In an application restored from a server-side bookmark, +the variable specified by \code{value} from the \code{values} environment. +Otherwise \code{default}. +} +\description{ +Get value from bookmark or return default. +} +\details{ +Bookmarks can store not only inputs but also arbitrary values. +These values are stored by \code{onBookmark} callbacks and restored by \code{onBookmarked} callbacks, +and they are placed in the \code{values} environment in the \code{session$restoreContext} field. +Using \code{teal_data_module} makes it impossible to run the callbacks +because the app becomes ready before modules execute and callbacks are registered. +In those cases the stored values can still be recovered from the \code{session} object directly. + +Note that variable names in the \code{values} environment are prefixed with module name space names, +therefore, when using this function in modules, \code{value} must be run through the name space function. +} +\keyword{internal} diff --git a/tests/testthat/test-filter_manager.R b/tests/testthat/test-filter_manager.R index 9cc0bd8d91..67550e3fa6 100644 --- a/tests/testthat/test-filter_manager.R +++ b/tests/testthat/test-filter_manager.R @@ -41,11 +41,11 @@ testthat::test_that("filter_manager_srv initializes properly processes input arg app = filter_manager_srv, args = list( id = "test", - filtered_data_list = filtered_data_list, + datasets = filtered_data_list, filter = filter_global ), expr = { - testthat::expect_named(filtered_data_list, c("m1", "m2", "m3")) + testthat::expect_named(datasets_flat, c("m1", "m2", "m3")) testthat::expect_identical(slices_global(), filter) } @@ -56,11 +56,11 @@ testthat::test_that("filter_manager_srv initializes properly processes input arg app = filter_manager_srv, args = list( id = "test", - filtered_data_list = filtered_data_list, + datasets = filtered_data_list, filter = filter_modular ), expr = { - testthat::expect_named(filtered_data_list, "global_filters") + testthat::expect_named(datasets_flat, "Global Filters") testthat::expect_identical(slices_global(), filter) } diff --git a/tests/testthat/test-shinytest2-module_bookmark_manager.R b/tests/testthat/test-shinytest2-module_bookmark_manager.R new file mode 100644 index 0000000000..237e53a99b --- /dev/null +++ b/tests/testthat/test-shinytest2-module_bookmark_manager.R @@ -0,0 +1,57 @@ +testthat::test_that("bookmark_manager_button is not rendered by default", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module"), + options = options() + ) + on.exit(app$stop()) + testthat::expect_null( + app$get_html(".bookmark_manager_button") + ) +}) + + +testthat::test_that("bookmark_manager_button is not rendered when enableBookmarking = 'url'", { + skip_if_too_deep(5) + options(shiny.bookmarkStore = "url") + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module"), + options = options() + ) + on.exit(app$stop()) + testthat::expect_null( + app$get_html(".bookmark_manager_button") + ) +}) + + +testthat::test_that("bookmark_manager_button is rendered when enableBookmarking = 'server'", { + skip_if_too_deep(5) + options(shiny.bookmarkStore = "server") + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module"), + options = options() + ) + on.exit(app$stop()) + testthat::expect_true(!is.null(app$get_html(".bookmark_manager_button"))) +}) + +testthat::test_that("bookmark_manager_button shows modal with url containing state_id when clicked", { + skip_if_too_deep(5) + options(shiny.bookmarkStore = "server") + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module"), + options = options() + ) + bookmark_button_id <- app$get_attr(".bookmark_manager_button", "id") + app$click(bookmark_button_id) + + testthat::expect_match( + rvest::html_text(app$get_html_rvest("div[id$=bookmark_modal] pre")), + "_state_id_" + ) +}) diff --git a/tests/testthat/test-shinytest2-wunder_bar.R b/tests/testthat/test-shinytest2-wunder_bar.R new file mode 100644 index 0000000000..dedb7c244d --- /dev/null +++ b/tests/testthat/test-shinytest2-wunder_bar.R @@ -0,0 +1,36 @@ +testthat::test_that("wunder_bar_srv clicking filter icon opens filter-manager modal", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module") + ) + + filter_manager_btn_id <- grep( + "filter_manager", + x = app$get_attr(".wunder_bar_button", "id"), + value = TRUE + ) + + testthat::expect_true(is.null(app$get_text(".filter_manager_modal"))) + app$click(filter_manager_btn_id) + testthat::expect_true(!is.null(app$get_text(".filter_manager_modal"))) +}) + + +testthat::test_that("wunder_bar_srv clicking snapshot icon opens snapshot-manager modal", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module") + ) + + snapshot_manager_btn_id <- grep( + "snapshot_manager", + x = app$get_attr(".wunder_bar_button", "id"), + value = TRUE + ) + + testthat::expect_true(is.null(app$get_text(".snapshot_manager_modal"))) + app$click(snapshot_manager_btn_id) + testthat::expect_true(!is.null(app$get_text(".snapshot_manager_modal"))) +}) diff --git a/tests/testthat/test-snapshot_manager.R b/tests/testthat/test-snapshot_manager.R index 800ece54b3..4954fe4b41 100644 --- a/tests/testthat/test-snapshot_manager.R +++ b/tests/testthat/test-snapshot_manager.R @@ -14,12 +14,12 @@ testthat::test_that("snapshot manager holds initial state in history", { fd1 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris))) fd2 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris), mtcars = list(dataset = mtcars))) fd3 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris), women = list(dataset = women))) - filtered_data_list <- list(m1 = fd1, m2 = fd2, m3 = fd3) + datasets_flat <- list(m1 = fd1, m2 = fd2, m3 = fd3) slices_global <- reactiveVal(shiny::isolate(filter)) mapping_matrix <- reactive({ - module_states <- lapply(filtered_data_list, function(x) x$get_filter_state()) + module_states <- lapply(datasets_flat, function(x) x$get_filter_state()) mapping_ragged <- lapply(module_states, function(x) vapply(x, `[[`, character(1L), "id")) all_names <- vapply(slices_global(), `[[`, character(1L), "id") mapping_smooth <- lapply(mapping_ragged, is.element, el = all_names) @@ -32,7 +32,7 @@ testthat::test_that("snapshot manager holds initial state in history", { id = "test", slices_global = slices_global, mapping_matrix = mapping_matrix, - filtered_data_list = filtered_data_list + datasets = datasets_flat ), expr = { testthat::expect_true("Initial application state" %in% names(snapshot_history())) From 65beda833d1fb590cce86999067156edf55ce038 Mon Sep 17 00:00:00 2001 From: chlebowa Date: Thu, 28 Mar 2024 16:17:02 +0000 Subject: [PATCH 32/35] [skip actions] Bump version to 0.15.2.9019 --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 84f77760f8..1d4bb0657f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9018 -Date: 2024-03-27 +Version: 0.15.2.9019 +Date: 2024-03-28 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), diff --git a/NEWS.md b/NEWS.md index 401182f502..25ba451511 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9018 +# teal 0.15.2.9019 ### Miscellaneous * Filter mapping display is no longer coupled to the snapshot manager. From 59cae26c6fd00effe14a91d4d93cc9f4a7f3f5e9 Mon Sep 17 00:00:00 2001 From: chlebowa Date: Thu, 28 Mar 2024 16:17:55 +0000 Subject: [PATCH 33/35] [skip ci] Update WORDLIST --- inst/WORDLIST | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/inst/WORDLIST b/inst/WORDLIST index 20dae96097..e8716e7cb5 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,30 +1,28 @@ Biomarker -bookmarkable CDISC +Forkers +Hoffmann +MAEs +ORCID +Reproducibility +TLG +UI +UIs +UX +bookmarkable cloneable customizable -dialog +dialogs favicon favicons -Forkers funder -Hoffmann -href -JSON -MAEs omics -ORCID pre programmatically repo reproducibility -Reproducibility summarization tabsetted themer theming -TLG -UI -UIs uncheck -UX From 699b7377f40bfccce66a30df376d7a64364a6812 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 1 Apr 2024 12:24:37 +0200 Subject: [PATCH 34/35] Adds extra parameters to methods that call `TealAppDriver$set_inputs` (shinytest2) (#1175) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit # Pull Request Fixes #1169 ### Changes description - Added upstream parameters on `TealAppDriver` methods that use `AppDriver$set_inputs` --------- Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: kartikeya kirar Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> --- R/TealAppDriver.R | 41 ++++++++++++++++++++++++++++++++--------- man/TealAppDriver.Rd | 12 ++++++++---- 2 files changed, 40 insertions(+), 13 deletions(-) diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R index c3426d4965..31fe701648 100644 --- a/R/TealAppDriver.R +++ b/R/TealAppDriver.R @@ -221,14 +221,16 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. #' #' @param input_id (character) The shiny input id to get the value from. #' @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_module_input = function(input_id, value) { + 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 + value, + ... ) invisible(self) }, @@ -291,9 +293,10 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. #' #' @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. + #' @param ... Additional arguments to be passed to `shinytest2::AppDriver$set_inputs` #' #' @return The `TealAppDriver` object invisibly. - add_filter_var = function(dataset_name, var_name) { + add_filter_var = function(dataset_name, var_name, ...) { checkmate::check_string(dataset_name) checkmate::check_string(var_name) self$set_input( @@ -302,7 +305,8 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. self$active_filters_ns(), dataset_name ), - var_name + var_name, + ... ) invisible(self) }, @@ -349,10 +353,13 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. #' @param dataset_name (character) The name of the dataset to set the filter value for. #' @param var_name (character) The name of the variable to set the filter value for. #' @param input The value to set the filter to. - #' @param type (character) The type of the filter to get the value from. Default is `categorical`. + #' @param ... Additional arguments to be passed to `shinytest2::AppDriver$set_inputs` #' #' @return The `TealAppDriver` object invisibly. - set_active_filter_selection = function(dataset_name, var_name, input) { + set_active_filter_selection = function(dataset_name, + var_name, + input, + ...) { checkmate::check_string(dataset_name) checkmate::check_string(var_name) checkmate::check_string(input) @@ -392,16 +399,32 @@ TealAppDriver <- R6::R6Class( # nolint: object_name. if (identical(slices_suffix, "selection_manual")) { checkmate::assert_numeric(input, len = 2) + + dots <- rlang::list2(...) + checkmate::assert_choice(dots$priority_, formals(self$set_inputs)[["priority_"]], null.ok = TRUE) + checkmate::assert_flag(dots$wait_, null.ok = TRUE) + self$run_js( sprintf( - "Shiny.setInputValue('%s:sw.numericRange', [%f, %f], {priority: 'event'})", + "Shiny.setInputValue('%s:sw.numericRange', [%f, %f], {priority: '%s'})", slices_input_id, input[[1]], - input[[2]] + input[[2]], + priority_ = ifelse(is.null(dots$priority_), "input", dots$priority_) ) ) + + if (isTRUE(dots$wait_) || is.null(dots$wait_)) { + self$wait_for_idle( + timeout = if (is.null(dots$timeout_)) rlang::missing_arg() else dots$timeout_ + ) + } } else if (identical(slices_suffix, "selection")) { - self$set_input(slices_input_id, input) + self$set_input( + slices_input_id, + input, + ... + ) } else { stop("Filter selection set not supported for this slice.") } diff --git a/man/TealAppDriver.Rd b/man/TealAppDriver.Rd index 0d2e8bb556..e78702a93d 100644 --- a/man/TealAppDriver.Rd +++ b/man/TealAppDriver.Rd @@ -354,7 +354,7 @@ The value of the shiny output. 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{
    }} +\if{html}{\out{
    }}\preformatted{TealAppDriver$set_module_input(input_id, value, ...)}\if{html}{\out{
    }} } \subsection{Arguments}{ @@ -363,6 +363,8 @@ This function will only set inputs in the name space of the current active teal \item{\code{input_id}}{(character) The shiny input id to get the value from.} \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{}} } @@ -404,7 +406,7 @@ If \code{NULL}, the filter variables for all the datasets will be returned in a \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{
    }} +\if{html}{\out{
    }}\preformatted{TealAppDriver$add_filter_var(dataset_name, var_name, ...)}\if{html}{\out{
    }} } \subsection{Arguments}{ @@ -413,6 +415,8 @@ Add a new variable from the dataset to be filtered. \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.} + +\item{\code{...}}{Additional arguments to be passed to \code{shinytest2::AppDriver$set_inputs}} } \if{html}{\out{}} } @@ -450,7 +454,7 @@ The \code{TealAppDriver} object invisibly. \subsection{Method \code{set_active_filter_selection()}}{ Set the active filter values for a variable of a dataset in the active filter variable panel. \subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealAppDriver$set_active_filter_selection(dataset_name, var_name, input)}\if{html}{\out{
    }} +\if{html}{\out{
    }}\preformatted{TealAppDriver$set_active_filter_selection(dataset_name, var_name, input, ...)}\if{html}{\out{
    }} } \subsection{Arguments}{ @@ -462,7 +466,7 @@ Set the active filter values for a variable of a dataset in the active filter va \item{\code{input}}{The value to set the filter to.} -\item{\code{type}}{(character) The type of the filter to get the value from. Default is \code{categorical}.} +\item{\code{...}}{Additional arguments to be passed to \code{shinytest2::AppDriver$set_inputs}} } \if{html}{\out{}} } From af17c0790729bdf1b01aa2a627753b5f2250b97a Mon Sep 17 00:00:00 2001 From: vedhav Date: Mon, 1 Apr 2024 10:25:31 +0000 Subject: [PATCH 35/35] [skip actions] Bump version to 0.15.2.9020 --- .pre-commit-config.yaml | 2 +- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index eaf44b622f..1171b71506 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -6,7 +6,7 @@ default_language_version: python: python3 repos: - repo: https://github.com/lorenzwalthert/precommit - rev: v0.4.0 + rev: v0.4.1 hooks: - id: style-files name: Style code with `styler` diff --git a/DESCRIPTION b/DESCRIPTION index 1d4bb0657f..61bb0f2a05 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9019 -Date: 2024-03-28 +Version: 0.15.2.9020 +Date: 2024-04-01 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), diff --git a/NEWS.md b/NEWS.md index 25ba451511..040c7a29c7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9019 +# teal 0.15.2.9020 ### Miscellaneous * Filter mapping display is no longer coupled to the snapshot manager.