Introduce the new DDL

DESCRIPTION

@@ -88,6 +88,7 @@ Collate:
     'show_rcode_modal.R'
     'tdata.R'
     'teal.R'
+    'teal_data_module.R'
     'teal_reporter.R'
     'teal_slices-store.R'
     'teal_slices.R'

NAMESPACE

@@ -31,6 +31,7 @@ export(reporter_previewer_module)
 export(show_rcode_modal)
 export(srv_teal_with_splash)
 export(tdata2env)
+export(teal_data_module)
 export(teal_slices)
 export(ui_teal_with_splash)
 export(validate_has_data)

R/dummy_functions.R

@@ -75,6 +75,7 @@ example_datasets <- function() { # nolint
 #'
 #' @description `r lifecycle::badge("experimental")`
 #' @inheritParams module
+#' @param src (`logical(1)`) whether to display reproducible R code in the module.
 #' @return A `teal` module which can be included in the `modules` argument to [teal::init()].
 #' @examples
 #' app <- init(
@@ -88,21 +89,31 @@ example_datasets <- function() { # nolint
 #'   shinyApp(app$ui, app$server)
 #' }
 #' @export
-example_module <- function(label = "example teal module", datanames = "all") {
+example_module <- function(label = "example teal module", datanames = "all", src = TRUE) {
   checkmate::assert_string(label)
   module(
     label,
     server = function(id, data) {
       checkmate::assert_class(data, "tdata")
       moduleServer(id, function(input, output, session) {
         output$text <- renderPrint(data[[input$dataname]]())
+        teal.widgets::verbatim_popup_srv(
+          id = "rcode",
+          verbatim_content = attr(data, "code")(),
+          title = "Association Plot"
+        )
       })
     },
     ui = function(id, data) {
       ns <- NS(id)
       teal.widgets::standard_layout(
         output = verbatimTextOutput(ns("text")),
-        encoding = selectInput(ns("dataname"), "Choose a dataset", choices = names(data))
+        encoding = div(
+          selectInput(ns("dataname"), "Choose a dataset", choices = names(data)),
+          if (src) {
+            teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
+          }
+        )
       )
     },
     datanames = datanames

R/init.R

@@ -15,10 +15,11 @@
 #' an end-user, don't use this function, but instead this module.
 #'
 #' @param data (`TealData` or `TealDataset` or `TealDatasetConnector` or `list` or `data.frame`
-#' or `MultiAssayExperiment`, `teal_data`)\cr
+#' or `MultiAssayExperiment`, `teal_data`, `teal_data_module`)\cr
 #' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()],
 #' [teal.data::cdisc_dataset()], [teal.data::dataset()], [teal.data::dataset_connector()] or
-#' [teal.data::cdisc_dataset_connector()] or a single `data.frame` or a `MultiAssayExperiment`
+#' [teal.data::cdisc_dataset_connector()] or [teal::teal_data_module()] or a single `data.frame` or
+#' a `MultiAssayExperiment`
 #' or a list of the previous objects or function returning a named list.
 #' NOTE: teal does not guarantee reproducibility of the code when names of the list elements
 #' do not match the original object names. To ensure reproducibility please use [teal.data::teal_data()]
@@ -114,11 +115,11 @@ init <- function(data,
                  footer = tags$p(),
                  id = character(0)) {
   logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).")
-
-  if (!inherits(data, c("TealData", "teal_data"))) {
+  if (!inherits(data, c("TealData", "teal_data", "teal_data_module"))) {
     data <- teal.data::to_relational_data(data = data)
   }
-  checkmate::assert_multi_class(data, c("TealData", "teal_data"))
+
+  checkmate::assert_multi_class(data, c("TealData", "teal_data", "teal_data_module"))
   checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules"))
   checkmate::assert_string(title, null.ok = TRUE)
   checkmate::assert(
@@ -142,26 +143,13 @@ init <- function(data,
   if (length(landing) > 1L) stop("Only one `landing_popup_module` can be used.")
   modules <- drop_module(modules, "teal_module_landing")
 
-  # resolve modules datanames
-  datanames <- teal.data::get_dataname(data)
-  join_keys <- teal.data::get_join_keys(data)
-  modules <- resolve_modules_datanames(modules = modules, datanames = datanames, join_keys = join_keys)
-
-  if (!inherits(filter, "teal_slices")) {
-    checkmate::assert_subset(names(filter), choices = datanames)
-    # list_to_teal_slices is lifted from teal.slice package, see zzz.R
-    # This is a temporary measure and will be removed two release cycles from now (now meaning 0.13.0).
-    filter <- list_to_teal_slices(filter)
-  }
-  # convert teal.slice::teal_slices to teal::teal_slices
-  filter <- as.teal_slices(as.list(filter))
-
-  # Calculate app hash to ensure snapshot compatibility. See ?snapshot. Raw data must be extracted from environments.
+  # Calculate app hash to ensure snapshot compatibility.
+  # See ?snapshot. Raw data must be extracted from environments.
   hashables <- mget(c("data", "modules"))
   hashables$data <- if (inherits(hashables$data, "teal_data")) {
     as.list(hashables$data@env)
-  } else if (inherits(hashables$data, "ddl")) {
-    attr(hashables$data, "code")
+  } else if (inherits(data, "teal_data_module")) {
+    body(data$server)
   } else if (hashables$data$is_pulled()) {
     sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) {
       hashables$data$get_dataset(dn)$get_raw_data()
@@ -172,20 +160,8 @@ init <- function(data,
 
   attr(filter, "app_id") <- rlang::hash(hashables)
 
-  # check teal_slices
-  for (i in seq_along(filter)) {
-    dataname_i <- shiny::isolate(filter[[i]]$dataname)
-    if (!dataname_i %in% datanames) {
-      stop(
-        sprintf(
-          "filter[[%s]] has a different dataname than available in a 'data':\n %s not in %s",
-          i,
-          dataname_i,
-          toString(datanames)
-        )
-      )
-    }
-  }
+  # convert teal.slice::teal_slices to teal::teal_slices
+  filter <- as.teal_slices(as.list(filter))
 
   if (isTRUE(attr(filter, "module_specific"))) {
     module_names <- unlist(c(module_labels(modules), "global_filters"))
@@ -213,6 +189,23 @@ init <- function(data,
     }
   }
 
+  if (inherits(data, "teal_data")) {
+    # in case of teal_data_module this check is postponed to the srv_teal_with_splash
+    is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data))
+    if (!isTRUE(is_modules_ok)) {
+      logger::log_error(is_modules_ok)
+      stop(is_modules_ok)
+    }
+
+    is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data))
+    if (!isTRUE(is_filter_ok)) {
+      logger::log_warn(is_filter_ok)
+      warning(is_filter_ok)
+      # we allow app to continue if applied filters are outside
+      # of possible data range
+    }
+  }
+
   # Note regarding case `id = character(0)`:
   # rather than using `callModule` and creating a submodule of this module, we directly modify
   # the `ui` and `server` with `id = character(0)` and calling the server function directly

R/module_nested_tabs.R

@@ -112,8 +112,7 @@ ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L, is_mod
   checkmate::assert_class(datasets, class = "FilteredData")
   ns <- NS(id)
 
-  args <- isolate(teal.transform::resolve_delayed(modules$ui_args, datasets))
-  args <- c(list(id = ns("module")), args)
+  args <- c(list(id = ns("module")), modules$ui_args)
 
   if (is_arg_used(modules$ui, "datasets")) {
     args <- c(args, datasets = datasets)
@@ -297,7 +296,11 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
   checkmate::assert_class(datasets, "FilteredData")
   checkmate::assert_class(trigger_data, "reactiveVal")
 
-  datanames <- if (is.null(module$datanames)) datasets$datanames() else module$datanames
+  datanames <- if (is.null(module$datanames) || identical(module$datanames, "all")) {
+    datasets$datanames()
+  } else {
+    unique(module$datanames) # todo: include parents! unique shouldn't be needed here!
+  }
 
   # list of reactive filtered data
   data <- sapply(

R/module_tabs_with_filters.R

@@ -122,7 +122,13 @@ srv_tabs_with_filters <- function(id,
     )
 
     if (!is_module_specific) {
-      active_datanames <- reactive(active_module()$datanames)
+      active_datanames <- reactive({
+        if (identical(active_module()$datanames, "all")) {
+          singleton$datanames()
+        } else {
+          active_module()$datanames
+        }
+      })
       singleton <- unlist(datasets)[[1]]
       singleton$srv_filter_panel("filter_panel", active_datanames = active_datanames)
 

R/module_teal.R

@@ -160,6 +160,11 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
       }
     )
 
+    reporter <- teal.reporter::Reporter$new()
+    if (is_arg_used(modules, "reporter") && length(extract_module(modules, "teal_module_previewer")) == 0) {
+      modules <- append_module(modules, reporter_previewer_module())
+    }
+
     env <- environment()
     datasets_reactive <- eventReactive(raw_data(), {
       env$progress <- shiny::Progress$new(session)
@@ -171,6 +176,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
       # Singleton starts with only global filters active.
       filter_global <- Filter(function(x) x$id %in% attr(filter, "mapping")$global_filters, filter)
       datasets_singleton$set_filter_state(filter_global)
+
       module_datasets <- function(modules) {
         if (inherits(modules, "teal_modules")) {
           datasets <- lapply(modules$children, module_datasets)
@@ -180,11 +186,16 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
         } else if (isTRUE(attr(filter, "module_specific"))) {
           # we should create FilteredData even if modules$datanames is null
           # null controls a display of filter panel but data should be still passed
-          datanames <- if (is.null(modules$datanames)) teal.data::get_dataname(raw_data()) else modules$datanames
-          # todo: subset tdata object to datanames
+          datanames <- if (is.null(modules$datanames) || modules$datanames == "all") {
+            include_parent_datanames(raw_data()@datanames, raw_data()@join_keys) # todo: use methods instead
+          } else {
+            modules$datanames
+          }
+          # todo: subset teal_data to datanames
           datasets_module <- teal_data_to_filtered_data(raw_data())
 
           # set initial filters
+          #  - filtering filters for this module
           slices <- Filter(x = filter, f = function(x) {
             x$id %in% unique(unlist(attr(filter, "mapping")[c(modules$label, "global_filters")])) &&
               x$dataname %in% datanames
@@ -199,29 +210,23 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
           datasets_singleton
         }
       }
-      datasets <- module_datasets(modules)
-
-      logger::log_trace("srv_teal@4 Raw Data transferred to FilteredData.")
-      datasets
+      module_datasets(modules)
     })
 
-    reporter <- teal.reporter::Reporter$new()
-    if (is_arg_used(modules, "reporter") && length(extract_module(modules, "teal_module_previewer")) == 0) {
-      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
     # usually not change afterwards
     # if restored from bookmarked state, `filter` is ignored
-    observeEvent(datasets_reactive(), ignoreNULL = TRUE, once = TRUE, {
+
+    observeEvent(datasets_reactive(), {
       logger::log_trace("srv_teal@5 setting main ui after data was pulled")
-      env$progress$set(0.5, message = "Setting up main UI")
       on.exit(env$progress$close())
-      # main_ui_container contains splash screen first and we remove it and replace it by the real UI
+      env$progress$set(0.5, message = "Setting up main UI")
+      datasets <- datasets_reactive()
 
-      removeUI(sprintf("#%s:first-child", session$ns("main_ui_container")))
+      # main_ui_container contains splash screen first and we remove it and replace it by the real UI
+      removeUI(sprintf("#%s > div:nth-child(1)", session$ns("main_ui_container")))
       insertUI(
         selector = paste0("#", session$ns("main_ui_container")),
         where = "beforeEnd",
@@ -230,7 +235,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
         ui = div(ui_tabs_with_filters(
           session$ns("main_ui"),
           modules = modules,
-          datasets = datasets_reactive(),
+          datasets = datasets,
           filter = filter
         )),
         # needed so that the UI inputs are available and can be immediately updated, otherwise, updating may not
@@ -242,7 +247,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
       # registered once (calling server functions twice would trigger observers twice each time)
       active_module <- srv_tabs_with_filters(
         id = "main_ui",
-        datasets = datasets_reactive(),
+        datasets = datasets,
         modules = modules,
         reporter = reporter,
         filter = filter