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