Add "Reset active module" button to snapshot manager (#1707)

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

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.

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

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,