📑 Reporter Refactor: Adds support for new teal_report and teal_card class

DESCRIPTION

@@ -77,8 +77,13 @@ Suggests:
 VignetteBuilder:
     knitr,
     rmarkdown
-RdMacros:
-    lifecycle
+Remotes:
+    insightsengineering/teal.reporter@teal_reportable,
+    insightsengineering/teal.logger@main,
+    insightsengineering/teal.data@main,
+    insightsengineering/teal.code@main,
+    insightsengineering/teal.slice@main,
+    insightsengineering/teal.widgets@main
 Config/Needs/verdepcheck: rstudio/shiny, insightsengineering/teal.data,
     insightsengineering/teal.slice, mllg/checkmate, jeroen/jsonlite,
     r-lib/lifecycle, daroczig/logger, r-lib/mirai, r-lib/cli,
@@ -98,6 +103,7 @@ Roxygen: list(markdown = TRUE, packages = c("roxy.shinylive"))
 RoxygenNote: 7.3.2
 Collate:
     'TealAppDriver.R'
+    'after.R'
     'checkmate.R'
     'dummy_functions.R'
     'include_css_js.R'

NAMESPACE

@@ -15,9 +15,11 @@ S3method(print,teal_modules)
 S3method(within,teal_data_module)
 export(TealReportCard)
 export(add_landing_modal)
+export(after)
 export(as.teal_slices)
 export(as_tdata)
 export(build_app_title)
+export(disable_report)
 export(example_module)
 export(get_code_tdata)
 export(get_metadata)

NEWS.md

@@ -18,6 +18,13 @@
     - Reporter: The Report previewer is no longer displayed as yet another teal module, it is placed inside a "Report" drop-down right next to the "Module" drop-down. The Report previewer is a modal that displays the added report cards. The "Report" drop-down also contains other global report options like download/load/reset the Report.
     - Teal Data Module: The UI created by the `teal_data_module()` is now placed inside a modal that can only be closed when it returns `teal_data`.
 
+### New features
+
+* `init` and `srv_teal` have new `reporter` parameter, that allows to pre-define `teal.reporter::Reporter` object to be
+used for storing the content of the report. You can also globally disable reporting by setting `reporter = NULL` 
+(and `disable = TRUE` in `ui_teal` for cases when `ui_teal` is used as shiny module).
+* TODO: verify if we need to clone/deep_clone reporter in `srv_teal/init`.
+
 # teal 0.16.0
 
 ### New features

R/after.R

@@ -0,0 +1,91 @@
+#' Executes modifications to the result of a module
+#'
+#' Primarily used to modify the output object of module to change the containing
+#' report.
+#' @param x (`teal_module`)
+#' @param ui (`function(id, elem, ...)`) function to receive output (`shiny.tag`) from `x$ui`
+#' @param server (`function(input, output, session, data, ...)`) function to receive output data from `x$server`
+#' @param ... additional argument passed to `ui` and `server` by matching their formals names.
+#' @return A `teal_report` object with the result of the server function.
+#' @export
+after <- function(x,
+                  ui = function(id, elem) elem,
+                  server = function(input, output, session, data) data,
+                  ...) {
+  # todo: make a method for teal_app and remove teal_extend_server?
+  checkmate::assert_multi_class(x, "teal_module")
+  if (!is.function(ui) || !all(names(formals(ui)) %in% c("id", "elem"))) {
+    stop("ui should be a function of id and elem")
+  }
+  if (!is.function(server) || !all(names(formals(server)) %in% c("input", "output", "session", "data"))) {
+    stop("server should be a function of `input` and `output`, `session`, `data`")
+  }
+
+  additional_args <- list(...)
+  new_x <- x # because overwriting x$ui/server will cause infinite recursion
+  new_x$ui <- .after_ui(x$ui, ui, additional_args)
+  new_x$server <- .after_server(x$server, server, additional_args)
+  new_x
+}
+
+.after_ui <- function(x, y, additional_args) {
+  # add `_`-prefix to make sure objects are not masked in the wrapper functions
+  `_x` <- x # nolint: object_name.
+  `_y` <- y # nolint: object_name.
+  new_x <- function(id, ...) {
+    original_args <- as.list(environment())
+    if ("..." %in% names(formals(`_x`))) {
+      original_args <- c(original_args, list(...))
+    }
+    ns <- NS(id)
+    original_args$id <- ns("wrapped")
+    original_out <- do.call(`_x`, original_args, quote = TRUE)
+
+    wrapper_args <- c(
+      additional_args,
+      list(id = ns("wrapper"), elem = original_out)
+    )
+    do.call(`_y`, args = wrapper_args[names(formals(`_y`))])
+  }
+  formals(new_x) <- formals(x)
+  new_x
+}
+
+.after_server <- function(x, y, additional_args) {
+  # add `_`-prefix to make sure objects are not masked in the wrapper functions
+  `_x` <- x # nolint: object_name.
+  `_y` <- y # nolint: object_name.
+  new_x <- function(id, ...) {
+    original_args <- as.list(environment())
+    original_args$id <- "wrapped"
+    if ("..." %in% names(formals(`_x`))) {
+      original_args <- c(original_args, list(...))
+    }
+    moduleServer(id, function(input, output, session) {
+      original_out <- if (all(c("input", "output", "session") %in% names(formals(`_x`)))) {
+        original_args$module <- `_x`
+        do.call(shiny::callModule, args = original_args)
+      } else {
+        do.call(`_x`, original_args)
+      }
+      original_out_r <- reactive(
+        if (is.reactive(original_out)) {
+          original_out()
+        } else {
+          original_out
+        }
+      )
+      wrapper_args <- utils::modifyList(
+        additional_args,
+        list(id = "wrapper", input = input, output = output, session = session)
+      )
+      reactive({
+        req(original_out_r())
+        wrapper_args$data <- original_out()
+        do.call(`_y`, wrapper_args[names(formals(`_y`))], quote = TRUE)
+      })
+    })
+  }
+  formals(new_x) <- formals(x)
+  new_x
+}

R/init.R

@@ -34,6 +34,7 @@
 #'   a string specifying the `shiny` module id in cases it is used as a `shiny` module
 #'   rather than a standalone `shiny` app.
 #'   This parameter is no longer supported. Use [ui_teal()] and [srv_teal()] instead.
+#' @param reporter (`Reporter`) object used to store report contents. Set to `NULL` to globally disable reporting.
 #'
 #' @return Named list containing server and UI functions.
 #'
@@ -99,7 +100,8 @@ init <- function(data,
                  title = lifecycle::deprecated(),
                  header = lifecycle::deprecated(),
                  footer = lifecycle::deprecated(),
-                 id = lifecycle::deprecated()) {
+                 id = lifecycle::deprecated(),
+                 reporter = teal.reporter::Reporter$new()) {
   logger::log_debug("init initializing teal app with: data ('{ class(data) }').")
 
   # argument checking (independent)
@@ -183,7 +185,6 @@ init <- function(data,
   landing <- extract_module(modules, "teal_module_landing")
   modules <- drop_module(modules, "teal_module_landing")
 
-
   if (lifecycle::is_present(id)) {
     lifecycle::deprecate_soft(
       when = "0.16.0",
@@ -235,7 +236,13 @@ init <- function(data,
         )
       },
       server = function(input, output, session) {
-        srv_teal(id = "teal", data = data, modules = modules, filter = deep_copy_filter(filter))
+        srv_teal(
+          id = "teal",
+          data = data,
+          modules = modules,
+          filter = deep_copy_filter(filter),
+          reporter = if (!is.null(reporter)) reporter$clone(deep = TRUE)
+        )
         srv_session_info("teal-footer-session_info")
       }
     ),

R/module_init_data.R

@@ -90,15 +90,31 @@ srv_init_data <- function(id, data) {
 #' @keywords internal
 .add_signature_to_data <- function(data) {
   hashes <- .get_hashes_code(data)
+  data_teal_report <- as(data, "teal_report")
+  if (!inherits(data, "teal_report")) {
+    teal.reporter::teal_card(data_teal_report) <- c(
+      teal.reporter::teal_card(),
+      "## Code preparation",
+      teal.reporter::teal_card(data_teal_report)
+    )
+  }
   tdata <- do.call(
-    teal.data::teal_data,
+    teal.reporter::teal_report,
     c(
-      list(code = trimws(c(teal.code::get_code(data), hashes), which = "right")),
-      list(join_keys = teal.data::join_keys(data)),
-      as.list(data, all.names = TRUE)
+      list(
+        code = trimws(c(teal.code::get_code(data_teal_report), hashes), which = "right"),
+        join_keys = teal.data::join_keys(data_teal_report),
+        teal_card = teal.reporter::teal_card(data_teal_report)
+      ),
+      sapply(
+        names(data_teal_report),
+        base::get,
+        envir = data_teal_report,
+        simplify = FALSE
+      )
     )
   )
-  tdata@verified <- data@verified
+  tdata@verified <- data_teal_report@verified
   tdata
 }
 

R/module_nested_tabs.R

@@ -225,6 +225,7 @@ srv_teal_module <- function(id,
   tab_pane <- div(
     id = container_id,
     class = c("tab-pane", "teal_module", if (identical(module_id, active_module_id)) "active"),
+    ui_add_reporter(ns("add_reporter_wrapper")),
     tagList(
       .modules_breadcrumb(modules),
       if (!is.null(modules$datanames)) {
@@ -334,7 +335,7 @@ srv_teal_module <- function(id,
   checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"))
   assert_reactive(datasets, null.ok = TRUE)
   checkmate::assert_class(slices_global, ".slicesGlobal")
-  checkmate::assert_class(reporter, "Reporter")
+  checkmate::assert_class(reporter, "Reporter", null.ok = TRUE)
   assert_reactive(data_load_status)
   UseMethod(".srv_teal_module", modules)
 }
@@ -488,21 +489,16 @@ srv_teal_module <- function(id,
       })
 
       # Call modules.
-      if (!inherits(modules, "teal_module_previewer")) {
-        obs_module <- .call_once_when(
-          !is.null(module_teal_data()),
-          ignoreNULL = TRUE,
-          handlerExpr = {
-            module_out(.call_teal_module(modules, datasets, module_teal_data, reporter))
-          }
-        )
-      } else {
-        # Report previewer must be initiated on app start for report cards to be included in bookmarks.
-        # When previewer is delayed, cards are bookmarked only if previewer has been initiated (visited).
-        module_out(.call_teal_module(modules, datasets, module_teal_data, reporter))
-      }
+      obs_module <- .call_once_when(
+        !is.null(module_teal_data()),
+        ignoreNULL = TRUE,
+        handlerExpr = {
+          out <- .call_teal_module(modules, datasets, module_teal_data, reporter)
+          srv_add_reporter("add_reporter_wrapper", out, reporter)
+          module_out(out)
+        }
+      )
     })
-
     module_out
   })
 }
@@ -513,7 +509,7 @@ srv_teal_module <- function(id,
 
   # collect arguments to run teal_module
   args <- c(list(id = "module"), modules$server_args)
-  if (is_arg_used(modules$server, "reporter")) {
+  if (is_arg_used(modules$server, "reporter") && !is.null(reporter)) {
     args <- c(args, list(reporter = reporter))
   }
 

R/module_snapshot_manager.R

@@ -183,6 +183,12 @@ srv_snapshot_manager <- function(id, slices_global) {
         modalDialog(
           easyClose = TRUE,
           textInput(ns("snapshot_name"), "Name the snapshot", width = "100%", placeholder = "Meaningful, unique name"),
+          tags$script(
+            shiny::HTML(
+              sprintf("shinyjs.autoFocusModal('%s');", ns("snapshot_name")),
+              sprintf("shinyjs.enterToSubmit('%s', '%s');", ns("snapshot_name"), ns("snapshot_name_accept"))
+            )
+          ),
           footer = shiny::div(
             shiny::tags$button(
               type = "button",

R/module_teal.R

@@ -53,8 +53,9 @@ ui_teal <- function(id, modules) {
   mod <- extract_module(modules, class = "teal_module_previewer")
   reporter_opts <- if (length(mod)) .get_reporter_options(mod[[1]]$server_args)
   modules <- drop_module(modules, "teal_module_landing")
-  modules <- drop_module(modules, "teal_module_previewer")
 
+  # show busy icon when `shiny` session is busy computing stuff
+  # based on https://stackoverflow.com/questions/17325521/r-shiny-display-loading-message-while-function-is-running/22475216#22475216 # nolint: line_length.
   shiny_busy_message_panel <- conditionalPanel(
     condition = "(($('html').hasClass('shiny-busy')) && (document.getElementById('shiny-notification-panel') == null))", # nolint: line_length.
     tags$div(
@@ -108,6 +109,7 @@ ui_teal <- function(id, modules) {
     theme = get_teal_bs_theme(),
     include_teal_css_js(),
     shinyjs::useShinyjs(),
+    shiny::includeScript(system.file("js/extendShinyJs.js", package = "teal.reporter")),
     shiny_busy_message_panel,
     tags$div(id = ns("tabpanel_wrapper"), class = "teal-body", navbar),
     tags$hr(style = "margin: 1rem 0 0.5rem 0;")
@@ -116,14 +118,13 @@ ui_teal <- function(id, modules) {
 
 #' @rdname module_teal
 #' @export
-srv_teal <- function(id, data, modules, filter = teal_slices()) {
+srv_teal <- function(id, data, modules, filter = teal_slices(), reporter = teal.reporter::Reporter$new()) {
   checkmate::assert_character(id, max.len = 1, any.missing = FALSE)
   checkmate::assert_multi_class(data, c("teal_data", "teal_data_module", "reactive"))
   checkmate::assert_class(modules, "teal_modules")
   checkmate::assert_class(filter, "teal_slices")
 
   modules <- drop_module(modules, "teal_module_landing")
-  modules <- drop_module(modules, "teal_module_previewer")
 
   moduleServer(id, function(input, output, session) {
     logger::log_debug("srv_teal initializing.")
@@ -159,7 +160,6 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
     srv_check_module_datanames("datanames_warning", data_handled, modules)
 
     data_validated <- .trigger_on_success(data_handled)
-
     data_signatured <- reactive({
       req(inherits(data_validated(), "teal_data"))
       is_filter_ok <- check_filter_datanames(filter, names(data_validated()))
@@ -239,17 +239,16 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
         ui = tags$div(validate_ui)
       )
     }
-
-    if (is_arg_used(modules, "reporter")) {
+    if (!is.null(reporter)) {
       shinyjs::show("reporter_menu_container")
+      reporter$set_id(attr(filter, "app_id"))
+      teal.reporter::preview_report_button_srv("preview_report", reporter)
+      teal.reporter::report_load_srv("load_report", reporter)
+      teal.reporter::download_report_button_srv(id = "download_report", reporter = reporter)
+      teal.reporter::reset_report_button_srv("reset_reports", reporter)
     } else {
       removeUI(selector = sprintf("#%s", session$ns("reporter_menu_container")))
     }
-    reporter <- teal.reporter::Reporter$new()$set_id(attr(filter, "app_id"))
-    teal.reporter::preview_report_button_srv("preview_report", reporter)
-    teal.reporter::report_load_srv("load_report", reporter)
-    teal.reporter::download_report_button_srv(id = "download_report", reporter = reporter)
-    teal.reporter::reset_report_button_srv("reset_reports", reporter)
 
     datasets_rv <- if (!isTRUE(attr(filter, "module_specific"))) {
       eventReactive(data_signatured(), {

R/teal_data_module-eval_code.R

@@ -18,14 +18,13 @@ setOldClass("teal_data_module")
 #' @include teal_data_module.R
 #' @name eval_code
 #' @rdname teal_data_module
-#' @aliases eval_code,teal_data_module,character-method
-#' @aliases eval_code,teal_data_module,language-method
-#' @aliases eval_code,teal_data_module,expression-method
+#' @aliases eval_code,teal_data_module
+#' @aliases \S4method{eval_code}{teal_data_module}
 #'
 #' @importFrom methods setMethod
 #' @importMethodsFrom teal.code eval_code
 #'
-setMethod("eval_code", signature = c("teal_data_module", "character"), function(object, code) {
+setMethod("eval_code", signature = c(object = "teal_data_module"), function(object, code) {
   teal_data_module(
     ui = function(id) {
       ns <- NS(id)
@@ -50,11 +49,3 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function(
     once = attr(object, "once")
   )
 })
-
-setMethod("eval_code", signature = c("teal_data_module", "language"), function(object, code) {
-  eval_code(object, code = paste(lang2calls(code), collapse = "\n"))
-})
-
-setMethod("eval_code", signature = c("teal_data_module", "expression"), function(object, code) {
-  eval_code(object, code = paste(lang2calls(code), collapse = "\n"))
-})