Fix decorator problems after a good first run

[averissimo]

Pull Request

Fixes #1511

Changes description

• Captures errors in teal_transform_data on initialization
  • Which should only be applicable to decorators
• Error is propagated downstream

🤖 Example app

#' Calls all `modules`
#'
#' On the UI side each `teal_modules` is translated to a `tabsetPanel` and each `teal_module` is a
#' `tabPanel`. Both, UI and server are called recursively so that each tab is a separate module and
#' reflect nested structure of `modules` argument.
#'
#' @name module_teal_module
#'
#' @inheritParams module_teal
#'
#' @param data (`reactive` returning `teal_data`)
#'
#' @param slices_global (`reactiveVal` returning `modules_teal_slices`)
#'   see [`module_filter_manager`]
#'
#' @param depth (`integer(1)`)
#'  number which helps to determine depth of the modules nesting.
#'
#' @param datasets (`reactive` returning `FilteredData` or `NULL`)
#'  When `datasets` is passed from the parent module (`srv_teal`) then `dataset` is a singleton
#'  which implies in filter-panel to be "global". When `NULL` then filter-panel is "module-specific".
#'
#' @param data_load_status (`reactive` returning `character`)
#'  Determines action dependent on a data loading status:
#'  - `"ok"` when `teal_data` is returned from the data loading.
#'  - `"teal_data_module failed"` when [teal_data_module()] didn't return  `teal_data`. Disables tabs buttons.
#'  - `"external failed"` when a `reactive` passed to `srv_teal(data)` didn't return `teal_data`. Hides the whole tab
#'    panel.
#'
#' @return
#' output of currently active module.
#' - `srv_teal_module.teal_module` returns `reactiveVal` containing output of the called module.
#' - `srv_teal_module.teal_modules` returns output of module selected by `input$active_tab`.
#'
#' @keywords internal
NULL

#' @rdname module_teal_module
ui_teal_module <- function(id, modules, depth = 0L) {
  checkmate::assert_multi_class(modules, c("teal_modules", "teal_module", "shiny.tag"))
  checkmate::assert_count(depth)
  UseMethod("ui_teal_module", modules)
}

#' @rdname module_teal_module
#' @export
ui_teal_module.default <- function(id, modules, depth = 0L) {
  stop("Modules class not supported: ", paste(class(modules), collapse = " "))
}

#' @rdname module_teal_module
#' @export
ui_teal_module.teal_modules <- function(id, modules, depth = 0L) {
  ns <- NS(id)
  tags$div(
    id = ns("wrapper"),
    do.call(
      switch(as.character(depth),
        "0" = bslib::navset_pill,
        "1" = bslib::navset_tab,
        bslib::navset_underline
      ),
      c(
        # by giving an id, we can reactively respond to tab changes
        list(
          id = ns("active_tab")
        ),
        lapply(
          names(modules$children),
          function(module_id) {
            module_label <- modules$children[[module_id]]$label
            if (is.null(module_label)) {
              module_label <- icon("fas fa-database")
            }
            bslib::nav_panel(
              title = module_label,
              value = module_id, # when clicked this tab value changes input$<tabset panel id>
              ui_teal_module(
                id = ns(module_id),
                modules = modules$children[[module_id]],
                depth = depth + 1L
              )
            )
          }
        )
      )
    )
  )
}

#' @rdname module_teal_module
#' @export
ui_teal_module.teal_module <- function(id, modules, depth = 0L) {
  ns <- NS(id)
  args <- c(list(id = ns("module")), modules$ui_args)

  ui_teal <- tags$div(
    ui_module_validate(ns("validation")),
    tags$div(
      id = ns("teal_module_ui"),
      do.call(what = modules$ui, args = args, quote = TRUE)
    )
  )

  div(
    id = id,
    class = "teal_module",
    uiOutput(ns("data_reactive"), inline = TRUE),
    tagList(
      if (depth >= 2L) tags$div(),
      if (!is.null(modules$datanames)) {
        tagList(
          bslib::layout_sidebar(
            class = "teal-sidebar-layout",
            sidebar = bslib::sidebar(
              id = ns("teal_module_sidebar"),
              class = "teal-sidebar",
              width = getOption("teal.sidebar.width", 250),
              tags$div(
                tags$div(
                  class = "teal-active-data-summary-panel",
                  bslib::accordion(
                    id = ns("data_summary_accordion"),
                    bslib::accordion_panel(
                      "Active Data Summary",
                      tags$div(
                        class = "teal-active-data-summary",
                        ui_data_summary(ns("data_summary"))
                      )
                    )
                  )
                ),
                tags$br(),
                tags$div(
                  class = "teal-filter-panel",
                  ui_filter_data(ns("filter_panel"))
                ),
                if (length(modules$transformators) > 0 && !isTRUE(attr(modules$transformators, "custom_ui"))) {
                  tags$div(
                    tags$br(),
                    tags$div(
                      class = "teal-transform-panel",
                      bslib::accordion(
                        id = ns("data_transform_accordion"),
                        bslib::accordion_panel(
                          "Transform Data",
                          ui_transform_teal_data(
                            ns("data_transform"),
                            transformators = modules$transformators
                          )
                        )
                      )
                    )
                  )
                }
              )
            ),
            ui_teal
          ),
          div(
            id = ns("sidebar_toggle_buttons"),
            class = "sidebar-toggle-buttons",
            actionButton(
              class = "data-summary-toggle btn-outline-primary",
              ns("data_summary_toggle"),
              icon("fas fa-list")
            ),
            actionButton(
              class = "data-filters-toggle btn-outline-secondary",
              ns("data_filters_toggle"),
              icon("fas fa-filter")
            ),
            if (length(modules$transformators) > 0) {
              actionButton(
                class = "data-transforms-toggle btn-outline-primary",
                ns("data_transforms_toggle"),
                icon("fas fa-pen-to-square")
              )
            }
          ),
          tags$script(
            HTML(
              sprintf(
                "
                  $(document).ready(function() {
                    $('#%s').insertAfter('#%s > .bslib-sidebar-layout > button.collapse-toggle');
                  });
                ",
                ns("sidebar_toggle_buttons"),
                id
              )
            )
          )
        )
      } else {
        ui_teal
      }
    )
  )
}

#' @rdname module_teal_module
srv_teal_module <- function(id,
                            data,
                            modules,
                            datasets = NULL,
                            slices_global,
                            reporter = teal.reporter::Reporter$new(),
                            data_load_status = reactive("ok"),
                            is_active = reactive(TRUE)) {
  checkmate::assert_string(id)
  assert_reactive(data)
  checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"))
  assert_reactive(datasets, null.ok = TRUE)
  checkmate::assert_class(slices_global, ".slicesGlobal")
  checkmate::assert_class(reporter, "Reporter")
  assert_reactive(data_load_status)
  UseMethod("srv_teal_module", modules)
}

#' @rdname module_teal_module
#' @export
srv_teal_module.default <- function(id,
                                    data,
                                    modules,
                                    datasets = NULL,
                                    slices_global,
                                    reporter = teal.reporter::Reporter$new(),
                                    data_load_status = reactive("ok"),
                                    is_active = reactive(TRUE)) {
  stop("Modules class not supported: ", paste(class(modules), collapse = " "))
}

#' @rdname module_teal_module
#' @export
srv_teal_module.teal_modules <- function(id,
                                         data,
                                         modules,
                                         datasets = NULL,
                                         slices_global,
                                         reporter = teal.reporter::Reporter$new(),
                                         data_load_status = reactive("ok"),
                                         is_active = reactive(TRUE)) {
  moduleServer(id = id, module = function(input, output, session) {
    logger::log_debug("srv_teal_module.teal_modules initializing the module { deparse1(modules$label) }.")

    observeEvent(data_load_status(), {
      tabs_selector <- sprintf("#%s li a", session$ns("active_tab"))
      if (identical(data_load_status(), "ok")) {
        logger::log_debug("srv_teal_module@1 enabling modules tabs.")
        shinyjs::show("wrapper")
        shinyjs::enable(selector = tabs_selector)
      } else if (identical(data_load_status(), "teal_data_module failed")) {
        logger::log_debug("srv_teal_module@1 disabling modules tabs.")
        shinyjs::disable(selector = tabs_selector)
      } else if (identical(data_load_status(), "external failed")) {
        logger::log_debug("srv_teal_module@1 hiding modules tabs.")
        shinyjs::hide("wrapper")
      }
    })

    modules_output <- sapply(
      names(modules$children),
      function(module_id) {
        srv_teal_module(
          id = module_id,
          data = data,
          modules = modules$children[[module_id]],
          datasets = datasets,
          slices_global = slices_global,
          reporter = reporter,
          is_active = reactive(
            is_active() &&
              input$active_tab == module_id &&
              identical(data_load_status(), "ok")
          )
        )
      },
      simplify = FALSE
    )

    modules_output
  })
}

#' @rdname module_teal_module
#' @export
srv_teal_module.teal_module <- function(id,
                                        data,
                                        modules,
                                        datasets = NULL,
                                        slices_global,
                                        reporter = teal.reporter::Reporter$new(),
                                        data_load_status = reactive("ok"),
                                        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(), modules = modules)
    })
    if (is.null(datasets)) {
      datasets <- eventReactive(data(), {
        req(inherits(data(), "teal_data"))
        logger::log_debug("srv_teal_module@1 initializing module-specific FilteredData")
        teal_data_to_filtered_data(data(), datanames = active_datanames())
      })
    }

    # manage module filters on the module level
    # important:
    #   filter_manager_module_srv needs to be called before filter_panel_srv
    #   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)

    .call_once_when(is_active(), {
      filtered_teal_data <- srv_filter_data(
        "filter_panel",
        datasets = datasets,
        active_datanames = active_datanames,
        data = data,
        is_active = is_active
      )
      is_transform_failed <- reactiveValues()
      transformed_teal_data <- srv_transform_teal_data(
        "data_transform",
        data = filtered_teal_data,
        transformators = modules$transformators,
        modules = modules,
        is_transform_failed = is_transform_failed
      )
      any_transform_failed <- reactive({
        any(unlist(reactiveValuesToList(is_transform_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)
        all_teal_data[c(module_datanames, ".raw_data")]
      })

      srv_module_validate_datanames(
        "validation",
        x = module_teal_data,
        modules = modules,
        show_warn = any_transform_failed,
        message_warn = "One of the transformators failed. Please check its inputs."
      )

      observe({ # Blur and disable main module UI when there are errors with reactive teal_data
        shinyjs::show("teal_module_ui")
        shinyjs::toggleClass("teal_module_ui", "blurred", condition = any_transform_failed())
        shinyjs::toggleState("teal_module_ui", condition = !any_transform_failed())
      })

      summary_table <- srv_data_summary("data_summary", module_teal_data)

      observeEvent(input$data_summary_toggle, {
        bslib::toggle_sidebar(id = "teal_module_sidebar", open = TRUE)
        bslib::accordion_panel_open(id = "data_summary_accordion", values = TRUE)
        bslib::accordion_panel_close(id = "filter_panel-filters-main_filter_accordian", values = TRUE)
        bslib::accordion_panel_close(id = "data_transform_accordion", values = TRUE)
      })

      observeEvent(input$data_filters_toggle, {
        bslib::toggle_sidebar(id = "teal_module_sidebar", open = TRUE)
        bslib::accordion_panel_close(id = "data_summary_accordion", values = TRUE)
        bslib::accordion_panel_open(id = "filter_panel-filters-main_filter_accordian", values = TRUE)
        bslib::accordion_panel_close(id = "data_transform_accordion", values = TRUE)
      })

      observeEvent(input$data_transforms_toggle, {
        bslib::toggle_sidebar(id = "teal_module_sidebar", open = TRUE)
        bslib::accordion_panel_close(id = "data_summary_accordion", values = TRUE)
        bslib::accordion_panel_close(id = "filter_panel-filters-main_filter_accordian", values = TRUE)
        bslib::accordion_panel_open(id = "data_transform_accordion", values = TRUE)
      })

      # 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))
      }
    })

    module_out
  })
}

# This function calls a module server function.
.call_teal_module <- function(modules, datasets, data, reporter) {
  assert_reactive(data)

  # collect arguments to run teal_module
  args <- c(list(id = "module"), modules$server_args)
  if (is_arg_used(modules$server, "reporter")) {
    args <- c(args, list(reporter = reporter))
  }

  if (is_arg_used(modules$server, "datasets")) {
    args <- c(args, datasets = datasets())
    warning("datasets argument is not reactive and therefore it won't be updated when data is refreshed.")
  }

  if (is_arg_used(modules$server, "data")) {
    args <- c(args, data = list(data))
  }

  if (is_arg_used(modules$server, "filter_panel_api")) {
    args <- c(args, filter_panel_api = teal.slice::FilterPanelAPI$new(datasets()))
  }

  if (is_arg_used(modules$server, "id")) {
    do.call(what = modules$server, args = args, quote = TRUE)
  } else {
    do.call(what = callModule, args = c(args, list(module = modules$server)), quote = TRUE)
  }
}

.resolve_module_datanames <- function(data, modules) {
  stopifnot("data must be teal_data object." = inherits(data, "teal_data"))
  if (is.null(modules$datanames) || identical(modules$datanames, "all")) {
    names(data)
  } else {
    intersect(
      names(data), # Keep topological order from teal.data::names()
      .include_parent_datanames(modules$datanames, teal.data::join_keys(data))
    )
  }
}

#' 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),
    ...
  )
}

[averissimo]

This PR will minimize the srv_decorate_teal_data function definition repeated in {tmc} and {tmg}.

• tmg
• tmc

[github-actions]

Unit Test Performance Difference

Test Suite	$Status$	Time on main	$±Time$	$±Tests$	$±Skipped$	$±Failures$	$±Errors$
module_session_info	💚	$19.65$	$-2.14$	$0$	$0$	$0$	$0$
module_teal	💚	$159.27$	$-1.55$	$+1$	$0$	$0$	$0$

Additional test case details

Test Suite	$Status$	Time on main	$±Time$	Test Case
module_session_info	💚	$19.63$	$-2.14$	creation_process_is_invoked_for_teal.lockfile.mode_enabled_and_snapshot_is_copied_to_teal_app.lock_and_removed_after_session_ended

Results for commit 0bc1052

♻️ This comment has been updated with latest results.

[github-actions]

Code Coverage Summary

Filename                          Stmts    Miss  Cover    Missing
------------------------------  -------  ------  -------  ----------------------------------------------------------------------------------------------------------------------------------------
R/checkmate.R                        24       0  100.00%
R/dummy_functions.R                  67      11  83.58%   46, 48, 90-98
R/include_css_js.R                   22      17  22.73%   12-38, 76-82
R/init.R                            142      96  32.39%   137-158, 188-196, 206-231, 234-235, 242-251, 254-263, 266-275, 279-289, 291
R/landing_popup_module.R             34      34  0.00%    22-57
R/module_bookmark_manager.R         161     130  19.25%   47-68, 88-142, 147-148, 160, 207, 242-319
R/module_data_summary.R             177      10  94.35%   25-26, 40, 50, 205, 236-240
R/module_filter_data.R               64       2  96.88%   22-23
R/module_filter_manager.R           230      57  75.22%   56-62, 73-82, 90-95, 108-112, 117-118, 291-314, 340, 367, 379, 386-387
R/module_init_data.R                 74       0  100.00%
R/module_nested_tabs.R              314     172  45.22%   40-212, 244, 269-271, 370-373, 377-380, 384-387, 436
R/module_session_info.R              18       7  61.11%   35-41
R/module_snapshot_manager.R         216     146  32.41%   89-95, 104-113, 121-133, 152-153, 170-180, 184-199, 201-208, 215-230, 234-238, 240-246, 249-262, 265-273, 303-317, 320-331, 334-340, 354
R/module_teal_data.R                149      76  48.99%   43-149
R/module_teal_lockfile.R            131      55  58.02%   33-37, 45-57, 60-62, 76, 86-88, 92-96, 100-102, 110-119, 122, 124, 126-127, 161-162, 196-201
R/module_teal_with_splash.R          33      33  0.00%    24-61
R/module_teal.R                     153      51  66.67%   50-101, 118, 132-133, 172
R/module_transform_data.R           134       8  94.03%   20, 56, 116, 149-153
R/modules.R                         285      53  81.40%   174-178, 233-236, 360-380, 388, 394, 571-577, 590-598, 613-628, 674, 687
R/reporter_previewer_module.R        19       1  94.74%   34
R/show_rcode_modal.R                 23      23  0.00%    17-41
R/tdata.R                            14      14  0.00%    19-61
R/teal_data_module-eval_code.R       24       0  100.00%
R/teal_data_module-within.R           7       0  100.00%
R/teal_data_module.R                 20       0  100.00%
R/teal_data_utils.R                  10       0  100.00%
R/teal_modifiers.R                   71      71  0.00%    26-214
R/teal_reporter.R                    70       8  88.57%   69, 77-82, 131-132, 135, 152
R/teal_slices-store.R                29       0  100.00%
R/teal_slices.R                      63       0  100.00%
R/teal_transform_module.R            45       0  100.00%
R/TealAppDriver.R                   385     385  0.00%    57-776
R/utils.R                           250      38  84.80%   400-449
R/validate_inputs.R                  32       0  100.00%
R/validations.R                      58      37  36.21%   118-406
R/zzz.R                              15      11  26.67%   4-18
TOTAL                              3563    1546  56.61%

Diff against main

Filename                     Stmts    Miss  Cover
-------------------------  -------  ------  -------
R/module_nested_tabs.R          -7       0  -1.19%
R/module_transform_data.R      +18      +1  +0.06%
TOTAL                          +11      +1  +0.11%

Results for commit: 9225ed0

Minimum allowed coverage is 80%

♻️ This comment has been updated with latest results

[github-actions]

Unit Tests Summary

  1 files   26 suites   2m 58s ⏱️
272 tests 226 ✅ 46 💤 0 ❌
469 runs  423 ✅ 46 💤 0 ❌

Results for commit 9225ed0.

♻️ This comment has been updated with latest results.

[averissimo]

📑 Journal (rolling update):

1. (non-documented)
2. Use validate(need(...)) instead of stop() for better shiny handling in module
3. Q: Keep "trigger on success" in summary data?
   • Seems to me that this should be less reactive to errors in transforms

Note: UI changes about placement and what should show where should be discussed #1509

Latest screenshot

Older screenshots

_(nothing to see here yet)_

[averissimo]

I think this should not be in error state or hidden when transformators introduce an error.

The alternative is to use module_teal_data and remove the (newly) introduced summary_data as below.

Q: WDYT?

[llrs-roche]

I like that there is not data summary as it cannot be provided, but maybe it was hidden because this makes the different order pop up the error message more for the users. But I prefer to not have hidding elements messing with the layout of the app and leave the section even if empty.

[llrs-roche]

I left a couple of comments as I couldn't run yet the branch. The most important is to make it easier to pull the branch. I had messed my git config but I fixed it.

It would also great if the example app at the beginning of the PR could be updated to really open an app (to avoid me messing it and test different things)

[llrs-roche]

I like that there is not data summary as it cannot be provided, but maybe it was hidden because this makes the different order pop up the error message more for the users. But I prefer to not have hidding elements messing with the layout of the app and leave the section even if empty.

[llrs-roche]

Code looks good I left a couple of comments but I think this resolves the issue:

2025-05-23_15-00-44.mp4

I think the code on "example app" is not the one that generates the leading screenshots. But if there is further testing to be done let me know, the checks locally (and remotely) run well

[llrs-roche]

As transformed_teal_data depends on the output of filtered_teal_data it can be omitted and I think we would get the same result (at least on the app on the issue it works as before).

Suggested change

	!inherits(try(transformed_teal_data(), silent = TRUE), "teal_data") &&
	inherits(filtered_teal_data(), "teal_data")
	!inherits(try(transformed_teal_data(), silent = TRUE), "teal_data")

[llrs-roche]

I think there is a div with id = "wrapper" for modules tabs, but where does this _panel come from? Would it work on teal modules used directly on shiny? Just thinking aloud after resolving an issue coming from an id not matching between different parts.

[llrs-roche]

Nice trick, never thought about adding two expressions as a single event. Would be the same as to have only data_handled()? Or in reversed order?