Improvement on decorators

DESCRIPTION

@@ -35,7 +35,7 @@ Imports:
     DT (>= 0.13),
     forcats (>= 1.0.0),
     grid,
-    lifecycle (>= 0.2.0),
+    rlistings (>= 0.2.8),
     scales,
     shinyjs,
     shinyTree (>= 0.2.8),
@@ -66,6 +66,7 @@ Suggests:
     jsonlite,
     knitr (>= 1.42),
     lattice (>= 0.18-4),
+    lifecycle (>= 0.2.0),
     logger (>= 0.2.0),
     MASS,
     nestcolor (>= 0.1.0),

R/roxygen2_templates.R

@@ -1,18 +1,4 @@
 # nocov start
-roxygen_decorators_param <- function(module_name) {
-  paste(
-    sep = " ",
-    lifecycle::badge("experimental"),
-    " (`list` of `teal_transform_module`, named `list` of `teal_transform_module` or",
-    "`NULL`) optional, if not `NULL`, decorator for tables or plots included in the module.",
-    "When a named list of `teal_transform_module`, the decorators are applied to the",
-    "respective output objects.\n\n",
-    "Otherwise, the decorators are applied to all objects, which is equivalent as using the name `default`.\n\n",
-    sprintf("See section \"Decorating `%s`\"", module_name),
-    "below for more details."
-  )
-}
-
 roxygen_ggplot2_args_param <- function(...) {
   paste(
     sep = " ",
@@ -21,7 +7,7 @@ roxygen_ggplot2_args_param <- function(...) {
     "The argument is merged with options variable `teal.ggplot2_args` and default module setup.\n\n",
     sprintf(
       "List names should match the following: `c(\"default\", %s)`.\n\n",
-      paste("\"", unlist(rlang::list2(...)), "\"", collapse = ", ", sep = "")
+      paste("\"", unlist(list(...)), "\"", collapse = ", ", sep = "")
     ),
     "For more details see the vignette: `vignette(\"custom-ggplot2-arguments\", package = \"teal.widgets\")`."
   )

R/tm_a_pca.R

@@ -14,11 +14,10 @@
 #' - If vector of `length == 1` then the font sizes will have a fixed size.
 #' - while vector of `value`, `min`, and `max` allows dynamic adjustment.
 #' @param ggplot2_args `r roxygen_ggplot2_args_param("Elbow plot", "Circle plot", "Biplot", "Eigenvector plot")`
-#' @param decorators `r roxygen_decorators_param("tm_a_pca")`
 #'
 #' @inherit shared_params return
 #'
-#' @section Decorating `tm_a_pca`:
+#' @section Decorating Module:
 #'
 #' This module generates the following objects, which can be modified in place using decorators:
 #' - `elbow_plot` (`ggplot2`)
@@ -1121,9 +1120,12 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
       )
     })
 
+    # Render R code.
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
+
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))),
+      verbatim_content = source_code_r,
       title = "R Code for PCA"
     )
 
@@ -1146,7 +1148,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(req(decorated_output_q())))
+        card$append_src(source_code_r())
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

R/tm_a_regression.R

@@ -40,11 +40,10 @@
 # nolint start: line_length.
 #' @param ggplot2_args `r roxygen_ggplot2_args_param("Response vs Regressor", "Residuals vs Fitted", "Scale-Location", "Cook's distance", "Residuals vs Leverage", "Cook's dist vs Leverage")`
 # nolint end: line_length.
-#' @param decorators `r roxygen_decorators_param("tm_a_regression")`
 #'
 #' @inherit shared_params return
 #'
-#' @section Decorating `tm_a_regression`:
+#' @section Decorating Module:
 #'
 #' This module generates the following objects, which can be modified in place using decorators:
 #' - `plot` (`ggplot2`)
@@ -1006,9 +1005,12 @@ srv_a_regression <- function(id,
       )
     })
 
+    # Render R code.
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
+
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))),
+      verbatim_content = source_code_r,
       title = "R code for the regression plot",
     )
 
@@ -1027,7 +1029,7 @@ srv_a_regression <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(req(decorated_output_q())))
+        card$append_src(source_code_r())
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

R/tm_data_table.R

@@ -26,18 +26,9 @@
 #' `list(searching = FALSE, pageLength = 30, lengthMenu = c(5, 15, 30, 100), scrollX = TRUE)`
 #' @param server_rendering (`logical`) should the data table be rendered server side
 #' (see `server` argument of [DT::renderDataTable()])
-#' @param decorators `r roxygen_decorators_param("tm_data_table")`
 #'
 #' @inherit shared_params return
 #'
-#' @section Decorating `tm_data_table`:
-#'
-#' This module generates the following objects, which can be modified in place using decorators:
-#' - `table` ([DT::datatable()])
-#'
-#' For additional details and examples of decorators, refer to the vignette
-#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation.
-#'
 #' @examplesShinylive
 #' library(teal.modules.general)
 #' interactive <- function() TRUE
@@ -105,8 +96,7 @@ tm_data_table <- function(label = "Data Table",
                           ),
                           server_rendering = FALSE,
                           pre_output = NULL,
-                          post_output = NULL,
-                          decorators = NULL) {
+                          post_output = NULL) {
   message("Initializing tm_data_table")
 
   # Start of assertions
@@ -132,8 +122,6 @@ tm_data_table <- function(label = "Data 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)
 
-  decorators <- normalize_decorators(decorators)
-  assert_decorators(decorators, null.ok = TRUE, "table")
   # End of assertions
 
   ans <- module(
@@ -146,8 +134,7 @@ tm_data_table <- function(label = "Data Table",
       datasets_selected = datasets_selected,
       dt_args = dt_args,
       dt_options = dt_options,
-      server_rendering = server_rendering,
-      decorators = decorators
+      server_rendering = server_rendering
     ),
     ui_args = list(
       pre_output = pre_output,
@@ -197,8 +184,7 @@ srv_page_data_table <- function(id,
                                 variables_selected,
                                 dt_args,
                                 dt_options,
-                                server_rendering,
-                                decorators) {
+                                server_rendering) {
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(isolate(data()), "teal_data")
   moduleServer(id, function(input, output, session) {
@@ -251,8 +237,7 @@ srv_page_data_table <- function(id,
                     ui_data_table(
                       id = session$ns(x),
                       choices = choices,
-                      selected = variables_selected,
-                      decorators = decorators
+                      selected = variables_selected
                     )
                   )
                 )
@@ -274,19 +259,15 @@ srv_page_data_table <- function(id,
           if_distinct = if_distinct,
           dt_args = dt_args,
           dt_options = dt_options,
-          server_rendering = server_rendering,
-          decorators = decorators
+          server_rendering = server_rendering
         )
       }
     )
   })
 }
 
 # UI function for the data_table module
-ui_data_table <- function(id,
-                          choices,
-                          selected,
-                          decorators) {
+ui_data_table <- function(id, choices, selected) {
   ns <- NS(id)
 
   if (!is.null(selected)) {
@@ -298,7 +279,6 @@ ui_data_table <- function(id,
   tagList(
     teal.widgets::get_dt_rows(ns("data_table"), ns("dt_rows")),
     fluidRow(
-      ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(decorators, "table")),
       teal.widgets::optionalSelectInput(
         ns("variables"),
         "Select variables:",
@@ -322,8 +302,7 @@ srv_data_table <- function(id,
                            if_distinct,
                            dt_args,
                            dt_options,
-                           server_rendering,
-                           decorators) {
+                           server_rendering) {
   moduleServer(id, function(input, output, session) {
     iv <- shinyvalidate::InputValidator$new()
     iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names"))
@@ -367,15 +346,9 @@ srv_data_table <- function(id,
       )
     })
 
-    decorated_data_table_data <- srv_decorate_teal_data(
-      id = "decorator",
-      data = data_table_data,
-      decorators = select_decorators(decorators, "table")
-    )
-
     output$data_table <- DT::renderDataTable(server = server_rendering, {
       teal::validate_inputs(iv)
-      req(decorated_data_table_data())[["table"]]
+      req(data_table_data())[["table"]]
     })
   })
 }

R/tm_g_association.R

@@ -21,11 +21,10 @@
 #' Default to `"gray"`.
 #'
 #' @param ggplot2_args `r roxygen_ggplot2_args_param("Bivariate1", "Bivariate2")`
-#' @param decorators `r roxygen_decorators_param("tm_g_association")`
 #'
 #' @inherit shared_params return
 #'
-#' @section Decorating `tm_g_association`:
+#' @section Decorating Module:
 #'
 #' This module generates the following objects, which can be modified in place using decorators:
 #' - `plot` (`grob` created with [ggplot2::ggplotGrob()])
@@ -526,9 +525,12 @@ srv_tm_g_association <- function(id,
       teal.code::dev_suppress(output_q()[["title"]])
     })
 
+    # Render R code.
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_grob_q())))
+
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(req(decorated_output_grob_q()))),
+      verbatim_content = source_code_r,
       title = "Association Plot"
     )
 
@@ -547,7 +549,7 @@ srv_tm_g_association <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(req(decorated_output_grob_q())))
+        card$append_src(source_code_r())
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

R/tm_g_bivariate.R

@@ -43,11 +43,10 @@
 #' @param free_y_scales (`logical`) optional, whether Y scaling shall be changeable.
 #' Does not allow scaling to be changed by default (`FALSE`).
 #' @param swap_axes (`logical`) optional, whether to swap X and Y axes. Defaults to `FALSE`.
-#' @param decorators `r roxygen_decorators_param("tm_g_bivariate")`
 #'
 #' @inherit shared_params return
 #'
-#' @section Decorating `tm_g_bivariate`:
+#' @section Decorating Module:
 #'
 #' This module generates the following objects, which can be modified in place using decorators:
 #' - `plot` (`ggplot2`)
@@ -715,9 +714,12 @@ srv_g_bivariate <- function(id,
       width = plot_width
     )
 
+    # Render R code.
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_q_facets())))
+
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(req(decorated_output_q_facets()))),
+      verbatim_content = source_code_r,
       title = "Bivariate Plot"
     )
 
@@ -736,7 +738,7 @@ srv_g_bivariate <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(req(decorated_output_q_facets)))
+        card$append_src(source_code_r())
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)