Delays transform modules reactivity until tab is active

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,19 @@ 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(
+            paste(
+              "srv_teal_data",
+              "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\")`)."
+            )
+          )
+        }
+
         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

tests/testthat/test-module_teal.R

@@ -1588,25 +1588,37 @@ testthat::describe("srv_teal teal_module(s) transformer", {
   })
 
   testthat::it("fails when transformer doesn't return reactive", {
-    testthat::expect_error(
-      testServer(
-        app = srv_teal,
-        args = list(
-          id = "test",
-          data = teal.data::teal_data(iris = iris),
-          modules = modules(
-            module(
-              server = function(id, data) data,
-              transformers = list(
-                teal_transform_module(
-                  ui = function(id) NULL,
-                  server = function(id, data) "whatever"
+    testthat::expect_warning(
+      # error decorator is mocked to avoid showing the trace error during the
+      # test.
+      # This tests works without the mocking, but it's more verbose.
+      testthat::with_mocked_bindings(
+        testServer(
+          app = srv_teal,
+          args = list(
+            id = "test",
+            data = teal.data::teal_data(iris = iris),
+            modules = modules(
+              module(
+                server = function(id, data) data,
+                transformers = list(
+                  teal_transform_module(
+                    ui = function(id) NULL,
+                    server = function(id, data) "whatever"
+                  )
                 )
               )
             )
-          )
+          ),
+          expr = {
+            session$setInputs("teal_modules-active_tab" = "module")
+            session$flushReact()
+          }
         ),
-        expr = {}
+        decorate_err_msg = function(x, ...) {
+          testthat::expect_error(x, "Must be a reactive")
+          warning(tryCatch(x, error = function(e) e$message))
+        },
       ),
       "Must be a reactive"
     )

vignettes/data-transform-as-shiny-module.Rmd

@@ -94,6 +94,10 @@ if (interactive()) {
 }
 ```
 
+_Note_: It is recommended to return `reactive()` with `teal_data()` in `server` code of a `teal_transform_module` as this is more robust for maintaining the reactivity of Shiny.
+If you are planning on using `eventReactive()` in the server, the event should include `data()` _(example `eventReactive(list(input$a, data()), {...})`)_.
+More in [this discussion](https://github.com/insightsengineering/teal/issues/1303#issuecomment-2286239832).
+
 ### Multiple Transformers
 
 Note that we can add multiple `teal` transformers by including `teal_transform_module` in a list.