Delays transform modules reactivity until tab is active (#1373)

# Pull Request

Fixes #1303

### Changes description

- [x] Unifying function for delayed trigger of module and
transformations
- [x] Filter manager crash when clicked with an app that has module
specific filters
- [x] Fix bug detected when app is called with `teal_data_module`
  - One of my testing apps is failing (see below)
- [x] Add tests

### Topics to discuss

- **Functionality change**: this PR will delay the first module
reactivity execution until data is pulled from `teal_data_module`

<details>

<summary>Sample app for bug</summary>

```R
options(
  teal.log_level = "INFO",
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)

# pkgload::load_all("../teal.data")
# pkgload::load_all("../teal.slice")
pkgload::load_all("../teal")

my_transformers <- list(
  teal_transform_module(
    label = "Keep first 6 from IRIS",
    ui = function(id) {
      ns <- NS(id)
      div(
        checkboxInput(ns("check"), label = "Toggle `head(iris)`"),
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        eventReactive(input$check, {
          print("Check triggered")
          req(data())
          if (input$check) {
            within(data(), iris <- head(iris, 6))
          } else {
            data()
          }
        })
      })
    }
  )
)


data <- teal::teal_data_module(
  ui = function(id) {
    ns <- shiny::NS(id)
    shiny::tagList(
      shiny::tags$head(
        shiny::tags$style(shiny::HTML("
          .teal-data-module {
            border: 1px solid rgba(0, 0, 0, .5);
            border-radius: 4px;
            padding: 1em;
            margin: .2em;
          }
          .teal-data-module .shiny-options-group {
            display: flex;
            flex-wrap: wrap;
            column-gap: 1em;
          }
          .teal-data-module .shiny-options-group  .checkbox {
            margin-top: 1em;
            margin-bottom: 0;
          }
        "))
      ),
      shiny::tags$h2("Data Module"),
      shiny::div(
        class = "teal-data-module",
        shiny::checkboxGroupInput(
          ns("datasets"),
          "Datasets",
          choices = c("ADSL", "ADTTE", "iris", "CO2", "miniACC"),
          selected = c("ADSL", "ADTTE", "iris", "CO2")
        ),
        shiny::actionButton(ns("submit"), label = "Submit")
      )
    )
  },
  server = function(id, ...) {
    shiny::moduleServer(id, function(input, output, session) {
      code <- list(
        ADSL = expression(ADSL <- teal.data::rADSL),
        ADTTE = expression({
          ADTTE <- teal.data::rADTTE
          ADTTE$CNSRL <- as.logical(ADTTE$CNSR)
        }),
        iris = expression(iris <- iris),
        CO2 = expression({
          CO2 <- CO2
          factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L))))
          CO2[factors] <- lapply(CO2[factors], as.character)
        }),
        miniACC = expression({
          data(
            "miniACC",
            package = "MultiAssayExperiment",
            envir = environment(),
            overwrite = TRUE
          )
          miniACC <- miniACC
        })
      )

      datasets <- reactive(input$datasets)

      shiny::eventReactive(input$submit, {
        code_to_eval <- do.call(c, code[datasets()])
        data <- teal.code::eval_code(teal.data::teal_data(), code_to_eval)

        join_keys(data) <- default_cdisc_join_keys[datasets()]
        teal.data::datanames(data) <- datasets()
        data
      })
    })
  }, once = FALSE
)

teal::init(
  data = data,
  modules = teal::modules(
    teal::example_module(label = "A", datanames = NULL, transformers = my_transformers),
    teal::example_module(label = "B", transformers = my_transformers)
  ),
  filter = teal::teal_slices(
    # # FilterRange
    teal.slice::teal_slice("ADSL", "AGE", selected = c(18L, 65L)),
    # # FilterExpr
    teal_slice(
      dataname = "ADSL",
      id = "Female adults",
      expr = "SEX == 'F' & AGE >= 18",
      title = "Female adults"
    ),
    # # FilterDatetime
    teal_slice(
      dataname = "ADTTE",
      varname = "ADTM",
      id = "Analysis DTM",
      selected = c("2019-03-25 07:06:18", "2020-01-22 15:03:58"),
      title = "Female adults"
    ),
    # # FilterDate with LSTALVDT
    teal_slice(
      dataname = "ADSL",
      varname = "LSTALVDT",
      id = "Last Alive Date",
      selected = c("2022-02-14", "2022-11-24"),
      title = "Last Alive Date"
    ),
    # FilterEmpty
    # FilterLogical with CNSRL
    teal_slice(
      dataname = "ADTTE",
      varname = "CNSRL",
      id = "Censored",
      selected = TRUE,
      title = "Censored"
    ),
    module_specific = FALSE,
    teal.slice::teal_slice("ADSL", "SEX")
  ),
  title = "yada"
) |>
  shiny::runApp()
```

</details>

---------

Signed-off-by: André Veríssimo <[email protected]>
Co-authored-by: m7pr <[email protected]>
Co-authored-by: Marcin <[email protected]>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
Co-authored-by: Dawid Kałędkowski <[email protected]>

R/module_nested_tabs.R

@@ -214,7 +214,11 @@ srv_teal_module.teal_modules <- function(id,
           datasets = datasets,
           slices_global = slices_global,
           reporter = reporter,
-          is_active = reactive(is_active() && input$active_tab == module_id)
+          is_active = reactive(
+            is_active() &&
+              input$active_tab == module_id &&
+              identical(data_load_status(), "ok")
+          )
         )
       },
       simplify = FALSE
@@ -236,6 +240,8 @@ srv_teal_module.teal_module <- function(id,
                                         is_active = reactive(TRUE)) {
   logger::log_debug("srv_teal_module.teal_module initializing the module: { deparse1(modules$label) }.")
   moduleServer(id = id, module = function(input, output, session) {
+    module_out <- reactiveVal()
+
     active_datanames <- reactive({
       .resolve_module_datanames(data = data_rv(), modules = modules)
     })
@@ -253,77 +259,77 @@ srv_teal_module.teal_module <- function(id,
     #   Because available_teal_slices is used in FilteredData$srv_available_slices (via srv_filter_panel)
     #   and if it is not set, then it won't be available in the srv_filter_panel
     srv_module_filter_manager(modules$label, module_fd = datasets, slices_global = slices_global)
-    filtered_teal_data <- srv_filter_data(
-      "filter_panel",
-      datasets = datasets,
-      active_datanames = active_datanames,
-      data_rv = data_rv,
-      is_active = is_active
-    )
 
-    is_transformer_failed <- reactiveValues()
-    transformed_teal_data <- srv_transform_data(
-      "data_transform",
-      data = filtered_teal_data,
-      transforms = modules$transformers,
-      modules = modules,
-      is_transformer_failed = is_transformer_failed
-    )
-    any_transformer_failed <- reactive({
-      any(unlist(reactiveValuesToList(is_transformer_failed)))
-    })
-    observeEvent(any_transformer_failed(), {
-      if (isTRUE(any_transformer_failed())) {
-        shinyjs::hide("teal_module_ui")
-        shinyjs::hide("validate_datanames")
-        shinyjs::show("transformer_failure_info")
-      } else {
-        shinyjs::show("teal_module_ui")
-        shinyjs::show("validate_datanames")
-        shinyjs::hide("transformer_failure_info")
-      }
-    })
+    call_once_when(is_active(), {
+      filtered_teal_data <- srv_filter_data(
+        "filter_panel",
+        datasets = datasets,
+        active_datanames = active_datanames,
+        data_rv = data_rv,
+        is_active = is_active
+      )
+      is_transformer_failed <- reactiveValues()
+      transformed_teal_data <- srv_transform_data(
+        "data_transform",
+        data = filtered_teal_data,
+        transforms = modules$transformers,
+        modules = modules,
+        is_transformer_failed = is_transformer_failed
+      )
+      any_transformer_failed <- reactive({
+        any(unlist(reactiveValuesToList(is_transformer_failed)))
+      })
 
-    module_teal_data <- reactive({
-      req(inherits(transformed_teal_data(), "teal_data"))
-      all_teal_data <- transformed_teal_data()
-      module_datanames <- .resolve_module_datanames(data = all_teal_data, modules = modules)
-      .subset_teal_data(all_teal_data, module_datanames)
-    })
+      observeEvent(any_transformer_failed(), {
+        if (isTRUE(any_transformer_failed())) {
+          shinyjs::hide("teal_module_ui")
+          shinyjs::hide("validate_datanames")
+          shinyjs::show("transformer_failure_info")
+        } else {
+          shinyjs::show("teal_module_ui")
+          shinyjs::show("validate_datanames")
+          shinyjs::hide("transformer_failure_info")
+        }
+      })
 
-    srv_validate_reactive_teal_data(
-      "validate_datanames",
-      data = module_teal_data,
-      modules = modules
-    )
+      module_teal_data <- reactive({
+        req(inherits(transformed_teal_data(), "teal_data"))
+        all_teal_data <- transformed_teal_data()
+        module_datanames <- .resolve_module_datanames(data = all_teal_data, modules = modules)
+        .subset_teal_data(all_teal_data, module_datanames)
+      })
 
-    summary_table <- srv_data_summary("data_summary", module_teal_data)
-
-    # Call modules.
-    module_out <- reactiveVal(NULL)
-    if (!inherits(modules, "teal_module_previewer")) {
-      obs_module <- observeEvent(
-        # wait for module_teal_data() to be not NULL but only once:
-        ignoreNULL = TRUE,
-        once = TRUE,
-        eventExpr = module_teal_data(),
-        handlerExpr = {
-          module_out(.call_teal_module(modules, datasets, module_teal_data, reporter))
-        }
+      srv_validate_reactive_teal_data(
+        "validate_datanames",
+        data = module_teal_data,
+        modules = modules
       )
-    } else {
-      # Report previewer must be initiated on app start for report cards to be included in bookmarks.
-      # When previewer is delayed, cards are bookmarked only if previewer has been initiated (visited).
-      module_out(.call_teal_module(modules, datasets, module_teal_data, reporter))
-    }
 
-    # todo: (feature request) add a ReporterCard to the reporter as an output from the teal_module
-    #       how to determine if module returns a ReporterCard so that reportPreviewer is needed?
-    #       Should we insertUI of the ReportPreviewer then?
-    #       What about attr(module, "reportable") - similar to attr(module, "bookmarkable")
-    if ("report" %in% names(module_out)) {
-      # (reactively) add card to the reporter
-    }
+      summary_table <- srv_data_summary("data_summary", module_teal_data)
+
+      # Call modules.
+      if (!inherits(modules, "teal_module_previewer")) {
+        obs_module <- call_once_when(
+          !is.null(module_teal_data()),
+          ignoreNULL = TRUE,
+          handlerExpr = {
+            module_out(.call_teal_module(modules, datasets, module_teal_data, reporter))
+          }
+        )
+      } else {
+        # Report previewer must be initiated on app start for report cards to be included in bookmarks.
+        # When previewer is delayed, cards are bookmarked only if previewer has been initiated (visited).
+        module_out(.call_teal_module(modules, datasets, module_teal_data, reporter))
+      }
+
+      # todo: (feature request) add a ReporterCard to the reporter as an output from the teal_module
+      #       how to determine if module returns a ReporterCard so that reportPreviewer is needed?
+      #       Should we insertUI of the ReportPreviewer then?
+      #       What about attr(module, "reportable") - similar to attr(module, "bookmarkable")
+      if ("report" %in% names(module_out)) {
+        # (reactively) add card to the reporter
+      }
+    })
 
     module_out
   })
@@ -368,3 +374,39 @@ srv_teal_module.teal_module <- function(id,
     )
   }
 }
+
+#' Calls expression when condition is met
+#'
+#' Function postpones `handlerExpr` to the moment when `eventExpr` (condition) returns `TRUE`,
+#' otherwise nothing happens.
+#' @param eventExpr A (quoted or unquoted) logical expression that represents the event;
+#' this can be a simple reactive value like input$click, a call to a reactive expression
+#' like dataset(), or even a complex expression inside curly braces.
+#' @param ... additional arguments passed to `observeEvent` with the exception of `eventExpr` that is not allowed.
+#' @inheritParams shiny::observeEvent
+#'
+#' @return An observer.
+#'
+#' @keywords internal
+call_once_when <- function(eventExpr, # nolint: object_name.
+                           handlerExpr, # nolint: object_name.
+                           event.env = parent.frame(), # nolint: object_name.
+                           handler.env = parent.frame(), # nolint: object_name.
+                           ...) {
+  event_quo <- rlang::new_quosure(substitute(eventExpr), env = event.env)
+  handler_quo <- rlang::new_quosure(substitute(handlerExpr), env = handler.env)
+
+  # When `condExpr` is TRUE, then `handlerExpr` is evaluated once.
+  activator <- reactive({
+    if (isTRUE(rlang::eval_tidy(event_quo))) {
+      TRUE
+    }
+  })
+
+  observeEvent(
+    eventExpr = activator(),
+    once = TRUE,
+    handlerExpr = rlang::eval_tidy(handler_quo),
+    ...
+  )
+}

R/teal_data_module.R

@@ -104,6 +104,10 @@ teal_data_module <- function(ui, server, label = "data module", once = TRUE) {
 #' `shiny` module server function; that takes `id` and `data` argument,
 #' where the `id` is the module id and `data` is the reactive `teal_data` input.
 #' The server function must return reactive expression containing `teal_data` object.
+#'
+#' The server function definition should not use `eventReactive` as it may lead to
+#' unexpected behavior.
+#' See `vignettes("data-transform-as-shiny-module")` for more information.
 #' @param datanames (`character`)
 #'  Names of the datasets that are relevant for the module. The
 #'  filter panel will only display filters for specified `datanames`. The keyword `"all"` will show
@@ -149,6 +153,18 @@ teal_transform_module <- function(ui = function(id) NULL,
       ui = ui,
       server = function(id, data) {
         data_out <- server(id, data)
+
+        if (inherits(data_out, "reactive.event")) {
+          # This warning message partially detects when `eventReactive` is used in `data_module`.
+          warning(
+            "teal_transform_module() ",
+            "Using eventReactive in teal_transform module server code should be avoided as it ",
+            "may lead to unexpected behavior. See the vignettes for more information  ",
+            "(`vignette(\"data-transform-as-shiny-module\", package = \"teal\")`).",
+            call. = FALSE
+          )
+        }
+
         decorate_err_msg(
           assert_reactive(data_out),
           pre = sprintf("From: 'teal_transform_module()':\nA 'teal_transform_module' with \"%s\" label:", label),

inst/WORDLIST

@@ -1,28 +1,29 @@
 Biomarker
-CDISC
-Forkers
-Hoffmann
-MAEs
-ORCID
-Reproducibility
-TLG
-UI
-UX
 bookmarkable
+CDISC
 cloneable
 customizable
 favicon
 favicons
+Forkers
 funder
+Hoffmann
 lockfile
+MAEs
 omics
+ORCID
 pre
 programmatically
+quosure
 reactively
 repo
+Reproducibility
 reproducibility
 summarization
 tabset
 themer
 theming
+TLG
+UI
 uncheck
+UX