Introduce decorators for tm_t_exposure

R/tm_t_exposure.R

@@ -189,17 +189,16 @@ template_exposure <- function(parentname,
 
   y$table <- substitute(
     expr = {
-      result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
-      result
+      table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
     },
     env = list(parent = as.name(parentname))
   )
 
   if (drop_levels) {
     y$table <- substitute(
       expr = {
-        result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
-        rtables::prune_table(result)
+        table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
+        table <- rtables::prune_table(table)
       },
       env = list(parent = as.name(parentname))
     )
@@ -224,9 +223,18 @@ template_exposure <- function(parentname,
 #'   parameter category values.
 #' @param paramcd_label (`character`)\cr the column from the dataset where the value will be used to
 #'   label the argument `paramcd`.
+#' @param decorators `r roxygen_decorators_param("tm_t_exposure")`
 #'
 #' @inherit module_arguments return seealso
 #'
+#' @section Decorating `tm_t_exposure`:
+#'
+#' This module generates the following objects, which can be modified in place using decorators:
+#' - `table` (`TableTree` as created from `rtables::build_table`)
+#'
+#' For additional details and examples of decorators, refer to the vignette
+#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation.
+#'
 #' @examplesShinylive
 #' library(teal.modules.clinical)
 #' interactive <- function() TRUE
@@ -324,7 +332,8 @@ tm_t_exposure <- function(label,
                           na_level = default_na_str(),
                           pre_output = NULL,
                           post_output = NULL,
-                          basic_table_args = teal.widgets::basic_table_args()) {
+                          basic_table_args = teal.widgets::basic_table_args(),
+                          decorators = NULL) {
   message("Initializing tm_t_exposure")
   checkmate::assert_string(label)
   checkmate::assert_string(dataname)
@@ -344,6 +353,8 @@ tm_t_exposure <- function(label,
   checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
   checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
   checkmate::assert_class(basic_table_args, "basic_table_args")
+  decorators <- normalize_decorators(decorators)
+  assert_decorators(decorators, "table", null.ok = TRUE)
 
   data_extract_list <- list(
     paramcd = cs_to_des_filter(paramcd, dataname = dataname),
@@ -371,7 +382,8 @@ tm_t_exposure <- function(label,
         total_row_label = total_row_label,
         na_level = na_level,
         basic_table_args = basic_table_args,
-        paramcd_label = paramcd_label
+        paramcd_label = paramcd_label,
+        decorators = decorators
       )
     ),
     datanames = teal.transform::get_extract_datanames(data_extract_list)
@@ -430,6 +442,7 @@ ui_t_exposure <- function(id, ...) {
       ),
       checkboxInput(ns("add_total_row"), "Add Total row", value = a$add_total_row),
       checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
+      ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")),
       teal.widgets::panel_group(
         teal.widgets::panel_item(
           "Additional Variables Info",
@@ -481,7 +494,8 @@ srv_t_exposure <- function(id,
                            label,
                            total_label,
                            total_row_label,
-                           basic_table_args = basic_table_args) {
+                           basic_table_args = basic_table_args,
+                           decorators) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
@@ -631,7 +645,14 @@ srv_t_exposure <- function(id,
     })
 
     # Outputs to render.
-    table_r <- reactive(all_q()[["result"]])
+    decorated_table_q <- srv_decorate_teal_data(
+      id = "decorator",
+      data = all_q,
+      decorators = select_decorators(decorators, "table"),
+      expr = table
+    )
+
+    table_r <- reactive(decorated_table_q()[["table"]])
 
     teal.widgets::table_with_settings_srv(
       id = "table",
@@ -641,7 +662,7 @@ srv_t_exposure <- function(id,
     # Render R code.
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(all_q())),
+      verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))),
       title = label
     )
 
@@ -660,7 +681,7 @@ srv_t_exposure <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(all_q()))
+        card$append_src(teal.code::get_code(req(decorated_table_q())))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)