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 (use_reporter(modules)) {
+    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

@@ -134,15 +134,17 @@ ui_tabs_with_filters <- function(id, modules, datasets) {
 #' @param datasets (`FilteredData`)\cr
 #'   object to store filter state and filtered datasets, shared across modules. For more
 #'   details see [`teal.slice::FilteredData`].
+#' @param reporter (`Reporter`) object from `teal.reporter`
 #' @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"))
+  stopifnot(is(reporter, "Reporter"))
   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,49 @@ modules <- function(..., label = "root") {
 }
 
 
+
+#' Function which appends a teal_module onto the children of a teal_modules object
+#' @keywords internal
+#' @param modules `teal_modules`
+#' @param module `teal_module` object to be appended onto the children of `modules`
+#' @return `teal_modules` object with `module` appended
+append_module <- function(modules, module) {
+  checkmate::assert_class(modules, "teal_modules")
+  checkmate::assert_class(module, "teal_module")
+  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
+}
+
+#' Does the object make use of `teal.reporter` reporting
+#' @param modules `teal_module` or `teal_modules` object
+#' @return `logical` whether the object makes use of `teal.reporter` reporting
+#' @rdname use_reporter
+#' @keywords internal
+use_reporter <- function(modules) {
+  UseMethod("use_reporter", modules)
+}
+
+#' @rdname use_reporter
+#' @keywords internal
+use_reporter.default <- function(modules) {
+  stop("use_reporter function not implemented for this object")
+}
+
+#' @rdname use_reporter
+#' @keywords internal
+use_reporter.teal_modules <- function(modules) {
+  any(unlist(lapply(modules$children, function(x) use_reporter(x))))
+}
+
+#' @rdname use_reporter
+#' @keywords internal
+use_reporter.teal_module <- function(modules) {
+  "reporter" %in% names(formals(modules$server))
+}
+
+
 #' Deprecated: Creates the root modules container
 #'
 #' @description `r lifecycle::badge("deprecated")`

R/reporter_previewer_module.R

@@ -0,0 +1,29 @@
+#' Create a `teal` module for previewing a report
+#'
+#' This function wraps [teal.reporter::reporter_previewer_ui()] and
+#' [teal.reporter::reporter_previewer_srv()] into a `teal_module` to be
+#' used in `teal` applications.
+#'
+#' If you are creating a `teal` application using [teal::init()] then this
+#' module will be added to your application automatically if any of your `teal modules`
+#' support report generation
+#'
+#' @inheritParams module
+#' @return `teal_module` containing the `teal.reporter` previewer functionality
+#' @export
+reporter_previewer_module <- function(label = "Report previewer") {
+  checkmate::assert_string(label)
+  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
+  )
+}

README.md

@@ -25,6 +25,7 @@ A lot of the functionality of the `teal` framework derives from the following pa
 -   [`teal.code`](https://github.com/insightsengineering/teal.code): handles reproducibility of outputs.
 -   [`teal.transform`](https://github.com/insightsengineering/teal.transform): standardizes extracting and merging data.
 -   [`teal.logger`](https://github.com/insightsengineering/teal.logger): standardizes logging within `teal` framework.
+-   [`teal.reporter`](https://github.com/insightsengineering/teal.reporter): allows `teal` applications to generate reports.
 
 <!-- markdownlint-enable MD007 MD030 -->