From 0c905433a1bdd7bda927d4e3c435ce1770532003 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 1 Aug 2024 05:37:08 +0200 Subject: [PATCH] fix: duplicated slices are lingering the filter panel after DDL reload (#602) # Pull Request Companion of https://github.com/insightsengineering/teal/pull/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 --- R/FilterState.R | 27 +++++++++++++++++++-------- R/FilterStateChoices.R | 8 ++++---- R/FilterStateDate.R | 8 ++++---- R/FilterStateDatettime.R | 10 +++++----- R/FilterStateExpr.R | 14 ++++++++++++-- R/FilterStateLogical.R | 4 ++-- R/FilterStateRange.R | 10 +++++----- R/FilterStates.R | 13 +++++++------ R/FilteredData.R | 6 +++--- man/FilterState.Rd | 5 ++++- man/FilterStateExpr.Rd | 5 ++++- man/FilteredData.Rd | 4 ++-- 12 files changed, 71 insertions(+), 43 deletions(-) diff --git a/R/FilterState.R b/R/FilterState.R index 5d5c5438a..3572a78b2 100644 --- 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 index 4b7d6bcab..401f1f6a1 100644 --- 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 index c81226ca9..97bc3069a 100644 --- 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 index a11e82089..52a3f16be 100644 --- 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 index 9fa262309..07cee220c 100644 --- 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 index 074727f26..54f47c783 100644 --- 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 index ab7dc82b1..ab153ed5d 100644 --- 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 index c8dd0b0d6..164c9ab60 100644 --- 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 index 6b247215b..14a8f612d 100644 --- 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 index 86f8f9888..efeb8b285 100644 --- a/man/FilterState.Rd +++ b/man/FilterState.Rd @@ -200,7 +200,7 @@ and must be executed in reactive or isolated context. \subsection{Method \code{server()}}{ \code{shiny} module server. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{FilterState$server(id)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{FilterState$server(id, remove_callback)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -208,6 +208,9 @@ and must be executed in reactive or isolated context. \describe{ \item{\code{id}}{(\code{character(1)}) \code{shiny} module instance id.} + +\item{\code{remove_callback}}{(\code{function}) +callback to handle removal of this \code{FilterState} object from \code{state_list}} } \if{html}{\out{}} } diff --git a/man/FilterStateExpr.Rd b/man/FilterStateExpr.Rd index bd1ede71f..75eebe154 100644 --- a/man/FilterStateExpr.Rd +++ b/man/FilterStateExpr.Rd @@ -217,7 +217,7 @@ Destroy observers stored in \code{private$observers}. \subsection{Method \code{server()}}{ \code{shiny} module server. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{FilterStateExpr$server(id)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{FilterStateExpr$server(id, remove_callback)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -225,6 +225,9 @@ Destroy observers stored in \code{private$observers}. \describe{ \item{\code{id}}{(\code{character(1)}) \code{shiny} module instance id.} + +\item{\code{remove_callback}}{(\code{function}) +callback to handle removal of this \code{FilterState} object from \code{state_list}} } \if{html}{\out{}} } diff --git a/man/FilteredData.Rd b/man/FilteredData.Rd index fda417640..eeeab4f84 100644 --- a/man/FilteredData.Rd +++ b/man/FilteredData.Rd @@ -525,7 +525,7 @@ flag specifying whether to include anchored filter states.} top-level \code{shiny} module for the filter panel in the \code{teal} app. Contains 1) filter overview panel, 2) filter active panel, and 3) add filters panel. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{FilteredData$ui_filter_panel(id, active_datanames = self$datanames())}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{FilteredData$ui_filter_panel(id, active_datanames = self$datanames)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -576,7 +576,7 @@ the filter panel will be hidden.} \subsection{Method \code{ui_active()}}{ Server module responsible for displaying active filters. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{FilteredData$ui_active(id, active_datanames = self$datanames())}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{FilteredData$ui_active(id, active_datanames = self$datanames)}\if{html}{\out{
}} } \subsection{Arguments}{