add reporter

DESCRIPTION

@@ -39,6 +39,7 @@ Imports:
     styler,
     teal.code,
     teal.logger,
+    teal.reporter,
     teal.slice,
     utils
 Suggests:
@@ -78,6 +79,7 @@ Collate:
     'module_teal.R'
     'module_teal_with_splash.R'
     'modules_debugging.R'
+    'reporter_previewer_module.R'
     'show_rcode_modal.R'
     'teal.R'
     'utils.R'

NAMESPACE

@@ -23,6 +23,7 @@ export(init)
 export(log_app_usage)
 export(module)
 export(modules)
+export(reporter_previewer_module)
 export(root_modules)
 export(show_rcode_modal)
 export(srv_teal_with_splash)

NEWS.md

@@ -1,5 +1,10 @@
 # teal 0.11.0.9006
 
+### Enhancments
+
+* Added new function `reporter_previewer_module` to wrap the `teal.reporter` package previewer functionality as a `teal` module.
+* `teal` now supports `modules` which include reporting. If any `module` which supports reporting is included then a `reporter_previewer_module` is included.
+
 ### Breaking changes
 * Deprecated `bookmarkableShinyApp`. In future releases the `teal` framework will stop supporting shiny bookmarking (which has not officially been supported); it may be officially supported in the future. Note the filter panel in `teal.slice` retains its ability to save and restore its state if used in a standalone `shiny` app with bookmarking. 
 

R/module_nested_tabs.R

@@ -86,15 +86,13 @@ ui_nested_tabs.teal_modules <- function(id, modules, datasets, depth = 0L) {
 ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L) {
   stopifnot(is(datasets, "FilteredData"))
   args <- isolate(teal.transform::resolve_delayed(modules$ui_args, datasets))
+  args <- c(list(id = id, datasets = datasets), args)
   tags$div(
     id = id,
     class = "teal_module",
     tagList(
       if (depth >= 2L) div(style = "margin-top: 1.5rem;"),
-      do.call(
-        modules$ui,
-        c(list(id = id, datasets = datasets), args)
-      )
+      do.call(modules$ui, args)
     )
   )
 }
@@ -122,22 +120,23 @@ ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L) {
 #'
 #' @return `reactive` which returns the active module that corresponds to the selected tab
 #' @keywords internal
-srv_nested_tabs <- function(id, datasets, modules) {
+srv_nested_tabs <- function(id, datasets, modules, reporter) {
   stopifnot(inherits(datasets, "FilteredData"))
+  stopifnot(inherits(reporter, "Reporter"))
   UseMethod("srv_nested_tabs", modules)
 }
 
 #' @rdname srv_nested_tabs
 #' @export
 #' @keywords internal
-srv_nested_tabs.default <- function(id, datasets, modules) {
+srv_nested_tabs.default <- function(id, datasets, modules, reporter) {
   stop("Modules class not supported: ", paste(class(modules), collapse = " "))
 }
 
 #' @rdname srv_nested_tabs
 #' @export
 #' @keywords internal
-srv_nested_tabs.teal_modules <- function(id, datasets, modules) {
+srv_nested_tabs.teal_modules <- function(id, datasets, modules, reporter) {
   moduleServer(id = id, module = function(input, output, session) {
     logger::log_trace(
       paste(
@@ -147,7 +146,7 @@ srv_nested_tabs.teal_modules <- function(id, datasets, modules) {
       )
     )
     modules_reactive <- sapply(names(modules$children), USE.NAMES = TRUE, function(id) {
-      srv_nested_tabs(id = id, datasets = datasets, modules = modules$children[[id]])
+      srv_nested_tabs(id = id, datasets = datasets, modules = modules$children[[id]], reporter = reporter)
     })
 
     get_active_module <- reactive({
@@ -168,7 +167,7 @@ srv_nested_tabs.teal_modules <- function(id, datasets, modules) {
 #' @rdname srv_nested_tabs
 #' @export
 #' @keywords internal
-srv_nested_tabs.teal_module <- function(id, datasets, modules) {
+srv_nested_tabs.teal_module <- function(id, datasets, modules, reporter) {
   logger::log_trace(
     paste(
       "srv_nested_tabs.teal_module initializing the module with:",
@@ -179,16 +178,17 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules) {
 
   modules$server_args <- teal.transform::resolve_delayed(modules$server_args, datasets)
   is_module_server <- isTRUE("id" %in% names(formals(modules$server)))
+
+  args <- c(list(id = id, datasets = datasets), modules$server_args)
+  if (modules$use_reporter) {
+    args <- c(args, list(reporter = reporter))
+  }
+
   if (is_module_server) {
-    do.call(modules$server, c(list(id = id, datasets = datasets), modules$server_args))
+    do.call(modules$server, args)
   } else {
-    do.call(
-      callModule,
-      c(
-        list(module = modules$server, id = id, datasets = datasets),
-        modules$server_args
-      )
-    )
+    args <- c(args, list(module = modules$server))
+    do.call(callModule, args)
   }
   reactive(modules)
 }

R/module_tabs_with_filters.R

@@ -136,13 +136,13 @@ ui_tabs_with_filters <- function(id, modules, datasets) {
 #'   details see [`teal.slice::FilteredData`].
 #' @return `reactive` currently selected active_module
 #' @keywords internal
-srv_tabs_with_filters <- function(id, datasets, modules, filter) {
+srv_tabs_with_filters <- function(id, datasets, modules, reporter, filter) {
   stopifnot(is(datasets, "FilteredData"))
   moduleServer(id, function(input, output, session) {
     logger::log_trace(
       "srv_tabs_with_filters initializing the module with datasets { paste(datasets$datanames(), collapse = ' ') }."
     )
-    active_module <- srv_nested_tabs(id = "root", datasets = datasets, modules = modules)
+    active_module <- srv_nested_tabs(id = "root", datasets = datasets, modules = modules, reporter = reporter)
 
     active_datanames <- eventReactive(
       eventExpr = active_module(),

R/module_teal.R

@@ -193,6 +193,13 @@ srv_teal <- function(id, modules, raw_data, filter = list()) {
       datasets
     })
 
+
+    reporter <- teal.reporter::Reporter$new()
+
+    if (use_reporter(modules)) {
+      modules <- append_module(modules, reporter_previewer_module())
+    }
+
     # Replace splash / welcome screen once data is loaded ----
     # ignoreNULL to not trigger at the beginning when data is NULL
     # just handle it once because data obtained through delayed loading should
@@ -209,7 +216,11 @@ srv_teal <- function(id, modules, raw_data, filter = list()) {
         where = "beforeEnd",
         # we put it into a div, so it can easily be removed as a whole, also when it is a tagList (and not
         # just the first item of the tagList)
-        ui = div(ui_tabs_with_filters(session$ns("main_ui"), modules = modules, datasets = datasets_reactive())),
+        ui = div(ui_tabs_with_filters(
+          session$ns("main_ui"),
+          modules = modules,
+          datasets = datasets_reactive())
+        ),
         # needed so that the UI inputs are available and can be immediately updated, otherwise, updating may not
         # have any effect as they are ignored when not present, see note in `module_add_filter_variable.R`
         immediate = TRUE
@@ -218,13 +229,15 @@ srv_teal <- function(id, modules, raw_data, filter = list()) {
       # switching filter to bookmarked state
       if (!is.null(saved_datasets_state())) filter <- saved_datasets_state()
 
+
       # must make sure that this is only executed once as modules assume their observers are only
       # registered once (calling server functions twice would trigger observers twice each time)
       # `once = TRUE` ensures this
       active_module <- srv_tabs_with_filters(
         id = "main_ui",
         datasets = datasets_reactive(),
         modules = modules,
+        reporter = reporter,
         filter = filter
       )
       return(active_module)

R/modules.R

@@ -92,6 +92,32 @@ modules <- function(..., label = "root") {
 }
 
 
+append_module <- function(modules, module) {
+  # TODO validation
+  modules$children <- c(modules$children, list(module))
+  labels <- vapply(modules$children, function(submodule) submodule$label, character(1))
+  names(modules$children) <- make.unique(gsub("[^[:alnum:]]", "_", tolower(labels)), sep = "_")
+  modules
+}
+
+
+use_reporter <- function(modules) {
+  UseMethod("use_reporter", modules)
+}
+
+use_reporter.default <- function(modules) {
+  stop("use_reporter function not implemented for this object")
+}
+
+use_reporter.teal_modules <- function(modules) {
+  any(unlist(lapply(modules$children, function(x) use_reporter(x))))
+}
+
+use_reporter.teal_module <- function(modules) {
+  modules$use_reporter
+}
+
+
 #' Deprecated: Creates the root modules container
 #'
 #' @description `r lifecycle::badge("deprecated")`
@@ -249,7 +275,8 @@ module <- function(label, server, ui, filters, server_args = NULL, ui_args = NUL
     list(
       label = label,
       server = server, ui = ui, filters = filters,
-      server_args = server_args, ui_args = ui_args
+      server_args = server_args, ui_args = ui_args,
+      use_reporter = "reporter" %in% server_main_args
     ),
     class = "teal_module"
   )

R/reporter_previewer_module.R

@@ -0,0 +1,17 @@
+#' @export
+reporter_previewer_module <- function(label = "Report previewer") {
+
+  srv <- function(id, datasets, reporter, ...){
+    teal.reporter::reporter_previewer_srv(id, reporter, ...)
+  }
+
+  ui <- function(id, datasets, ...){
+    teal.reporter::reporter_previewer_ui(id, ...)
+  }
+
+  module(
+    label = label,
+    server = srv, ui = ui,
+    server_args = list(), ui_args = list(), filters = NULL
+  )
+}

staged_dependencies.yaml

@@ -21,6 +21,9 @@ upstream_repos:
   insightsengineering/teal.logger:
     repo: insightsengineering/teal.logger
     host: https://github.com
+  insightsengineering/teal.reporter:
+    repo: insightsengineering/teal.reporter
+    host: https://github.com
   insightsengineering/scda:
     repo: insightsengineering/scda
     host: https://github.com