Adds decorate functionality to module output

DESCRIPTION

@@ -57,6 +57,7 @@ Imports:
     utils
 Suggests:
     bslib,
+    ggplot2 (>= 3.4.0),
     knitr (>= 1.42),
     mirai (>= 1.1.1),
     MultiAssayExperiment,
@@ -122,6 +123,7 @@ Collate:
     'teal_reporter.R'
     'teal_slices-store.R'
     'teal_slices.R'
+    'teal_transform_module.R'
     'utils.R'
     'validate_inputs.R'
     'validations.R'

NAMESPACE

@@ -22,6 +22,7 @@ export(get_code_tdata)
 export(get_metadata)
 export(init)
 export(landing_popup_module)
+export(make_teal_transform_server)
 export(module)
 export(modules)
 export(new_tdata)
@@ -31,12 +32,14 @@ export(set_datanames)
 export(show_rcode_modal)
 export(srv_teal)
 export(srv_teal_with_splash)
+export(srv_transform_teal_data)
 export(tdata2env)
 export(teal_data_module)
 export(teal_slices)
 export(teal_transform_module)
 export(ui_teal)
 export(ui_teal_with_splash)
+export(ui_transform_teal_data)
 export(validate_has_data)
 export(validate_has_elements)
 export(validate_has_variable)

NEWS.md

@@ -3,7 +3,7 @@
 ### New features
 
 * Possible to call `ui_teal` and `srv_teal` directly in any application by delivering `data` argument as a `reactive` returning `teal_data` object. #669
-* Introduced `teal_transform_module` to provide a way to interactively modify data delivered to `teal_module`'s `server`. #1228
+* Introduced `teal_transform_module` to provide a way to interactively modify data delivered to `teal_module`'s `server` and to decorate module outputs. #1228 #1384
 * Introduced a new argument `once = FALSE` in `teal_data_module` to possibly reload data during a run time.
 * Possibility to download lockfile to restore app session for reproducibility. #479
 * Introduced a function `set_datanames()` to change a `datanames` of the `teal_module`.

R/dummy_functions.R

@@ -2,7 +2,16 @@
 #'
 #' `r lifecycle::badge("experimental")`
 #'
+#' This module creates an object called `object` that can be modified with decorators.
+#' The `object` is determined by what's selected in `Choose a dataset` input in UI.
+#' The object can be anything that can be handled by `renderPrint()`.
+#' See the `vignette("decorate-modules-output", package = "teal")` or [`teal_transform_module`]
+#' to read more about decorators.
+#'
 #' @inheritParams teal_modules
+#' @param decorators `r lifecycle::badge("experimental")` (`list` of `teal_transform_module` or `NULL`) optional,
+#' if not `NULL`, decorator for tables or plots included in the module.
+#'
 #' @return A `teal` module which can be included in the `modules` argument to [init()].
 #' @examples
 #' app <- init(
@@ -13,11 +22,16 @@
 #'   shinyApp(app$ui, app$server)
 #' }
 #' @export
-example_module <- function(label = "example teal module", datanames = "all", transformers = list()) {
+example_module <- function(label = "example teal module",
+                           datanames = "all",
+                           transformators = list(),
+                           decorators = NULL) {
   checkmate::assert_string(label)
+  checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE)
+
   ans <- module(
     label,
-    server = function(id, data) {
+    server = function(id, data, decorators) {
       checkmate::assert_class(isolate(data()), "teal_data")
       moduleServer(id, function(input, output, session) {
         datanames_rv <- reactive(names(req(data())))
@@ -36,30 +50,52 @@ example_module <- function(label = "example teal module", datanames = "all", tra
           )
         })
 
-        output$text <- renderPrint({
+        table_data <- reactive({
           req(input$dataname)
-          data()[[input$dataname]]
+          within(data(),
+            {
+              object <- dataname
+            },
+            dataname = as.name(input$dataname)
+          )
+        })
+
+        table_data_decorated_no_print <- srv_transform_teal_data(
+          "decorate",
+          data = table_data,
+          transformators = decorators
+        )
+        table_data_decorated <- reactive(within(req(table_data_decorated_no_print()), expr = object))
+
+        output$text <- renderPrint({
+          req(table_data()) # Ensure original errors from module are displayed
+          table_data_decorated()[["object"]]
         })
 
         teal.widgets::verbatim_popup_srv(
           id = "rcode",
-          verbatim_content = reactive(teal.code::get_code(data())),
+          verbatim_content = reactive(teal.code::get_code(req(table_data_decorated()))),
           title = "Example Code"
         )
+
+        table_data_decorated
       })
     },
-    ui = function(id) {
+    ui = function(id, decorators) {
       ns <- NS(id)
       teal.widgets::standard_layout(
         output = verbatimTextOutput(ns("text")),
         encoding = tags$div(
           selectInput(ns("dataname"), "Choose a dataset", choices = NULL),
+          ui_transform_teal_data(ns("decorate"), transformators = decorators),
           teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
         )
       )
     },
+    ui_args = list(decorators = decorators),
+    server_args = list(decorators = decorators),
     datanames = datanames,
-    transformers = transformers
+    transformators = transformators
   )
   attr(ans, "teal_bookmarkable") <- TRUE
   ans

R/init.R

@@ -202,7 +202,7 @@ init <- function(data,
     }
 
     is_modules_ok <- check_modules_datanames(modules, names(data))
-    if (!isTRUE(is_modules_ok) && length(unlist(extract_transformers(modules))) == 0) {
+    if (!isTRUE(is_modules_ok) && length(unlist(extract_transformators(modules))) == 0) {
       warning(is_modules_ok, call. = FALSE)
     }
 

R/module_data_summary.R

@@ -148,10 +148,10 @@ get_filter_overview_wrapper <- function(teal_data) {
 
   current_data_objs <- sapply(
     datanames,
-    function(name) teal.code::get_var(teal_data(), name),
+    function(name) teal_data()[[name]],
     simplify = FALSE
   )
-  initial_data_objs <- teal.code::get_var(teal_data(), ".raw_data")
+  initial_data_objs <- teal_data()[[".raw_data"]]
 
   out <- lapply(
     datanames,

R/module_nested_tabs.R

@@ -92,22 +92,22 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) {
   args <- c(list(id = ns("module")), modules$ui_args)
 
   ui_teal <- tagList(
-    div(
-      id = ns("validate_datanames"),
-      ui_validate_reactive_teal_data(ns("validate_datanames"))
-    ),
     shinyjs::hidden(
       tags$div(
-        id = ns("transformer_failure_info"),
+        id = ns("transform_failure_info"),
         class = "teal_validated",
         div(
           class = "teal-output-warning",
-          "One of transformers failed. Please fix and continue."
+          "One of transformators failed. Please check its inputs."
         )
       )
     ),
     tags$div(
       id = ns("teal_module_ui"),
+      tags$div(
+        class = "teal_validated",
+        ui_check_module_datanames(ns("validate_datanames"))
+      ),
       do.call(modules$ui, args)
     )
   )
@@ -125,18 +125,12 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) {
             width = 3,
             ui_data_summary(ns("data_summary")),
             ui_filter_data(ns("filter_panel")),
-            ui_transform_data(ns("data_transform"), transformers = modules$transformers, class = "well"),
+            ui_transform_teal_data(ns("data_transform"), transformators = modules$transformators, class = "well"),
             class = "teal_secondary_col"
           )
         )
       } else {
-        div(
-          div(
-            class = "teal_validated",
-            uiOutput(ns("data_input_error"))
-          ),
-          ui_teal
-        )
+        ui_teal
       }
     )
   )
@@ -266,27 +260,25 @@ srv_teal_module.teal_module <- function(id,
         data_rv = data_rv,
         is_active = is_active
       )
-      is_transformer_failed <- reactiveValues()
-      transformed_teal_data <- srv_transform_data(
+      is_transform_failed <- reactiveValues()
+      transformed_teal_data <- srv_transform_teal_data(
         "data_transform",
         data = filtered_teal_data,
-        transformers = modules$transformers,
+        transformators = modules$transformators,
         modules = modules,
-        is_transformer_failed = is_transformer_failed
+        is_transform_failed = is_transform_failed
       )
-      any_transformer_failed <- reactive({
-        any(unlist(reactiveValuesToList(is_transformer_failed)))
+      any_transform_failed <- reactive({
+        any(unlist(reactiveValuesToList(is_transform_failed)))
       })
 
-      observeEvent(any_transformer_failed(), {
-        if (isTRUE(any_transformer_failed())) {
+      observeEvent(any_transform_failed(), {
+        if (isTRUE(any_transform_failed())) {
           shinyjs::hide("teal_module_ui")
-          shinyjs::hide("validate_datanames")
-          shinyjs::show("transformer_failure_info")
+          shinyjs::show("transform_failure_info")
         } else {
           shinyjs::show("teal_module_ui")
-          shinyjs::show("validate_datanames")
-          shinyjs::hide("transformer_failure_info")
+          shinyjs::hide("transform_failure_info")
         }
       })
 
@@ -297,7 +289,7 @@ srv_teal_module.teal_module <- function(id,
         all_teal_data[c(module_datanames, ".raw_data")]
       })
 
-      srv_validate_reactive_teal_data(
+      srv_check_module_datanames(
         "validate_datanames",
         data = module_teal_data,
         modules = modules

R/module_teal.R

@@ -187,12 +187,20 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
     )
 
     data_pulled <- srv_init_data("data", data = data)
-    data_validated <- srv_validate_reactive_teal_data(
-      "validate",
-      data = data_pulled,
-      modules = modules,
-      validate_shiny_silent_error = FALSE
+
+    validate_ui <- tags$div(
+      id = session$ns("validate_messages"),
+      class = "teal_validated",
+      ui_check_class_teal_data(session$ns("class_teal_data")),
+      ui_validate_error(session$ns("silent_error")),
+      ui_check_module_datanames(session$ns("datanames_warning"))
     )
+    srv_check_class_teal_data("class_teal_data", data_pulled)
+    srv_validate_error("silent_error", data_pulled, validate_shiny_silent_error = FALSE)
+    srv_check_module_datanames("datanames_warning", data_pulled, modules)
+
+    data_validated <- .trigger_on_success(data_pulled)
+
     data_rv <- reactive({
       req(inherits(data_validated(), "teal_data"))
       is_filter_ok <- check_filter_datanames(filter, names(data_validated()))
@@ -226,6 +234,8 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
       })
     }
 
+
+
     if (inherits(data, "teal_data_module")) {
       setBookmarkExclude(c("teal_modules-active_tab"))
       shiny::insertTab(
@@ -237,7 +247,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
           value = "teal_data_module",
           tags$div(
             ui_init_data(session$ns("data")),
-            ui_validate_reactive_teal_data(session$ns("validate"))
+            validate_ui
           )
         )
       )
@@ -254,7 +264,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
       insertUI(
         selector = sprintf("#%s", session$ns("tabpanel_wrapper")),
         where = "beforeBegin",
-        ui = tags$div(ui_validate_reactive_teal_data(session$ns("validate")), tags$br())
+        ui = tags$div(validate_ui, tags$br())
       )
     }