From 3569fc83dc7a4bffb956615ec8a95648d6c43133 Mon Sep 17 00:00:00 2001 From: Stefan Linner Date: Thu, 23 Apr 2026 20:06:14 +0200 Subject: [PATCH] implemented "reset active module" functionality --- R/module_nested_tabs.R | 17 +++++-- R/module_snapshot_manager.R | 78 +++++++++++++++++++++++++++++-- R/module_teal.R | 10 +++- man/module_snapshot_manager.Rd | 12 ++++- man/module_teal_module.Rd | 12 +++-- tests/testthat/test-module_teal.R | 75 +++++++++++++++++++++++++++++ 6 files changed, 189 insertions(+), 15 deletions(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index f81defa361..60a1e13628 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -55,9 +55,13 @@ #' `id` of the currently active module. This helps to determine which module can listen to reactive events. #' #' @return -#' Output of currently active module. -#' - `srv_teal_module.teal_module` returns `reactiveVal` containing output of the called module. -#' - `srv_teal_module.teal_modules` returns output of modules in a list following the hierarchy of `modules` +#' `srv_teal_module` returns a `list` with: +#' - `modules_output`: output of the module tree (see below). +#' - `active_module_id`: `reactive` returning the `character(1)` path of the currently active module. +#' +#' `.srv_teal_module` dispatches on `modules` class: +#' - `.srv_teal_module.teal_module` returns `reactiveVal` containing output of the called module. +#' - `.srv_teal_module.teal_modules` returns output of modules in a list following the hierarchy of `modules` #' #' @keywords internal NULL @@ -155,7 +159,7 @@ srv_teal_module <- function(id, ignoreNULL = FALSE ) } - .srv_teal_module( + modules_output <- .srv_teal_module( id = "nav", data = data, modules = modules, @@ -165,6 +169,11 @@ srv_teal_module <- function(id, data_load_status = data_load_status, active_module_id = reactive(input$active_module_id) ) + + list( + modules_output = modules_output, + active_module_id = reactive(input$active_module_id) + ) }) } diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 1060774f1e..4ebc56a438 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -74,6 +74,9 @@ #' @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. +#' @param active_module_id (`reactive` returning `character(1)`) +#' Path of the currently active module. Used to enable "Reset active module" functionality +#' when `module_specific` filtering is enabled. #' #' @return `list` containing the snapshot history, where each element is an unlisted `teal_slices` object. #' @@ -95,7 +98,7 @@ ui_snapshot_manager_panel <- function(id) { } #' @rdname module_snapshot_manager -srv_snapshot_manager_panel <- function(id, slices_global) { +srv_snapshot_manager_panel <- function(id, slices_global, active_module_id = reactive(NULL)) { moduleServer(id, function(input, output, session) { logger::log_debug("srv_snapshot_manager_panel initializing") setBookmarkExclude(c("show_snapshot_manager")) @@ -111,7 +114,11 @@ srv_snapshot_manager_panel <- function(id, slices_global) { ) ) }) - snapshot_history <- srv_snapshot_manager("module", slices_global = slices_global) + snapshot_history <- srv_snapshot_manager( + "module", + slices_global = slices_global, + active_module_id = active_module_id + ) snapshot_history }) } @@ -138,6 +145,7 @@ ui_snapshot_manager <- function(id) { "Reset initial state", placement = "top" ), + uiOutput(ns("snapshot_reset_module_ui"), inline = TRUE), NULL ), tags$br(), @@ -146,7 +154,7 @@ ui_snapshot_manager <- function(id) { } #' @rdname module_snapshot_manager -srv_snapshot_manager <- function(id, slices_global) { +srv_snapshot_manager <- function(id, slices_global, active_module_id = reactive(NULL)) { checkmate::assert_character(id) moduleServer(id, function(input, output, session) { @@ -155,7 +163,7 @@ srv_snapshot_manager <- function(id, slices_global) { # Set up bookmarking callbacks ---- # Register bookmark exclusions (all buttons and text fields). setBookmarkExclude(c( - "snapshot_add", "snapshot_load", "snapshot_reset", + "snapshot_add", "snapshot_load", "snapshot_reset", "snapshot_reset_module", "snapshot_name_accept", "snapshot_file_accept", "snapshot_name", "snapshot_file" )) @@ -339,6 +347,68 @@ srv_snapshot_manager <- function(id, slices_global) { ### End restore procedure. ### }) + # Restore initial state for active module only ---- + output$snapshot_reset_module_ui <- renderUI({ + if (slices_global$is_module_specific()) { + bslib::tooltip( + tags$span(actionLink(ns("snapshot_reset_module"), label = NULL, icon = icon("fas fa-rotate-left"))), + "Reset active module", + placement = "top" + ) + } + }) + + observeEvent(input$snapshot_reset_module, { + active_path <- active_module_id() + req(active_path) + # Extract module label from path (last segment after " / ") + active_label <- sub(".*/ ", "", active_path) + logger::log_debug( + "srv_snapshot_manager: snapshot_reset_module clicked, resetting module: { active_label }" + ) + + # Get initial and current states + initial_snapshot <- snapshot_history()[["Initial application state"]] + initial_state <- as.teal_slices(initial_snapshot) + initial_mapping <- attr(initial_state, "mapping") + initial_module_ids <- initial_mapping[[active_label]] %||% character(0) + + current_state <- slices_global$all_slices() + current_mapping <- attr(current_state, "mapping") + + # Replace only the active module's mapping with initial + current_mapping[[active_label]] <- initial_module_ids + + # Restore initial slice objects for this module + initial_module_slices <- Filter( + function(s) s$id %in% initial_module_ids, + initial_state + ) + current_ids <- if (length(current_state)) { + vapply(current_state, `[[`, character(1L), "id") + } else { + character(0) + } + new_state <- current_state + for (init_slice in initial_module_slices) { + idx <- match(init_slice$id, current_ids) + if (!is.na(idx)) { + new_state[[idx]] <- init_slice + } else { + new_state[[length(new_state) + 1L]] <- init_slice + current_ids <- c(current_ids, init_slice$id) + } + } + + attr(new_state, "mapping") <- current_mapping + # Ensure module_specific and app_id are preserved from the initial state, + # since these should never change during a session. + attr(new_state, "module_specific") <- attr(initial_state, "module_specific") + attr(new_state, "app_id") <- attr(initial_state, "app_id") + slices_global$slices_set(new_state) + removeModal() + }) + # Build snapshot table ---- # Create UI elements and server logic for the snapshot table. # Observers must be tracked to avoid duplication and excess reactivity. diff --git a/R/module_teal.R b/R/module_teal.R index 15fdd6d142..e3da4fa793 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -327,7 +327,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices(), reporter = teal. module_labels <- unlist(modules_slot(modules, "label"), use.names = FALSE) slices_global <- methods::new(".slicesGlobal", filter, module_labels) - modules_output <- srv_teal_module( + teal_module_result <- srv_teal_module( "teal_modules", data = data_signatured, modules = modules, @@ -336,9 +336,15 @@ srv_teal <- function(id, data, modules, filter = teal_slices(), reporter = teal. reporter = reporter, data_load_status = data_load_status ) + modules_output <- teal_module_result$modules_output + active_module_id <- teal_module_result$active_module_id mapping_table <- srv_filter_manager_panel("filter_manager_panel", slices_global = slices_global) - snapshots <- srv_snapshot_manager_panel("snapshot_manager_panel", slices_global = slices_global) + snapshots <- srv_snapshot_manager_panel( + "snapshot_manager_panel", + slices_global = slices_global, + active_module_id = active_module_id + ) srv_bookmark_panel("bookmark_manager", modules) }) diff --git a/man/module_snapshot_manager.Rd b/man/module_snapshot_manager.Rd index 723fcd3ccb..641b7b7df6 100644 --- a/man/module_snapshot_manager.Rd +++ b/man/module_snapshot_manager.Rd @@ -10,17 +10,25 @@ \usage{ ui_snapshot_manager_panel(id) -srv_snapshot_manager_panel(id, slices_global) +srv_snapshot_manager_panel( + id, + slices_global, + active_module_id = reactive(NULL) +) ui_snapshot_manager(id) -srv_snapshot_manager(id, slices_global) +srv_snapshot_manager(id, slices_global, active_module_id = reactive(NULL)) } \arguments{ \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.} + +\item{active_module_id}{(\code{reactive} returning \code{character(1)}) +Path of the currently active module. Used to enable "Reset active module" functionality +when \code{module_specific} filtering is enabled.} } \value{ \code{list} containing the snapshot history, where each element is an unlisted \code{teal_slices} object. diff --git a/man/module_teal_module.Rd b/man/module_teal_module.Rd index 735e86c65a..f18bb306fe 100644 --- a/man/module_teal_module.Rd +++ b/man/module_teal_module.Rd @@ -124,10 +124,16 @@ panel. \code{id} of the currently active module. This helps to determine which module can listen to reactive events.} } \value{ -Output of currently active module. +\code{srv_teal_module} returns a \code{list} with: \itemize{ -\item \code{srv_teal_module.teal_module} returns \code{reactiveVal} containing output of the called module. -\item \code{srv_teal_module.teal_modules} returns output of modules in a list following the hierarchy of \code{modules} +\item \code{modules_output}: output of the module tree (see below). +\item \code{active_module_id}: \code{reactive} returning the \code{character(1)} path of the currently active module. +} + +\code{.srv_teal_module} dispatches on \code{modules} class: +\itemize{ +\item \code{.srv_teal_module.teal_module} returns \code{reactiveVal} containing output of the called module. +\item \code{.srv_teal_module.teal_modules} returns output of modules in a list following the hierarchy of \code{modules} } } \description{ diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R index 6bea6a044a..9d54205ff5 100644 --- a/tests/testthat/test-module_teal.R +++ b/tests/testthat/test-module_teal.R @@ -2722,6 +2722,81 @@ testthat::describe("srv_teal snapshot manager", { ) }) + testthat::it("clicking reset active module resets only the active module's filters", { + shiny::testServer( + app = srv_teal, + args = list( + id = "test", + data = teal.data::teal_data(iris = iris, mtcars = mtcars), + modules = modules( + module("module_1", server = function(id, data) data), + module("module_2", server = function(id, data) data) + ), + filter = teal_slices( + teal_slice("iris", "Species"), + teal_slice("mtcars", "cyl"), + mapping = list(module_1 = "iris Species", module_2 = "mtcars cyl"), + module_specific = TRUE + ) + ), + expr = { + initial_slices <- slices_global$all_slices() + session$setInputs(`teal_modules-active_module_id` = "module_1") + session$setInputs(`teal_modules-active_module_id` = "module_2") + session$flushReact() + + # Modify module_1's mapping to also include the mtcars filter + slices_global$slices_active(list(module_1 = c("iris Species", "mtcars cyl"))) + session$flushReact() + + # Verify module_1 now has both filters + testthat::expect_equal( + attr(slices_global$all_slices(), "mapping")[["module_1"]], + c("iris Species", "mtcars cyl") + ) + + # Reset only module_1 + session$setInputs(`teal_modules-active_module_id` = "module_1") + session$flushReact() + session$setInputs("snapshot_manager_panel-module-snapshot_reset_module" = TRUE) + session$flushReact() + + restored_mapping <- attr(slices_global$all_slices(), "mapping") + + # module_1 should be restored to initial (only iris Species) + testthat::expect_equal(restored_mapping[["module_1"]], "iris Species") + + # module_2 should remain unchanged + testthat::expect_equal(restored_mapping[["module_2"]], "mtcars cyl") + } + ) + }) + + testthat::it("reset active module button is not rendered when module_specific is FALSE", { + shiny::testServer( + app = srv_teal, + args = list( + id = "test", + data = teal.data::teal_data(iris = iris), + modules = modules( + module("module_1", server = function(id, data) data) + ), + filter = teal_slices( + teal_slice("iris", "Species"), + module_specific = FALSE + ) + ), + expr = { + session$setInputs(`teal_modules-active_module_id` = "module_1") + session$flushReact() + rendered_ui <- output[["snapshot_manager_panel-module-snapshot_reset_module_ui"]] + testthat::expect_true( + is.null(rendered_ui$html) || !grepl("snapshot_reset_module", rendered_ui$html) + ) + } + ) + }) + testthat::it("adds snapshot to history when name is provided", { shiny::testServer( app = srv_teal,