introduce decorators for tm_t_crosstable (#806)

Part of https://github.com/insightsengineering/teal/issues/1370

<details><summary> Working Example </summary>

````r
devtools::load_all("../teal")
devtools::load_all(".")


split_by_decorator <- teal_transform_module(
  label = "Footnote",
  ui = function(id) shiny::textInput(
    shiny::NS(id, "text"), "Insert row", "Hello World!" 
  ),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      logger::log_info("🟢 Text called to action!", namespace = "teal.modules.general")
      reactive(
        within(
          data(),
          {
              table <- table %>% insert_rrow(rrow(text))
          },
          text = input$text
        )
      )
    })
  }
)

# CDISC data example
data <- teal_data()
data <- within(data, {
  ADSL <- rADSL
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

app <- init(
  data = data,
  modules = modules(
    tm_t_crosstable(
      label = "Cross Table",
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = variable_choices(data[["ADSL"]], subset = function(data) {
            idx <- !vapply(data, inherits, logical(1), c("Date", "POSIXct", "POSIXlt"))
            return(names(data)[idx])
          }),
          selected = "COUNTRY",
          multiple = TRUE,
          ordered = TRUE,
          fixed = FALSE
        )
      ),
      y = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = variable_choices(data[["ADSL"]], subset = function(data) {
            idx <- vapply(data, is.factor, logical(1))
            return(names(data)[idx])
          }),
          selected = "SEX",
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      decorators = list(split_by_decorator)
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}


````

</details>

---------

Signed-off-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: André Veríssimo <[email protected]>

Author: 3 people

R/tm_t_crosstable.R

@@ -25,6 +25,14 @@
 #'
 #' @inherit shared_params return
 #'
+#' @section Decorating `tm_t_crosstable`:
+#'
+#' This module generates the following objects, which can be modified in place using decorators:
+#' - `table` (`ElementaryTable` - 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.general)
 #' interactive <- function() TRUE
@@ -134,7 +142,8 @@ tm_t_crosstable <- function(label = "Cross Table",
                             show_total = TRUE,
                             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_crosstable")
 
   # Requires Suggested packages
@@ -158,6 +167,7 @@ tm_t_crosstable <- function(label = "Cross Table",
   checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_class(basic_table_args, classes = "basic_table_args")
+  checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE)
   # End of assertions
 
   # Make UI args
@@ -167,7 +177,8 @@ tm_t_crosstable <- function(label = "Cross Table",
     label = label,
     x = x,
     y = y,
-    basic_table_args = basic_table_args
+    basic_table_args = basic_table_args,
+    decorators = decorators
   )
 
   ans <- module(
@@ -184,6 +195,7 @@ tm_t_crosstable <- function(label = "Cross Table",
 
 # UI function for the cross-table module
 ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, post_output, ...) {
+  args <- list(...)
   ns <- NS(id)
   is_single_dataset <- teal.transform::is_single_dataset(x, y)
 
@@ -221,7 +233,8 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p
           checkboxInput(ns("show_percentage"), "Show column percentage", value = show_percentage),
           checkboxInput(ns("show_total"), "Show total column", value = show_total)
         )
-      )
+      ),
+      ui_teal_transform_data(ns("decorate"), transformators = args$decorators)
     ),
     forms = tagList(
       teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
@@ -232,7 +245,7 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p
 }
 
 # Server function for the cross-table module
-srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_args) {
+srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, 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")
@@ -351,7 +364,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
         teal.code::eval_code(
           substitute(
             expr = {
-              lyt <- basic_tables %>%
+              table <- basic_tables %>%
                 split_call %>% # styler: off
                 rtables::add_colcounts() %>%
                 tern::analyze_vars(
@@ -387,19 +400,22 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
           substitute(
             expr = {
               ANL <- tern::df_explicit_na(ANL)
-              tbl <- rtables::build_table(lyt = lyt, df = ANL[order(ANL[[y_name]]), ])
-              tbl
+              table <- rtables::build_table(lyt = table, df = ANL[order(ANL[[y_name]]), ])
             },
             env = list(y_name = y_name)
           )
         )
     })
 
+    decorated_output_q_no_print <- srv_teal_transform_data("decorate", data = output_q, transformators = decorators)
+    decorated_output_q <- reactive(within(decorated_output_q_no_print(), expr = table))
+
     output$title <- renderText(output_q()[["title"]])
 
     table_r <- reactive({
       req(iv_r()$is_valid())
-      output_q()[["tbl"]]
+      req(output_q())
+      decorated_output_q()[["table"]]
     })
 
     teal.widgets::table_with_settings_srv(
@@ -409,7 +425,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(output_q())),
+      verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))),
       title = "Show R Code for Cross-Table"
     )
 
@@ -428,7 +444,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(output_q()))
+        card$append_src(teal.code::get_code(req(decorated_output_q())))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)