diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index a9ce552ed9..3df4102110 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/.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 729023d073..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.9003 -Date: 2024-03-08 +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")), @@ -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 @@ -60,6 +60,8 @@ Suggests: MultiAssayExperiment, R6, rmarkdown (>= 2.19), + rvest, + shinytest2, shinyvalidate, testthat (>= 3.1.5), withr (>= 2.1.0), @@ -84,18 +86,21 @@ LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.1 Collate: + 'TealAppDriver.R' 'dummy_functions.R' 'get_rcode_utils.R' 'include_css_js.R' '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 2e6fb826dd..040c7a29c7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,7 @@ -# teal 0.15.2.9003 +# teal 0.15.2.9020 + +### Miscellaneous +* Filter mapping display is no longer coupled to the snapshot manager. # teal 0.15.2 diff --git a/R/TealAppDriver.R b/R/TealAppDriver.R new file mode 100644 index 0000000000..31fe701648 --- /dev/null +++ b/R/TealAppDriver.R @@ -0,0 +1,557 @@ +# 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 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, + filter = teal_slices(), + 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 + private$filter <- filter + app <- init( + data = data, + modules = modules, + filter = filter, + title = title, + 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( + 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. + #' 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() + 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 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. + 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. + #' @param ... Additional arguments to be passed to `shinytest2::AppDriver$set_inputs` + #' + #' @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 <- 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() + ) + ) + ) + + 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) { + 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)) { + return(active_filters) + } + active_filters[[dataset_name]] + }, + #' @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. + #' @param ... Additional arguments to be passed to `shinytest2::AppDriver$set_inputs` + #' + #' @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 ... 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, + ...) { + checkmate::check_string(dataset_name) + checkmate::check_string(var_name) + checkmate::check_string(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) + + 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: '%s'})", + slices_input_id, + input[[1]], + 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, + ... + ) + } else { + stop("Filter selection set not supported for this slice.") + } + + invisible(self) + }, + #' @description + #' Extract `html` attribute (found by a `selector`). + #' + #' @param selector (`character(1)`) specifying the selector to be used to get the content of a specific node. + #' @param attribute (`character(1)`) name of an attribute to retrieve from a node specified by `selector`. + #' + #' @return The `character` vector. + get_attr = function(selector, attribute) { + self$get_html_rvest("html") %>% + rvest::html_nodes(selector) %>% + rvest::html_attr(attribute) + }, + #' @description + #' Wrapper around `get_html` that passes the output directly to `rvest::read_html`. + #' + #' @param selector `(character(1))` passed to `get_html`. + #' + #' @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. + 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 ---- + private = list( + # private attributes ---- + data = NULL, + modules = NULL, + filter = teal_slices(), + ns = list( + module = character(0), + filter_panel = character(0) + ), + # 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) + } + }, + # @description + # Get the active filter values from the active filter selection of dataset from the filter panel. + # + # @param dataset_name (character) The name of the dataset to get the filter values from. + # @param var_name (character) The name of the variable to get the filter values from. + # + # @return The value of the active filter selection. + get_active_filter_selection = function(dataset_name, var_name) { + checkmate::check_string(dataset_name) + checkmate::check_string(var_name) + input_id_prefix <- sprintf( + "%s-active-%s-filter-%s_%s-inputs", + self$active_filters_ns(), + dataset_name, + dataset_name, + var_name + ) + + # Find the type of filter (categorical or range) + supported_suffix <- c("selection", "selection_manual") + for (suffix in supported_suffix) { + if (!is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix)))) { + return(self$get_value(input = sprintf("%s-%s", input_id_prefix, suffix))) + } + } + + NULL # If there are not any supported filters + } + ) +) diff --git a/R/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 9b43ae0397..8bea52b69a 100644 --- a/R/init.R +++ b/R/init.R @@ -31,11 +31,11 @@ #' 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. +#' @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/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/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 90fdd62b7f..4ec76a2ca7 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) } @@ -267,7 +266,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 +324,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 } @@ -395,7 +394,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 @@ -422,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 2ee7560684..ba84f3173f 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, ...) @@ -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/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..1a1c13c676 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 @@ -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/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/inst/WORDLIST b/inst/WORDLIST index bfba486c17..e8716e7cb5 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -9,8 +9,10 @@ TLG UI UIs UX +bookmarkable cloneable customizable +dialogs favicon favicons funder 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/TealAppDriver.Rd b/man/TealAppDriver.Rd new file mode 100644 index 0000000000..e78702a93d --- /dev/null +++ b/man/TealAppDriver.Rd @@ -0,0 +1,577 @@ +% 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-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()}} +\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_module_element_text}{\code{TealAppDriver$active_module_element_text()}} +\item \href{#method-TealAppDriver-active_filters_ns}{\code{TealAppDriver$active_filters_ns()}} +\item \href{#method-TealAppDriver-get_active_module_input}{\code{TealAppDriver$get_active_module_input()}} +\item \href{#method-TealAppDriver-get_active_module_output}{\code{TealAppDriver$get_active_module_output()}} +\item \href{#method-TealAppDriver-set_module_input}{\code{TealAppDriver$set_module_input()}} +\item \href{#method-TealAppDriver-get_active_filter_vars}{\code{TealAppDriver$get_active_filter_vars()}} +\item \href{#method-TealAppDriver-get_active_data_filters}{\code{TealAppDriver$get_active_data_filters()}} +\item \href{#method-TealAppDriver-add_filter_var}{\code{TealAppDriver$add_filter_var()}} +\item \href{#method-TealAppDriver-remove_filter_var}{\code{TealAppDriver$remove_filter_var()}} +\item \href{#method-TealAppDriver-set_active_filter_selection}{\code{TealAppDriver$set_active_filter_selection()}} +\item \href{#method-TealAppDriver-get_attr}{\code{TealAppDriver$get_attr()}} +\item \href{#method-TealAppDriver-get_html_rvest}{\code{TealAppDriver$get_html_rvest()}} +\item \href{#method-TealAppDriver-open_url}{\code{TealAppDriver$open_url()}} +\item \href{#method-TealAppDriver-wait_for_active_module_value}{\code{TealAppDriver$wait_for_active_module_value()}} +\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(), + timeout = rlang::missing_arg(), + load_timeout = rlang::missing_arg(), + ... +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\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{
}} +} +\subsection{Returns}{ +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()}}{ +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_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()}}{ +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.} + +\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-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-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.} + +\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-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, ...)}\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{...}}{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-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()}}{ +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()}}{ +\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-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()}}{ +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/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/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/man/init.Rd b/man/init.Rd index 89a588328f..2f0e34d2f5 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -38,12 +38,12 @@ 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{ -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/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/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/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..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; @@ -44,7 +43,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. diff --git a/tests/testthat/helper-shinytest2.R b/tests/testthat/helper-shinytest2.R new file mode 100644 index 0000000000..f5c298ac40 --- /dev/null +++ b/tests/testthat/helper-shinytest2.R @@ -0,0 +1,41 @@ +library(shinytest2) +library(rvest) + +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/setup-logger.R b/tests/testthat/setup-logger.R index 1a7b3e5c5f..aeb7fb70bb 100644 --- a/tests/testthat/setup-logger.R +++ b/tests/testthat/setup-logger.R @@ -1 +1 @@ -logger::log_appender(function(...) {}, namespace = "teal") +logger::log_appender(function(...) NULL, namespace = "teal") diff --git a/tests/testthat/setup-testing_depth.R b/tests/testthat/setup-testing_depth.R new file mode 100644 index 0000000000..3aa6cf3ec3 --- /dev/null +++ b/tests/testthat/setup-testing_depth.R @@ -0,0 +1,49 @@ +#' Returns testing depth set by session option or by environmental variable. +#' +#' @details Looks for the session option `TESTING_DEPTH` first. +#' If not set, takes the system environmental variable `TESTING_DEPTH`. +#' If neither is set, then returns 3 by default. +#' If the value of `TESTING_DEPTH` is not a numeric of length 1, then returns 3. +#' +#' @return `numeric(1)` the testing depth. +#' +get_testing_depth <- function() { + default_depth <- 3 + depth <- getOption("TESTING_DEPTH", Sys.getenv("TESTING_DEPTH", default_depth)) + depth <- tryCatch( + as.numeric(depth), + error = function(error) default_depth, + warning = function(warning) default_depth + ) + if (length(depth) != 1) depth <- default_depth + depth +} + +#' Skipping tests in the testthat pipeline under specific scope +#' @description This function should be used per each `testthat::test_that` call. +#' Each of the call should specify an appropriate depth value. +#' The depth value will set the appropriate scope so more/less time consuming tests could be recognized. +#' The environment variable `TESTING_DEPTH` is used for changing the scope of `testthat` pipeline. +#' `TESTING_DEPTH` interpretation for each possible value: +#' \itemize{ +#' \item{0}{no tests at all} +#' \item{1}{fast - small scope - executed on every commit} +#' \item{3}{medium - medium scope - daily integration pipeline} +#' \item{5}{slow - all tests - daily package tests} +#' } +#' @param depth `numeric` the depth of the testing evaluation, +#' has opposite interpretation to environment variable `TESTING_DEPTH`. +#' So e.g. `0` means run it always and `5` means a heavy test which should be run rarely. +#' If the `depth` argument is larger than `TESTING_DEPTH` then the test is skipped. +#' @importFrom testthat skip +#' @return `NULL` or invoke an error produced by `testthat::skip` +#' @note By default `TESTING_DEPTH` is equal to 3 if there is no environment variable for it. +#' By default `depth` argument lower or equal to 3 will not be skipped because by default `TESTING_DEPTH` +#' is equal to 3. To skip <= 3 depth tests then the environment variable has to be lower than 3 respectively. +skip_if_too_deep <- function(depth) { # nolintr + checkmate::assert_numeric(depth, len = 1, lower = 0, upper = 5) + testing_depth <- get_testing_depth() # by default 3 if there are no env variable + if (testing_depth < depth) { + testthat::skip(paste("testing depth", testing_depth, "is below current testing specification", depth)) + } +} diff --git a/tests/testthat/test-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-filter_panel.R b/tests/testthat/test-shinytest2-filter_panel.R new file mode 100644 index 0000000000..2f65f29b91 --- /dev/null +++ b/tests/testthat/test-shinytest2-filter_panel.R @@ -0,0 +1,104 @@ +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( + 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") + ) + ) + + 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", { + skip_if_too_deep(5) + 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") + ) + ) + ) + + expect_equal( + app$get_active_data_filters("iris")$Species, + c("setosa", "versicolor", "virginica") + ) + + app$navigate_teal_tab("Module_2") + + app$set_active_filter_selection("iris", "Species", c("setosa")) + + app$navigate_teal_tab("Module_1") + + expect_equal( + app$get_active_data_filters("iris")$Species, + c("setosa") + ) + + app$stop() +}) + +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( + 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") + ) + ) + ) + + expect_equal( + app$get_active_data_filters("mtcars")$cyl, + c("4", "6") + ) + + app$navigate_teal_tab("Module_2") + + app$set_active_filter_selection("mtcars", "cyl", c("4")) + + app$navigate_teal_tab("Module_1") + + expect_equal( + app$get_active_data_filters("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..9f57bfa904 --- /dev/null +++ b/tests/testthat/test-shinytest2-init.R @@ -0,0 +1,102 @@ +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") + ) + app$expect_no_shiny_error() + app$stop() +}) + +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") + ) + + # Check if button exists. + button_selector <- "#teal-sessionInfo-button" + testthat::expect_equal( + app$get_text(button_selector), + "Session Info" + ) + + app$click(selector = button_selector) + + # 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", { + 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" + 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 + ) + + testthat::expect_equal( + app$get_text("head > title")[1], + app_title + ) + testthat::expect_equal( + app$get_html_rvest("head > link[rel='icon']") %>% + 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-landing_popup.R b/tests/testthat/test-shinytest2-landing_popup.R new file mode 100644 index 0000000000..adaa82c19a --- /dev/null +++ b/tests/testthat/test-shinytest2-landing_popup.R @@ -0,0 +1,161 @@ +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() + ) + ) + + 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() + ) + ) + + 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() + ) + ) + + # Button is clicked. + app$click(selector = "#shiny-modal-wrapper button[data-dismiss='modal']") + + # 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() + ) + ) + + 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() + ) + ) + + testthat::expect_equal( + app$get_attr("#read", "onclick"), + onclick_text + ) + + app$stop() +}) 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-modules.R b/tests/testthat/test-shinytest2-modules.R new file mode 100644 index 0000000000..536f09f2b9 --- /dev/null +++ b/tests/testthat/test-shinytest2-modules.R @@ -0,0 +1,118 @@ +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, + 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") + ) + ) + + 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", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "mtcars", datanames = "mtcars") + ) + ) + + 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", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "all", datanames = "all") + ) + ) + + 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", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = modules( + example_module(label = "NULL", datanames = NULL) + ) + ) + + testthat::expect_identical( + app$get_html_rvest(".teal_secondary_col") %>% + 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", { + skip_if_too_deep(5) + 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..77b6b190d8 --- /dev/null +++ b/tests/testthat/test-shinytest2-reporter.R @@ -0,0 +1,84 @@ +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") + ) + + 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"), + 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", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = example_module(label = "Example Module") + ) + 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"), + 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", { + skip_if_too_deep(5) + app <- TealAppDriver$new( + data = simple_teal_data(), + modules = report_module(label = "Module with Reporter") + ) + + app$click(NS(app$active_module_ns(), "reporter-add_report_card_simple-add_report_card_button")) + + 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-show-rcode.R b/tests/testthat/test-shinytest2-show-rcode.R new file mode 100644 index 0000000000..383ed57b90 --- /dev/null +++ b/tests/testthat/test-shinytest2-show-rcode.R @@ -0,0 +1,53 @@ +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") + ) + + # 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) + + # 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() +}) 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..87025f1542 --- /dev/null +++ b/tests/testthat/test-shinytest2-teal_data_module.R @@ -0,0 +1,122 @@ +testthat::test_that("e2e: teal_data_module will have a delayed load of datasets", { + skip_if_too_deep(5) + tdm <- teal_data_module( + ui = function(id) { + ns <- shiny::NS(id) + shiny::actionButton(ns("submit"), label = "Load data") + }, + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::eventReactive(input$submit, { + data <- within( + teal_data(), + { + dataset1 <- iris + dataset2 <- mtcars + } + ) + datanames(data) <- c("dataset1", "dataset2") + + data + }) + }) + } + ) + + app <- TealAppDriver$new( + data = tdm, + modules = example_module(label = "Example Module") + ) + + app$click("teal_data_module-submit") + testthat::expect_setequal(app$get_active_filter_vars(), c("dataset1", "dataset2")) + + app$stop() +}) + +testthat::test_that("e2e: teal_data_module shows validation errors", { + skip_if_too_deep(5) + tdm <- teal_data_module( + ui = function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::textInput(ns("new_column"), label = "New column name"), + shiny::actionButton(ns("submit"), label = "Load data") + ) + }, + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::eventReactive(input$submit, { + shiny::validate( + shiny::need(input$new_column, "Please provide a new column name") + ) + data <- within(teal_data(), dataset1 <- iris) + datanames(data) <- c("dataset1") + data + }) + }) + } + ) + + app <- TealAppDriver$new( + data = tdm, + modules = example_module(label = "Example Module") + ) + + app$click("teal_data_module-submit") + + app$expect_validation_error() + + app$stop() +}) + +testthat::test_that("e2e: teal_data_module inputs change teal_data object that is passed to teal main UI", { + skip_if_too_deep(5) + tdm <- teal_data_module( + ui = function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::textInput(ns("new_column"), label = "New column name"), + shiny::actionButton(ns("submit"), label = "Load data") + ) + }, + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::eventReactive(input$submit, { + shiny::validate( + shiny::need(input$new_column, "Please provide a new column name") + ) + data <- within( + teal_data(), + { + dataset1 <- iris + dataset1[[new_column]] <- sprintf("%s new", dataset1$Species) + }, + new_column = input$new_column + ) + datanames(data) <- c("dataset1") + + data + }) + }) + } + ) + + app <- TealAppDriver$new( + data = tdm, + modules = example_module(label = "Example Module") + ) + + 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")) + + testthat::expect_setequal( + app$get_active_data_filters("dataset1")$A_New_Column, + unique(sprintf("%s new", iris$Species)) + ) + + app$stop() +}) diff --git a/tests/testthat/test-shinytest2-teal_slices.R b/tests/testthat/test-shinytest2-teal_slices.R new file mode 100644 index 0000000000..3797590074 --- /dev/null +++ b/tests/testthat/test-shinytest2-teal_slices.R @@ -0,0 +1,110 @@ +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( + 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") + ) + ) + + testthat::expect_identical( + 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_data_filters("mtcars")$cyl, + c("4", "6") + ) + testthat::expect_identical( + app$get_active_data_filters("mtcars")$drat, + c(3, 4) + ) + testthat::expect_identical( + 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( + 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") + ) + ) + ) + + testthat::expect_identical( + 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_data_filters("mtcars")$cyl, + c("4", "6") + ) + + 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") + + testthat::expect_identical( + 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_data_filters("mtcars")$drat, + c(3, 4) + ) + testthat::expect_identical( + app$get_active_data_filters("mtcars")$gear, + c("3", "4", "5") + ) + 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 new file mode 100644 index 0000000000..30b0d2bef2 --- /dev/null +++ b/tests/testthat/test-shinytest2-utils.R @@ -0,0 +1,30 @@ +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() + ) + + get_class_attributes <- function(app, selector) { + element <- app$get_html_rvest(selector = selector) %>% + 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") + 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() +}) 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())) 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")) ```