introduce decorators for tm_g_pp_vitals

R/tm_g_pp_vitals.R

@@ -123,7 +123,7 @@ template_vitals <- function(dataname = "ANL",
           color = paramcd_levels_e
         )
 
-        result_plot <- ggplot2::ggplot(data = vitals, mapping = ggplot2::aes(x = xaxis)) + # replaced VSDY
+        plot <- ggplot2::ggplot(data = vitals, mapping = ggplot2::aes(x = xaxis)) + # replaced VSDY
           ggplot2::geom_line(
             data = vitals,
             mapping = ggplot2::aes(y = aval_var, color = paramcd),
@@ -172,8 +172,6 @@ template_vitals <- function(dataname = "ANL",
           labs +
           ggthemes +
           themes
-
-        print(result_plot)
       },
       env = list(
         dataname = as.name(dataname),
@@ -211,6 +209,16 @@ template_vitals <- function(dataname = "ANL",
 #'
 #' @inherit module_arguments return
 #'
+#'
+#' @section Decorating `tm_g_pp_vitals`:
+#'
+#' This module generates the following objects, which can be modified in place using decorators:
+#' - `plot` (`ggplot2`)
+#'
+#' 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
@@ -271,7 +279,8 @@ tm_g_pp_vitals <- function(label,
                            plot_width = NULL,
                            pre_output = NULL,
                            post_output = NULL,
-                           ggplot2_args = teal.widgets::ggplot2_args()) {
+                           ggplot2_args = teal.widgets::ggplot2_args(),
+                           decorators = NULL) {
   if (lifecycle::is_present(aval)) {
     aval_var <- aval
     warning(
@@ -307,6 +316,15 @@ tm_g_pp_vitals <- function(label,
   checkmate::assert_multi_class(aval_var, c("choices_selected", "data_extract_spec"), null.ok = TRUE)
   checkmate::assert_multi_class(xaxis, c("choices_selected", "data_extract_spec"), null.ok = TRUE)
 
+  if (checkmate::test_list(decorators, "teal_transform_module", null.ok = TRUE)) {
+    decorators <- if (checkmate::test_names(names(decorators), subset.of = c("default", "plot"))) {
+      lapply(decorators, list)
+    } else {
+      list(default = decorators)
+    }
+  }
+  assert_decorators(decorators, null.ok = TRUE, names = c("default", "plot"))
+
   args <- as.list(environment())
   data_extract_list <- list(
     paramcd = `if`(is.null(paramcd), NULL, cs_to_des_select(paramcd, dataname = dataname)),
@@ -328,7 +346,8 @@ tm_g_pp_vitals <- function(label,
         patient_col = patient_col,
         plot_height = plot_height,
         plot_width = plot_width,
-        ggplot2_args = ggplot2_args
+        ggplot2_args = ggplot2_args,
+        decorators = decorators
       )
     ),
     datanames = c(dataname, parentname)
@@ -378,6 +397,7 @@ ui_g_vitals <- function(id, ...) {
         data_extract_spec = ui_args$aval_var,
         is_single_dataset = is_single_dataset_value
       ),
+      ui_decorate_teal_data(ns("decorator"), decorators = subset_decorators("plot", ui_args$decorators)),
       teal.widgets::panel_item(
         title = "Plot settings",
         collapsed = TRUE,
@@ -409,7 +429,8 @@ srv_g_vitals <- function(id,
                          plot_height,
                          plot_width,
                          label,
-                         ggplot2_args) {
+                         ggplot2_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")
@@ -553,7 +574,13 @@ srv_g_vitals <- function(id,
         teal.code::eval_code(as.expression(unlist(my_calls)))
     })
 
-    plot_r <- reactive(all_q()[["result_plot"]])
+    decorated_all_q <- srv_decorate_teal_data(
+      id = "decorator",
+      data = all_q,
+      decorators = subset_decorators("plot", decorators),
+      expr = print(plot)
+    )
+    plot_r <- reactive(decorated_all_q()[["plot"]])
 
     pws <- teal.widgets::plot_with_settings_srv(
       id = "vitals_plot",
@@ -564,7 +591,7 @@ srv_g_vitals <- function(id,
 
     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_all_q()))),
       title = label
     )
 
@@ -583,7 +610,7 @@ srv_g_vitals <- 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_all_q())))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)