datanames slot in teal_transform_module

R/init.R

@@ -210,20 +210,20 @@ init <- function(data,
 
   ## `data` - `modules`
   if (inherits(data, "teal_data")) {
-    if (length(.teal_data_datanames(data)) == 0) {
+    if (!length(.teal_data_ls(data))) {
       stop("The environment of `data` is empty.")
     }
 
     if (!length(teal.data::datanames(data))) {
-      warning("`data` object has no datanames. Default datanames are set using `teal_data`'s environment.")
+      teal.data::datanames(data) <- .teal_data_ls(data)
     }
 
-    is_modules_ok <- check_modules_datanames(modules, .teal_data_datanames(data))
-    if (!isTRUE(is_modules_ok) && length(unlist(extract_transformers(modules))) == 0) {
+    is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data))
+    if (!isTRUE(is_modules_ok) && !length(unlist(extract_transformers(modules)))) {
       lapply(is_modules_ok$string, warning, call. = FALSE)
     }
 
-    is_filter_ok <- check_filter_datanames(filter, .teal_data_datanames(data))
+    is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data))
     if (!isTRUE(is_filter_ok)) {
       warning(is_filter_ok)
       # we allow app to continue if applied filters are outside

R/module_filter_data.R

@@ -35,7 +35,6 @@ srv_filter_data <- function(id, datasets, active_datanames, data_rv, is_active)
         logger::log_debug("srv_filter_panel rendering filter panel.")
         if (length(active_datanames())) {
           datasets()$srv_active("filters", active_datanames = active_datanames)
-          # todo: make sure to bump the `teal.slice` version. Please use the branch `669_insertUI@main` in `teal.slice`.
           datasets()$ui_active(session$ns("filters"), active_datanames = active_datanames)
         }
       })

R/module_filter_manager.R

@@ -388,4 +388,3 @@ methods::setOldClass("reactivevalues")
     }
   )
 )
-# todo: prevent any teal_slices attribute except mapping

R/module_init_data.R

@@ -80,7 +80,13 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
     } else if (inherits(data, "teal_data")) {
       reactiveVal(data)
     } else if (test_reactive(data)) {
-      .fallback_on_failure(this = data, that = reactive(req(FALSE)), label = "Reactive data")
+      reactive({
+        data_obj <- .fallback_on_failure(this = data, that = reactive(req(FALSE)), label = "Reactive data")()
+        if (!length(teal.data::datanames(data_obj))) {
+          teal.data::datanames(data_obj) <- .teal_data_ls(data_obj)
+        }
+        data_obj
+      })
     }
 
     if (inherits(data, "teal_data_module")) {
@@ -107,7 +113,7 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
         )
       }
 
-      is_filter_ok <- check_filter_datanames(filter, .teal_data_datanames(data_validated()))
+      is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data_validated()))
       if (!isTRUE(is_filter_ok)) {
         showNotification(
           "Some filters were not applied because of incompatibility with data. Contact app developer.",
@@ -134,7 +140,10 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
     })
 
     # Adds signature protection to the datanames in the data
-    reactive(.add_signature_to_data(data_validated()))
+    reactive({
+      req(data_validated())
+      .add_signature_to_data(data_validated())
+    })
   })
 }
 
@@ -167,13 +176,12 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
 #' Get code that tests the integrity of the reproducible data
 #'
 #' @param data (`teal_data`) object holding the data
-#' @param datanames (`character`) names of `datasets`
 #'
 #' @return A character vector with the code lines.
 #' @keywords internal
 #'
-.get_hashes_code <- function(data, datanames = .teal_data_datanames(data)) {
-  # todo: this should be based on data_rv object not on datasets
+.get_hashes_code <- function(data) {
+  datanames <- teal.data::datanames(data)
   vapply(
     datanames,
     function(dataname, datasets) {

R/module_nested_tabs.R

@@ -205,11 +205,6 @@ srv_teal_module.teal_module <- function(id,
       })
     }
 
-    # manage module filters on the module level
-    # important:
-    #   filter_manager_module_srv needs to be called before filter_panel_srv
-    #   Because available_teal_slices is used in FilteredData$srv_available_slices (via srv_filter_panel)
-    #   and if it is not set, then it won't be available in the srv_filter_panel
     srv_module_filter_manager(modules$label, module_fd = datasets, slices_global = slices_global)
     filtered_teal_data <- srv_filter_data(
       "filter_panel",
@@ -232,14 +227,14 @@ srv_teal_module.teal_module <- function(id,
       .subset_teal_data(all_teal_data, module_datanames)
     })
 
+    summary_table <- srv_data_summary("data_summary", module_teal_data)
+
     module_teal_data_validated <- srv_validate_reactive_teal_data(
       "validate_datanames",
       data = module_teal_data,
       modules = modules
     )
 
-    summary_table <- srv_data_summary("data_summary", module_teal_data)
-
     # Call modules.
     module_out <- reactiveVal(NULL)
     if (!inherits(modules, "teal_module_previewer")) {
@@ -257,15 +252,6 @@ srv_teal_module.teal_module <- function(id,
       # 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))
     }
-
-    # todo: (feature request) add a ReporterCard to the reporter as an output from the teal_module
-    #       how to determine if module returns a ReporterCard so that reportPreviewer is needed?
-    #       Should we insertUI of the ReportPreviewer then?
-    #       What about attr(module, "reportable") - similar to attr(module, "bookmarkable")
-    if ("report" %in% names(module_out)) {
-      # (reactively) add card to the reporter
-    }
-
     module_out
   })
 }
@@ -299,9 +285,10 @@ srv_teal_module.teal_module <- function(id,
 }
 
 .resolve_module_datanames <- function(data, modules) {
-  stopifnot("data_rv must be teal_data object." = inherits(data, "teal_data"))
+  checkmate::assert_class(data, "teal_data")
+  checkmate::assert_class(modules, "teal_module")
   if (is.null(modules$datanames) || identical(modules$datanames, "all")) {
-    .teal_data_datanames(data)
+    teal.data::datanames(data)
   } else {
     intersect(
       include_parent_datanames(modules$datanames, teal.data::join_keys(data)),

R/module_teal_data.R

@@ -194,7 +194,6 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length
   assert_reactive(this)
   assert_reactive(that)
   checkmate::assert_string(label)
-
   reactive({
     res <- try(this(), silent = TRUE)
     if (inherits(res, "teal_data")) {

R/modules.R

@@ -39,18 +39,18 @@
 #'  - `...` (optional) When provided, `ui_args` elements will be passed to the module named argument
 #'    or to the `...`.
 #' @param filters (`character`) Deprecated. Use `datanames` instead.
-#' @param datanames (`character`) A vector with `datanames` that are relevant for the item. The
-#'   filter panel will automatically update the shown filters to include only
-#'   filters in the listed datasets. `NULL` will hide the filter panel,
-#'   and the keyword `"all"` will show filters of all datasets. `datanames` also determines
-#'   a subset of datasets which are appended to the `data` argument in server function.
+#' @param datanames (`character`) Names of the datasets that are relevant for the item. The
+#'  filter panel will only display filters for specified `datanames`. The keyword `"all"` will show
+#'  filters of all datasets. `NULL` will hide the filter panel. `datanames` also determines a subset
+#'  of datasets which are appended to the `data` argument in server function.
 #' @param server_args (named `list`) with additional arguments passed on to the server function.
 #' @param ui_args (named `list`) with additional arguments passed on to the UI function.
 #' @param x (`teal_module` or `teal_modules`) Object to format/print.
 #' @param indent (`integer(1)`) Indention level; each nested element is indented one level more.
 #' @param transformers (`list` of `teal_data_module`) that will be applied to transform the data.
 #' Each transform module UI will appear in the `teal` application, unless the `custom_ui` attribute is set on the list.
-#' If so, the module developer is responsible to display the UI in the module itself.
+#' If so, the module developer is responsible to display the UI in the module itself. `datanames` of the `transformers`
+#' will be added to the `datanames`.
 #'
 #' When the transformation does not have sufficient input data, the resulting data will fallback
 #' to the last successful transform or, in case there are none, to the filtered data.
@@ -127,7 +127,7 @@
 #' @export
 #'
 module <- function(label = "module",
-                   server = function(id, ...) moduleServer(id, function(input, output, session) NULL),
+                   server = function(id, data, ...) moduleServer(id, function(input, output, session) NULL),
                    ui = function(id, ...) tags$p(paste0("This module has no UI (id: ", id, " )")),
                    filters,
                    datanames = "all",
@@ -241,14 +241,23 @@ module <- function(label = "module",
   }
 
   ## `transformers`
-  checkmate::assert_list(transformers, types = "teal_data_module")
+  if (inherits(transformers, "teal_transform_module")) {
+    transformers <- list(transformers)
+  }
+  checkmate::assert_list(transformers, types = "teal_transform_module")
+  transformer_datanames <- unlist(lapply(transformers, attr, "datanames"))
+  combined_datanames <- if (identical(datanames, "all") || identical(transformer_datanames, "all")) {
+    "all"
+  } else {
+    union(datanames, transformer_datanames)
+  }
 
   structure(
     list(
       label = label,
       server = server,
       ui = ui,
-      datanames = unique(datanames),
+      datanames = combined_datanames,
       server_args = server_args,
       ui_args = ui_args,
       transformers = transformers
@@ -313,7 +322,6 @@ format.teal_modules <- function(x, indent = 0, ...) {
   )
 }
 
-
 #' @rdname teal_modules
 #' @export
 print.teal_modules <- print.teal_module

R/teal_data_module.R

@@ -75,6 +75,13 @@ teal_data_module <- function(ui, server, label = "data module", once = TRUE) {
           pre = sprintf("From: 'teal_data_module()':\nA 'teal_data_module' with \"%s\" label:", label),
           post = "Please make sure that this module returns a 'reactive` object containing 'teal_data' class of object." # nolint: line_length_linter.
         )
+        reactive({
+          new_data <- data_out()
+          if (inherits(new_data, "teal_data") && !length(teal.data::datanames(new_data))) {
+            teal.data::datanames(new_data) <- .teal_data_ls(new_data)
+          }
+          new_data
+        })
       }
     ),
     label = label,
@@ -104,10 +111,15 @@ teal_data_module <- function(ui, server, label = "data module", once = TRUE) {
 #' `shiny` module server function; that takes `id` and `data` argument,
 #' where the `id` is the module id and `data` is the reactive `teal_data` input.
 #' The server function must return reactive expression containing `teal_data` object.
+#' @param datanames (`character`)
+#'  Names of the datasets that are relevant for the item. The filter panel will only display filters
+#'  for specified `datanames`. The keyword `"all"` will show filters of all datasets. `datanames`
+#'  will be automatically appended to the [modules()] `datanames`.
 #' @examples
 #' my_transformers <- list(
 #'   teal_transform_module(
 #'     label = "Custom transform for iris",
+#'     datanames = "iris",
 #'     ui = function(id) {
 #'       ns <- NS(id)
 #'       tags$div(
@@ -132,10 +144,11 @@ teal_data_module <- function(ui, server, label = "data module", once = TRUE) {
 #' @name teal_transform_module
 #'
 #' @export
-teal_transform_module <- function(ui, server, label = "transform module") {
+teal_transform_module <- function(ui, server, label = "transform module", datanames = character(0)) {
   checkmate::assert_function(ui, args = "id", nargs = 1)
   checkmate::assert_function(server, args = c("id", "data"), nargs = 2)
   checkmate::assert_string(label)
+  checkmate::assert_character(datanames)
   structure(
     list(
       ui = ui,
@@ -149,6 +162,7 @@ teal_transform_module <- function(ui, server, label = "transform module") {
       }
     ),
     label = label,
+    datanames = datanames,
     class = c("teal_transform_module", "teal_data_module")
   )
 }

R/teal_data_utils.R

@@ -69,17 +69,6 @@ NULL
   new_data
 }
 
-#' @rdname teal_data_utilities
-.teal_data_datanames <- function(data) {
-  checkmate::assert_class(data, "teal_data")
-  datanames <- teal.data::datanames(data)
-  if (length(datanames)) {
-    datanames
-  } else {
-    .teal_data_ls(data)
-  }
-}
-
 #' @rdname teal_data_utilities
 .teal_data_ls <- function(data) {
   grep("._raw_", ls(teal.code::get_env(data), all.names = TRUE), value = TRUE, invert = TRUE)

R/utils.R

@@ -65,7 +65,7 @@ include_parent_datanames <- function(dataname, join_keys) {
 #' @param datanames (`character`) vector of data set names to include; must be subset of `datanames(x)`
 #' @return A `FilteredData` object.
 #' @keywords internal
-teal_data_to_filtered_data <- function(x, datanames = .teal_data_datanames(x)) {
+teal_data_to_filtered_data <- function(x, datanames = teal.data::datanames(x)) {
   checkmate::assert_class(x, "teal_data")
   checkmate::assert_character(datanames, min.chars = 1L, any.missing = FALSE)