fix duplicated FilterState when reloading (#609)

Fix Bug found by @vedhav when reloading data.
insightsengineering · Aug 8, 2024 · df87600 · df87600
1 parent 7010a81
commit df87600
Show file tree

Hide file tree

Showing 18 changed files with 148 additions and 108 deletions.
diff --git a/R/FilterState.R b/R/FilterState.R
@@ -215,7 +215,7 @@ FilterState <- R6::R6Class( # nolint
             private$server_inputs("inputs")
           }
 
-          private$observers[[session$ns("state")]] <- observeEvent(
+          private$session_bindings[[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())
@@ -225,7 +225,7 @@ FilterState <- R6::R6Class( # nolint
             }
           )
 
-          private$observers[[session$ns("back")]] <- observeEvent(
+          private$session_bindings[[session$ns("back")]] <- observeEvent(
             eventExpr = input$back,
             handlerExpr = {
               history <- rev(private$state_history())
@@ -236,7 +236,7 @@ FilterState <- R6::R6Class( # nolint
             }
           )
 
-          private$observers[[session$ns("reset")]] <- observeEvent(
+          private$session_bindings[[session$ns("reset")]] <- observeEvent(
             eventExpr = input$reset,
             handlerExpr = {
               slice <- private$state_history()[[1L]]
@@ -246,7 +246,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[[session$ns("state_history")]] <- observeEvent(
+          private$session_bindings[[session$ns("state_history")]] <- observeEvent(
             eventExpr = private$state_history(),
             handlerExpr = {
               shinyjs::disable(id = "back")
@@ -268,25 +268,21 @@ FilterState <- R6::R6Class( # nolint
             }
           )
 
-          private$observers[[session$ns("remove")]] <- observeEvent(
+          private$session_bindings[[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() }")
-
-            if (session$isEnded()) {
-              return(NULL)
-            } # skip input removal if session has ended
-            # remove values from the input list
-            lapply(session$ns(names(input)), .subset2(input, "impl")$.values$remove)
-
-            # remove observers
-            lapply(private$observers, function(x) x$destroy())
-          }
+          private$session_bindings[[session$ns("inputs")]] <- list(
+            destroy = function() {
+              logger::log_debug("Destroying FilterState inputs and observers; id: { private$get_id() }")
+              if (!session$isEnded()) {
+                lapply(session$ns(names(input)), .subset2(input, "impl")$.values$remove)
+              }
+            }
+          )
 
           private$state_history <- reactiveVal(list())
 
@@ -388,17 +384,14 @@ FilterState <- R6::R6Class( # nolint
     },
 
     #' @description
-    #' Destroy observers stored in `private$observers`.
+    #' Destroy inputs and observers stored in `private$session_bindings`.
     #'
-    #' The `destroy_shiny` definition is set in the server method.
     #'
     #' @return `NULL`, invisibly.
     #'
     finalize = function() {
-      if (!is.null(private$destroy_shiny)) {
-        private$destroy_shiny()
-        private$destroy_shiny <- NULL
-      }
+      .finalize_session_bindings(self, private)
+      invisible(NULL)
     }
   ),
 
@@ -412,10 +405,9 @@ FilterState <- R6::R6Class( # nolint
     na_count = integer(0),
     filtered_na_count = NULL, # reactive containing the count of NA in the filtered dataset
     varlabel = character(0), # taken from variable labels in data; displayed in filter cards
-    destroy_shiny = NULL, # function is set in server
     # other
     is_choice_limited = FALSE, # flag whether number of possible choices was limited when specifying filter
-    observers = list(), # stores observers
+    session_bindings = list(), # stores observers and inputs to destroy afterwards
     state_history = NULL, # reactiveVal holding a list storing states this FilterState has had since instantiation
 
     # private methods ----
@@ -771,7 +763,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[[session$ns("keep_na_api")]] <- observeEvent(
+        private$session_bindings[[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(),
@@ -786,7 +778,7 @@ FilterState <- R6::R6Class( # nolint
             }
           }
         )
-        private$observers[[session$ns("keep_na")]] <- observeEvent(
+        private$session_bindings[[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
@@ -412,7 +412,6 @@ ChoicesFilterState <- R6::R6Class( # nolint
         id = id,
         function(input, output, session) {
           logger::log_debug("ChoicesFilterState$server_inputs initializing, id: { private$get_id() }")
-
           # 1. renderUI is used here as an observer which triggers only if output is visible
           #  and if the reactive changes - reactive triggers only if the output is visible.
           # 2. We want to trigger change of the labels only if reactive count changes (not underlying data)
@@ -454,7 +453,7 @@ ChoicesFilterState <- R6::R6Class( # nolint
             })
           })
 
-          private$observers[[session$ns("selection")]] <- if (private$is_checkboxgroup()) {
+          private$session_bindings[[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
@@ -504,13 +503,12 @@ ChoicesFilterState <- R6::R6Class( # nolint
             )
           }
 
-
           private$keep_na_srv("keep_na")
 
           # 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[[session$ns("selection_api")]] <- observeEvent(private$get_selected(), {
+          private$session_bindings[[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[[session$ns("selection_api")]] <- observeEvent(
+          private$session_bindings[[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[[session$ns("selection")]] <- observeEvent(
+          private$session_bindings[[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[[session$ns("reset1")]] <- observeEvent(input$start_date_reset, {
+          private$session_bindings[[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[[session$ns("reset2")]] <- observeEvent(input$end_date_reset, {
+          private$session_bindings[[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[[session$ns("selection_api")]] <- observeEvent(
+          private$session_bindings[[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[[session$ns("selection_start")]] <- observeEvent(
+          private$session_bindings[[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[[session$ns("selection_end")]] <- observeEvent(
+          private$session_bindings[[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[[session$ns("reset1")]] <- observeEvent(
+          private$session_bindings[[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[[session$ns("reset2")]] <- observeEvent(
+          private$session_bindings[[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
@@ -141,16 +141,12 @@ FilterStateExpr <- R6::R6Class( # nolint
     },
 
     #' @description
-    #' Destroy observers stored in `private$observers`.
+    #' Destroy inputs and observers stored in `private$session_bindings`.
     #'
     #' @return `NULL`, invisibly.
     #'
     finalize = function() {
-      lapply(private$observers, function(x) x$destroy())
-
-      if (!is.null(private$destroy_shiny)) {
-        private$destroy_shiny()
-      }
+      .finalize_session_bindings(self, private)
       invisible(NULL)
     },
 
@@ -173,22 +169,21 @@ FilterStateExpr <- R6::R6Class( # nolint
         function(input, output, session) {
           private$server_summary("summary")
 
-          private$observers[[session$ns("remove")]] <- observeEvent(
+          private$session_bindings[[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 FilterStateExpr inputs; id: { private$get_id() }")
-
-            if (session$isEnded()) {
-              return(NULL)
-            } # skip input removal if session has ended
-            # remove values from the input list
-            lapply(session$ns(names(input)), .subset2(input, "impl")$.values$remove)
-          }
+          private$session_bindings[[session$ns("inputs")]] <- list(
+            destroy = function() {
+              logger::log_debug("Destroying FilterState inputs and observers; id: { private$get_id() }")
+              if (!session$isEnded()) {
+                lapply(session$ns(names(input)), .subset2(input, "impl")$.values$remove)
+              }
+            }
+          )
 
           NULL
         }
@@ -245,9 +240,8 @@ FilterStateExpr <- R6::R6Class( # nolint
   # private members ----
 
   private = list(
-    observers = NULL, # stores observers
+    session_bindings = list(), # stores observers and inputs to destroy afterwards
     teal_slice = NULL, # stores reactiveValues
-    destroy_shiny = NULL, # function is set in server
 
     # @description
     # Get id of the teal_slice.

diff --git a/R/FilterStateLogical.R b/R/FilterStateLogical.R
@@ -313,7 +313,7 @@ LogicalFilterState <- R6::R6Class( # nolint
             NULL
           })
 
-          private$observers[[session$ns("selected_api")]] <- observeEvent(
+          private$session_bindings[[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[[session$ns("selection")]] <- observeEvent(
+          private$session_bindings[[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[[session$ns("relayout")]] <- observeEvent(
+          private$session_bindings[[session$ns("relayout")]] <- observeEvent(
             ignoreNULL = FALSE,
             ignoreInit = TRUE,
             eventExpr = relayout_data(),
@@ -540,7 +540,7 @@ RangeFilterState <- R6::R6Class( # nolint
           )
 
           # Change in selection updates shapes (lines) on plot and numeric input.
-          private$observers[[session$ns("selection_api")]] <- observeEvent(
+          private$session_bindings[[session$ns("selection_api")]] <- observeEvent(
             ignoreNULL = FALSE,
             ignoreInit = TRUE,
             eventExpr = private$get_selected(),
@@ -557,7 +557,7 @@ RangeFilterState <- R6::R6Class( # nolint
           )
 
           # Manual input updates selection.
-          private$observers[[session$ns("selection_manual")]] <- observeEvent(
+          private$session_bindings[[session$ns("selection_manual")]] <- observeEvent(
             ignoreNULL = FALSE,
             ignoreInit = TRUE,
             eventExpr = selection_manual(),
@@ -712,7 +712,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[[session$ns("keep_inf_api")]] <- observeEvent(
+        private$session_bindings[[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(),
@@ -727,7 +727,7 @@ RangeFilterState <- R6::R6Class( # nolint
           }
         )
 
-        private$observers[[session$ns("keep_inf")]] <- observeEvent(
+        private$session_bindings[[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,