Adds decorators to tm_t_pp_medical_history (#1289)

Part of insightsengineering/teal#1371

<details>
<summary>Working example</summary>

```r
pkgload::load_all("../teal.modules.clinical", export_all = FALSE)
# Example below

rlisting_footer <- function(default_footer = "I am a good footer", .var_to_replace = "table_listing") {
  teal_transform_module(
    label = "New row",
    ui = function(id) shiny::textInput(shiny::NS(id, "footer"), "footer", value = default_footer),
    server = make_teal_transform_server(
      substitute({
        rlistings::main_footer(.var_to_replace) <- footer
      }, env = list(.var_to_replace = as.name(.var_to_replace)))
    )
  )
}

data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  ADMH <- tmc_ex_admh
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADMH <- data[["ADMH"]]

app <- init(
  data = data,
  modules = modules(
    tm_t_pp_medical_history(
      label = "Medical History",
      dataname = "ADMH",
      parentname = "ADSL",
      patient_col = "USUBJID",
      mhterm = choices_selected(
        choices = variable_choices(ADMH, c("MHTERM")),
        selected = "MHTERM"
      ),
      mhbodsys = choices_selected(
        choices = variable_choices(ADMH, "MHBODSYS"),
        selected = "MHBODSYS"
      ),
      mhdistat = choices_selected(
        choices = variable_choices(ADMH, "MHDISTAT"),
        selected = "MHDISTAT"
      ),
      decorators = list(insert_rrow_decorator())
    )
  )
) |> shiny::runApp()
```

</details>

---------

Co-authored-by: Marcin <[email protected]>

R/tm_t_pp_medical_history.R

@@ -40,7 +40,7 @@ template_medical_history <- function(dataname = "ANL",
         dplyr::distinct() %>%
         `colnames<-`(labels)
 
-      result <- rtables::basic_table() %>%
+      table <- rtables::basic_table() %>%
         rtables::split_cols_by_multivar(colnames(result_raw)[2:3]) %>%
         rtables::split_rows_by(
           colnames(result_raw)[1],
@@ -54,9 +54,7 @@ template_medical_history <- function(dataname = "ANL",
         rtables::analyze_colvars(function(x) x[seq_along(x)]) %>%
         rtables::build_table(result_raw)
 
-      main_title(result) <- paste("Patient ID:", patient_id)
-
-      result
+      main_title(table) <- paste("Patient ID:", patient_id)
     }, env = list(
       dataname = as.name(dataname),
       mhbodsys = as.name(mhbodsys),
@@ -88,6 +86,13 @@ template_medical_history <- function(dataname = "ANL",
 #'   available choices and preselected option for the `MHDISTAT` variable from `dataname`.
 #'
 #' @inherit module_arguments return
+#' @section Decorating Module:
+#'
+#' This module generates the following objects, which can be modified in place using decorators:
+#' - `table` (`TableTree` - output of `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)
@@ -141,7 +146,8 @@ tm_t_pp_medical_history <- function(label,
                                     mhbodsys = NULL,
                                     mhdistat = NULL,
                                     pre_output = NULL,
-                                    post_output = NULL) {
+                                    post_output = NULL,
+                                    decorators = NULL) {
   message("Initializing tm_t_pp_medical_history")
   checkmate::assert_string(label)
   checkmate::assert_string(dataname)
@@ -152,6 +158,8 @@ tm_t_pp_medical_history <- function(label,
   checkmate::assert_class(mhdistat, "choices_selected", null.ok = TRUE)
   checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
   checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
+  decorators <- normalize_decorators(decorators)
+  assert_decorators(decorators, null.ok = TRUE, "table")
 
   args <- as.list(environment())
   data_extract_list <- list(
@@ -171,7 +179,8 @@ tm_t_pp_medical_history <- function(label,
         dataname = dataname,
         parentname = parentname,
         label = label,
-        patient_col = patient_col
+        patient_col = patient_col,
+        decorators = decorators
       )
     ),
     datanames = c(dataname, parentname)
@@ -221,7 +230,8 @@ ui_t_medical_history <- function(id, ...) {
         label = "Select MHDISTAT variable:",
         data_extract_spec = ui_args$mhdistat,
         is_single_dataset = is_single_dataset_value
-      )
+      ),
+      ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(ui_args$decorators, "table"))
     ),
     forms = tagList(
       teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
@@ -242,7 +252,8 @@ srv_t_medical_history <- function(id,
                                   mhterm,
                                   mhbodsys,
                                   mhdistat,
-                                  label) {
+                                  label,
+                                  decorators) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
@@ -303,6 +314,7 @@ srv_t_medical_history <- function(id,
         teal.code::eval_code(as.expression(anl_inputs()$expr))
     })
 
+    # Generate r code for the analysis.
     all_q <- reactive({
       teal::validate_inputs(iv_r())
 
@@ -335,16 +347,27 @@ srv_t_medical_history <- function(id,
         teal.code::eval_code(as.expression(unlist(my_calls)))
     })
 
-    table_r <- reactive(all_q()[["result"]])
+    # Decoration of table output.
+    decorated_table_q <- srv_decorate_teal_data(
+      id = "decorator",
+      data = all_q,
+      decorators = select_decorators(decorators, "table"),
+      expr = table
+    )
+
+    # Outputs to render.
+    table_r <- reactive(decorated_table_q()[["table"]])
 
     teal.widgets::table_with_settings_srv(
       id = "table",
       table_r = table_r
     )
 
+    # Render R code.
+    source_code_r <- reactive(teal.code::get_code(req(decorated_table_q())))
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(all_q())),
+      verbatim_content = source_code_r,
       title = label
     )
 
@@ -363,7 +386,7 @@ srv_t_medical_history <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(all_q()))
+        card$append_src(source_code_r())
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)