fix: duplicated slices are lingering the filter panel after DDL reload (

#602) # Pull Request Companion of insightsengineering/teal#1275 Note: There's a similar solution that is cleaner. I'll push it on Monday #### Changes description - Keeps track of `remove observers` on filter panel - Destroys `remove observer` when clearing filter panel Co-authored-by: go_gonzo <[email protected]>
insightsengineering · Aug 1, 2024 · 0c90543 · 0c90543
1 parent 58eb499
commit 0c90543
Show file tree

Hide file tree

Showing 12 changed files with 71 additions and 43 deletions.
diff --git a/R/FilterState.R b/R/FilterState.R
@@ -200,9 +200,12 @@ FilterState <- R6::R6Class( # nolint
     #' @param id (`character(1)`)
     #'   `shiny` module instance id.
     #'
+    #' @param remove_callback (`function`)
+    #'   callback to handle removal of this `FilterState` object from `state_list`
+    #'
     #' @return Reactive expression signaling that remove button has been clicked.
     #'
-    server = function(id) {
+    server = function(id, remove_callback) {
       moduleServer(
         id = id,
         function(input, output, session) {
@@ -214,7 +217,7 @@ FilterState <- R6::R6Class( # nolint
             private$server_inputs("inputs")
           }
 
-          private$observers$state <- observeEvent(
+          private$observers[[session$ns("state")]] <- observeEvent(
             eventExpr = list(private$get_selected(), private$get_keep_na(), private$get_keep_inf()),
             handlerExpr = {
               current_state <- as.list(self$get_state())
@@ -224,7 +227,7 @@ FilterState <- R6::R6Class( # nolint
             }
           )
 
-          private$observers$back <- observeEvent(
+          private$observers[[session$ns("back")]] <- observeEvent(
             eventExpr = input$back,
             handlerExpr = {
               history <- rev(private$state_history())
@@ -235,7 +238,7 @@ FilterState <- R6::R6Class( # nolint
             }
           )
 
-          private$observers$reset <- observeEvent(
+          private$observers[[session$ns("reset")]] <- observeEvent(
             eventExpr = input$reset,
             handlerExpr = {
               slice <- private$state_history()[[1L]]
@@ -245,7 +248,7 @@ FilterState <- R6::R6Class( # nolint
 
           # Buttons for rewind/reset are disabled upon change in history to prevent double-clicking.
           # Re-enabling occurs after 100 ms, after they are potentially hidden when no history is present.
-          private$observers$state_history <- observeEvent(
+          private$observers[[session$ns("state_history")]] <- observeEvent(
             eventExpr = private$state_history(),
             handlerExpr = {
               shinyjs::disable(id = "back")
@@ -267,6 +270,13 @@ FilterState <- R6::R6Class( # nolint
             }
           )
 
+          private$observers[[session$ns("remove")]] <- observeEvent(
+            once = TRUE, # remove button can be called once, should be destroyed afterwards
+            ignoreInit = TRUE, # ignoreInit: should not matter because we destroy the previous input set of the UI
+            eventExpr = input$remove, # when remove button is clicked in the FilterState ui
+            handlerExpr = remove_callback()
+          )
+
           private$destroy_shiny <- function() {
             logger::log_debug("Destroying FilterState inputs and observers; id: { private$get_id() }")
             # remove values from the input list
@@ -276,7 +286,7 @@ FilterState <- R6::R6Class( # nolint
             lapply(private$observers, function(x) x$destroy())
           }
 
-          reactive(input$remove)
+          NULL
         }
       )
     },
@@ -381,6 +391,7 @@ FilterState <- R6::R6Class( # nolint
     destroy_observers = function() {
       if (!is.null(private$destroy_shiny)) {
         private$destroy_shiny()
+        private$destroy_shiny <- NULL
       }
     }
   ),
@@ -761,7 +772,7 @@ FilterState <- R6::R6Class( # nolint
         # this observer is needed in the situation when private$keep_inf has been
         # changed directly by the api - then it's needed to rerender UI element
         # to show relevant values
-        private$observers$keep_na_api <- observeEvent(
+        private$observers[[session$ns("keep_na_api")]] <- observeEvent(
           ignoreNULL = FALSE, # nothing selected is possible for NA
           ignoreInit = TRUE, # ignoreInit: should not matter because we set the UI with the desired initial state
           eventExpr = private$get_keep_na(),
@@ -776,7 +787,7 @@ FilterState <- R6::R6Class( # nolint
             }
           }
         )
-        private$observers$keep_na <- observeEvent(
+        private$observers[[session$ns("keep_na")]] <- observeEvent(
           ignoreNULL = FALSE, # ignoreNULL: we don't want to ignore NULL when nothing is selected in the `selectInput`
           ignoreInit = TRUE, # ignoreInit: should not matter because we set the UI with the desired initial state
           eventExpr = input$value,

diff --git a/R/FilterStateChoices.R b/R/FilterStateChoices.R
@@ -454,8 +454,8 @@ ChoicesFilterState <- R6::R6Class( # nolint
             })
           })
 
-          if (private$is_checkboxgroup()) {
-            private$observers$selection <- observeEvent(
+          private$observers[[session$ns("selection")]] <- if (private$is_checkboxgroup()) {
+            observeEvent(
               ignoreNULL = FALSE,
               ignoreInit = TRUE, # ignoreInit: should not matter because we set the UI with the desired initial state
               eventExpr = input$selection,
@@ -472,7 +472,7 @@ ChoicesFilterState <- R6::R6Class( # nolint
               }
             )
           } else {
-            private$observers$selection <- observeEvent(
+            observeEvent(
               ignoreNULL = FALSE,
               ignoreInit = TRUE, # ignoreInit: should not matter because we set the UI with the desired initial state
               eventExpr = input$selection_open, # observe click on a dropdown
@@ -510,7 +510,7 @@ ChoicesFilterState <- R6::R6Class( # nolint
           # this observer is needed in the situation when teal_slice$selected has been
           # changed directly by the api - then it's needed to rerender UI element
           # to show relevant values
-          private$observers$selection_api <- observeEvent(private$get_selected(), {
+          private$observers[[session$ns("selection_api")]] <- observeEvent(private$get_selected(), {
             # it's important to not retrigger when the input$selection is the same as reactive values
             # kept in the teal_slice$selected
             if (!setequal(input$selection, private$get_selected())) {

diff --git a/R/FilterStateDate.R b/R/FilterStateDate.R
@@ -327,7 +327,7 @@ DateFilterState <- R6::R6Class( # nolint
           # this observer is needed in the situation when teal_slice$selected has been
           # changed directly by the api - then it's needed to rerender UI element
           # to show relevant values
-          private$observers$seletion_api <- observeEvent(
+          private$observers[[session$ns("selection_api")]] <- observeEvent(
             ignoreNULL = TRUE, # dates needs to be selected
             ignoreInit = TRUE,
             eventExpr = private$get_selected(),
@@ -344,7 +344,7 @@ DateFilterState <- R6::R6Class( # nolint
             }
           )
 
-          private$observers$selection <- observeEvent(
+          private$observers[[session$ns("selection")]] <- observeEvent(
             ignoreNULL = TRUE, # dates needs to be selected
             ignoreInit = TRUE, # ignoreInit: should not matter because we set the UI with the desired initial state
             eventExpr = input$selection,
@@ -374,7 +374,7 @@ DateFilterState <- R6::R6Class( # nolint
 
           private$keep_na_srv("keep_na")
 
-          private$observers$reset1 <- observeEvent(input$start_date_reset, {
+          private$observers[[session$ns("reset1")]] <- observeEvent(input$start_date_reset, {
             logger::log_debug("DateFilterState$server@3 reset start date, id: { private$get_id() }")
             updateDateRangeInput(
               session = session,
@@ -383,7 +383,7 @@ DateFilterState <- R6::R6Class( # nolint
             )
           })
 
-          private$observers$reset2 <- observeEvent(input$end_date_reset, {
+          private$observers[[session$ns("reset2")]] <- observeEvent(input$end_date_reset, {
             logger::log_debug("DateFilterState$server@4 reset end date, id: { private$get_id() }")
             updateDateRangeInput(
               session = session,

diff --git a/R/FilterStateDatettime.R b/R/FilterStateDatettime.R
@@ -388,7 +388,7 @@ DatetimeFilterState <- R6::R6Class( # nolint
           # this observer is needed in the situation when teal_slice$selected has been
           # changed directly by the api - then it's needed to rerender UI element
           # to show relevant values
-          private$observers$selection_api <- observeEvent(
+          private$observers[[session$ns("selection_api")]] <- observeEvent(
             ignoreNULL = TRUE, # dates needs to be selected
             ignoreInit = TRUE, # on init selected == default, so no need to trigger
             eventExpr = private$get_selected(),
@@ -417,7 +417,7 @@ DatetimeFilterState <- R6::R6Class( # nolint
           )
 
 
-          private$observers$selection_start <- observeEvent(
+          private$observers[[session$ns("selection_start")]] <- observeEvent(
             ignoreNULL = TRUE, # dates needs to be selected
             ignoreInit = TRUE, # ignoreInit: should not matter because we set the UI with the desired initial state
             eventExpr = input$selection_start,
@@ -445,7 +445,7 @@ DatetimeFilterState <- R6::R6Class( # nolint
             }
           )
 
-          private$observers$selection_end <- observeEvent(
+          private$observers[[session$ns("selection_end")]] <- observeEvent(
             ignoreNULL = TRUE, # dates needs to be selected
             ignoreInit = TRUE, # ignoreInit: should not matter because we set the UI with the desired initial state
             eventExpr = input$selection_end,
@@ -475,7 +475,7 @@ DatetimeFilterState <- R6::R6Class( # nolint
 
           private$keep_na_srv("keep_na")
 
-          private$observers$reset1 <- observeEvent(
+          private$observers[[session$ns("reset1")]] <- observeEvent(
             ignoreInit = TRUE, # reset button shouldn't be trigger on init
             ignoreNULL = TRUE, # it's impossible and wrong to set default to NULL
             input$start_date_reset,
@@ -488,7 +488,7 @@ DatetimeFilterState <- R6::R6Class( # nolint
               logger::log_debug("DatetimeFilterState$server@2 reset start date, id: { private$get_id() }")
             }
           )
-          private$observers$reset2 <- observeEvent(
+          private$observers[[session$ns("reset2")]] <- observeEvent(
             ignoreInit = TRUE, # reset button shouldn't be trigger on init
             ignoreNULL = TRUE, # it's impossible and wrong to set default to NULL
             input$end_date_reset,

diff --git a/R/FilterStateExpr.R b/R/FilterStateExpr.R
@@ -162,9 +162,12 @@ FilterStateExpr <- R6::R6Class( # nolint
     #' @param id (`character(1)`)
     #'   `shiny` module instance id.
     #'
+    #' @param remove_callback (`function`)
+    #'   callback to handle removal of this `FilterState` object from `state_list`
+    #'
     #' @return Reactive expression signaling that the remove button has been clicked.
     #'
-    server = function(id) {
+    server = function(id, remove_callback) {
       moduleServer(
         id = id,
         function(input, output, session) {
@@ -176,7 +179,14 @@ FilterStateExpr <- R6::R6Class( # nolint
             lapply(session$ns(names(input)), .subset2(input, "impl")$.values$remove)
           }
 
-          reactive(input$remove) # back to parent to remove self
+          private$observers[[session$ns("remove")]] <- observeEvent(
+            once = TRUE, # remove button can be called once, should be destroyed afterwards
+            ignoreInit = TRUE, # ignoreInit: should not matter because we destroy the previous input set of the UI
+            eventExpr = input$remove, # when remove button is clicked in the FilterState ui
+            handlerExpr = remove_callback()
+          )
+
+          NULL
         }
       )
     },

diff --git a/R/FilterStateLogical.R b/R/FilterStateLogical.R
@@ -313,7 +313,7 @@ LogicalFilterState <- R6::R6Class( # nolint
             NULL
           })
 
-          private$observers$seleted_api <- observeEvent(
+          private$observers[[session$ns("selected_api")]] <- observeEvent(
             ignoreNULL = !private$is_multiple(),
             ignoreInit = TRUE,
             eventExpr = private$get_selected(),
@@ -335,7 +335,7 @@ LogicalFilterState <- R6::R6Class( # nolint
             }
           )
 
-          private$observers$selection <- observeEvent(
+          private$observers[[session$ns("selection")]] <- observeEvent(
             ignoreNULL = FALSE,
             ignoreInit = TRUE,
             eventExpr = input$selection,

diff --git a/R/FilterStateRange.R b/R/FilterStateRange.R
@@ -506,7 +506,7 @@ RangeFilterState <- R6::R6Class( # nolint
           })
 
           # Dragging shapes (lines) on plot updates selection.
-          private$observers$relayout <-
+          private$observers[[session$ns("relayout")]] <-
             observeEvent(
               ignoreNULL = FALSE,
               ignoreInit = TRUE,
@@ -541,7 +541,7 @@ RangeFilterState <- R6::R6Class( # nolint
             )
 
           # Change in selection updates shapes (lines) on plot and numeric input.
-          private$observers$selection_api <-
+          private$observers[[session$ns("selection_api")]] <-
             observeEvent(
               ignoreNULL = FALSE,
               ignoreInit = TRUE,
@@ -559,7 +559,7 @@ RangeFilterState <- R6::R6Class( # nolint
             )
 
           # Manual input updates selection.
-          private$observers$selection_manual <- observeEvent(
+          private$observers[[session$ns("selection_manual")]] <- observeEvent(
             ignoreNULL = FALSE,
             ignoreInit = TRUE,
             eventExpr = selection_manual(),
@@ -714,7 +714,7 @@ RangeFilterState <- R6::R6Class( # nolint
         # this observer is needed in the situation when private$teal_slice$keep_inf has been
         # changed directly by the api - then it's needed to rerender UI element
         # to show relevant values
-        private$observers$keep_inf_api <- observeEvent(
+        private$observers[[session$ns("keep_inf_api")]] <- observeEvent(
           ignoreNULL = TRUE, # its not possible for range that NULL is selected
           ignoreInit = TRUE, # ignoreInit: should not matter because we set the UI with the desired initial state
           eventExpr = private$get_keep_inf(),
@@ -729,7 +729,7 @@ RangeFilterState <- R6::R6Class( # nolint
           }
         )
 
-        private$observers$keep_inf <- observeEvent(
+        private$observers[[session$ns("keep_inf")]] <- observeEvent(
           ignoreNULL = TRUE, # it's not possible for range that NULL is selected
           ignoreInit = TRUE, # ignoreInit: should not matter because we set the UI with the desired initial state
           eventExpr = input$value,

diff --git a/R/FilterStates.R b/R/FilterStates.R
@@ -372,12 +372,9 @@ FilterStates <- R6::R6Class( # nolint
               added_state_names <- vapply(added_states(), function(x) x$get_state()$id, character(1L))
               logger::log_debug("FilterStates$srv_active@2 triggered by added states: { toString(added_state_names) }")
               lapply(added_states(), function(state) {
-                fs_callback <- state$server(id = fs_to_shiny_ns(state))
-                observeEvent(
-                  once = TRUE, # remove button can be called once, should be destroyed afterwards
-                  ignoreInit = TRUE, # ignoreInit: should not matter because we destroy the previous input set of the UI
-                  eventExpr = fs_callback(), # when remove button is clicked in the FilterState ui
-                  handlerExpr = private$state_list_remove(state$get_state()$id)
+                state$server(
+                  id = fs_to_shiny_ns(state),
+                  function() private$state_list_remove(state$get_state()$id)
                 )
               })
               added_states(NULL)
@@ -642,6 +639,10 @@ FilterStates <- R6::R6Class( # nolint
                   return(TRUE)
                 } else {
                   state$destroy_observers()
+                  lapply(
+                    Filter(function(x) grepl(state$get_state()$id, x, fixed = TRUE), names(private$observers)),
+                    function(x) private$observers[[x]]$destroy()
+                  )
                   FALSE
                 }
               } else {

diff --git a/R/FilteredData.R b/R/FilteredData.R
@@ -499,13 +499,13 @@ FilteredData <- R6::R6Class( # nolint
     #' @param active_datanames (`reactive`)
     #'   defining subset of `self$datanames()` to be displayed.
     #' @return `shiny.tag`
-    ui_filter_panel = function(id, active_datanames = self$datanames()) {
+    ui_filter_panel = function(id, active_datanames = self$datanames) {
       ns <- NS(id)
       tags$div(
         id = ns(NULL), # used for hiding / showing
         include_css_files(pattern = "filter-panel"),
         self$ui_overview(ns("overview")),
-        self$ui_active(ns("active"), active_datanames, private$allow_add)
+        self$ui_active(ns("active"), active_datanames = active_datanames)
       )
     },
 
@@ -547,7 +547,7 @@ FilteredData <- R6::R6Class( # nolint
     #' @param active_datanames (`reactive`)
     #'   defining subset of `self$datanames()` to be displayed.
     #' @return `shiny.tag`
-    ui_active = function(id, active_datanames = self$datanames()) {
+    ui_active = function(id, active_datanames = self$datanames) {
       ns <- NS(id)
       tags$div(
         id = id, # not used, can be used to customize CSS behavior

diff --git a/man/FilterState.Rd b/man/FilterState.Rd
diff --git a/man/FilterStateExpr.Rd b/man/FilterStateExpr.Rd