datanames slot in teal_transform_module (ignore @datanames) (#1334)

ignore `datanames(data)`

Author: gogonzo

NAMESPACE

@@ -28,6 +28,7 @@ export(modules)
 export(new_tdata)
 export(report_card_template)
 export(reporter_previewer_module)
+export(set_datanames)
 export(show_rcode_modal)
 export(srv_teal)
 export(srv_teal_with_splash)

NEWS.md

@@ -6,10 +6,13 @@
 * Introduced `teal_transform_module` to provide a way to interactively modify data delivered to `teal_module`'s `server`. #1228
 * 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`.
+* Datasets which name starts with `.` are ignored when `module`'s `datanames` is set as `"all"`.
 
 ### Breaking changes
 
+* Setting `datanames()` on `data` passed to teal application no longer has effect. In order to change `teal_module`'s 
+`datanames` one should modify `module$datanames`.
 * The `landing_popup_module()` needs to be passed as the `landing_popup` argument of `init` instead of being passed as a module of the `modules` argument of `init`.
 * `teal` no longer re-export `%>%`. Please load `library(magrittr)` instead or use `|>` from `base`.
 

R/dummy_functions.R

@@ -21,7 +21,7 @@ example_module <- function(label = "example teal module", datanames = "all", tra
       checkmate::assert_class(isolate(data()), "teal_data")
       moduleServer(id, function(input, output, session) {
         datanames_rv <- reactive({
-          teal.data::datanames(req(data()))
+          .teal_data_ls(req(data()))
         })
 
         observeEvent(datanames_rv(), {

R/init.R

@@ -210,20 +210,16 @@ init <- function(data,
 
   ## `data` - `modules`
   if (inherits(data, "teal_data")) {
-    if (length(.teal_data_datanames(data)) == 0) {
+    if (length(.teal_data_ls(data)) == 0) {
       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.")
-    }
-
-    is_modules_ok <- check_modules_datanames(modules, .teal_data_datanames(data))
+    is_modules_ok <- check_modules_datanames(modules, .teal_data_ls(data))
     if (!isTRUE(is_modules_ok) && length(unlist(extract_transformers(modules))) == 0) {
       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_ls(data))
     if (!isTRUE(is_filter_ok)) {
       warning(is_filter_ok)
       # we allow app to continue if applied filters are outside

R/module_data_summary.R

@@ -63,7 +63,7 @@ srv_data_summary <- function(id, teal_data) {
       summary_table <- reactive({
         req(inherits(teal_data(), "teal_data"))
 
-        if (length(teal.data::datanames(teal_data())) == 0) {
+        if (!length(.teal_data_ls(teal_data()))) {
           return(NULL)
         }
 

R/module_filter_data.R

@@ -27,24 +27,25 @@ ui_filter_data <- function(id) {
 srv_filter_data <- function(id, datasets, active_datanames, data_rv, is_active) {
   assert_reactive(datasets)
   moduleServer(id, function(input, output, session) {
+    active_corrected <- reactive(intersect(active_datanames(), datasets()$datanames()))
+
     output$panel <- renderUI({
       req(inherits(datasets(), "FilteredData"))
       isolate({
         # render will be triggered only when FilteredData object changes (not when filters change)
         # technically it means that teal_data_module needs to be refreshed
         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)
+        if (length(active_corrected())) {
+          datasets()$srv_active("filters", active_datanames = active_corrected)
+          datasets()$ui_active(session$ns("filters"), active_datanames = active_corrected)
         }
       })
     })
 
-    trigger_data <- .observe_active_filter_changed(datasets, is_active, active_datanames, data_rv)
+    trigger_data <- .observe_active_filter_changed(datasets, is_active, active_corrected, data_rv)
 
     eventReactive(trigger_data(), {
-      .make_filtered_teal_data(modules, data = data_rv(), datasets = datasets(), datanames = active_datanames())
+      .make_filtered_teal_data(modules, data = data_rv(), datasets = datasets(), datanames = active_corrected())
     })
   })
 }

R/module_init_data.R

@@ -107,7 +107,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_ls(data_validated()))
       if (!isTRUE(is_filter_ok)) {
         showNotification(
           "Some filters were not applied because of incompatibility with data. Contact app developer.",
@@ -160,7 +160,6 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
   )
 
   tdata@verified <- data@verified
-  teal.data::datanames(tdata) <- teal.data::datanames(data)
   tdata
 }
 
@@ -172,8 +171,7 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
 #' @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_ls(data)) {
   vapply(
     datanames,
     function(dataname, datasets) {

R/module_nested_tabs.R

@@ -301,7 +301,7 @@ 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"))
   if (is.null(modules$datanames) || identical(modules$datanames, "all")) {
-    .teal_data_datanames(data)
+    .teal_data_ls(data)
   } else {
     intersect(
       include_parent_datanames(modules$datanames, teal.data::join_keys(data)),

R/modules.R

@@ -1,3 +1,6 @@
+setOldClass("teal_module")
+setOldClass("teal_modules")
+
 #' Create `teal_module` and `teal_modules` objects
 #'
 #' @description
@@ -39,25 +42,40 @@
 #'  - `...` (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 keyword `"all"` provides all datasets available in `data` passed to `teal` application.
+#' `NULL` will hide the filter panel.
 #' @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.
 #' @param ...
 #' - For `modules()`: (`teal_module` or `teal_modules`) Objects to wrap into a tab.
 #' - For `format()` and `print()`: Arguments passed to other methods.
 #'
+#' @section `datanames`:
+#' The module's `datanames` argument determines a subset of datasets from the `data` object, as specified in the
+#' server function argument, to be presented in the module. Datasets displayed in the filter panel will be limited
+#' to this subset.
+#' When `datanames` is set to `"all"`, all available datasets in the `data` object are considered relevant for the
+#' module. However, setting `datanames` argument to `"all"` might include datasets that are irrelevant for the module,
+#' for example:
+#' - Proxy variables used for modifying columns.
+#' - Modified copies of datasets used to create a final dataset.
+#' - Connection objects.
+#' To prevent these irrelevant datasets from appearing in the module, use the [set_datanames()] function on the
+#' [module] or [modules()] to change the `datanames` from `"all"` to specific dataset names. Attempting to change
+#' `datanames` values that was not set to `"all"` using [set_datanames()] will be ignored with a warning.
+#'
+#' Additionally, datasets with names starting with `.` are ignored when `datanames` is set to `"all"`.
+#'
 #' @return
 #' `module()` returns an object of class `teal_module`.
 #'
@@ -127,7 +145,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 +259,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,6 +340,38 @@ format.teal_modules <- function(x, indent = 0, ...) {
   )
 }
 
+#' @param modules (`teal_module` or `teal_modules`)
+#' @rdname teal_modules
+#' @examples
+#' # change the module's datanames
+#' set_datanames(module(datanames = "all"), "a")
+#'
+#' # change modules' datanames
+#' set_datanames(
+#'   modules(
+#'     module(datanames = "all"),
+#'     module(datanames = "a")
+#'   ),
+#'   "b"
+#' )
+#' @export
+set_datanames <- function(modules, datanames) {
+  checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"))
+  if (inherits(modules, "teal_modules")) {
+    modules$children <- lapply(modules$children, set_datanames, datanames)
+  } else {
+    if (identical(modules$datanames, "all")) {
+      modules$datanames <- datanames
+    } else {
+      warning(
+        "Not possible to modify datanames of the module ", modules$label,
+        ". set_datanames() can only change datanames if it was set to \"all\".",
+        call. = FALSE
+      )
+    }
+  }
+  modules
+}
 
 #' @rdname teal_modules
 #' @export

R/reporter_previewer_module.R

@@ -41,7 +41,7 @@ reporter_previewer_module <- function(label = "Report previewer", server_args =
   )
   # Module is created with a placeholder label and the label is changed later.
   # This is to prevent another module being labeled "Report previewer".
-  class(module) <- c("teal_module_previewer", class(module))
+  class(module) <- c(class(module), "teal_module_previewer")
   module$label <- label
   attr(module, "teal_bookmarkable") <- TRUE
   module