Introduce teal_data class

R/init.R

@@ -114,9 +114,11 @@ init <- function(data,
                  footer = tags$p(),
                  id = character(0)) {
   logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).")
-  data <- teal.data::to_relational_data(data = data)
 
-  checkmate::assert_class(data, "TealData")
+  if (!inherits(data, c("TealData", "teal_data"))) {
+    data <- teal.data::to_relational_data(data = data)
+  }
+  checkmate::assert_multi_class(data, c("TealData", "teal_data"))
   checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules"))
   checkmate::assert_string(title, null.ok = TRUE)
   checkmate::assert(
@@ -138,7 +140,7 @@ init <- function(data,
 
   # resolve modules datanames
   datanames <- teal.data::get_dataname(data)
-  join_keys <- data$get_join_keys()
+  join_keys <- teal.data::get_join_keys(data)
   resolve_modules_datanames <- function(modules) {
     if (inherits(modules, "teal_modules")) {
       modules$children <- sapply(modules$children, resolve_modules_datanames, simplify = FALSE)
@@ -147,6 +149,17 @@ init <- function(data,
       modules$datanames <- if (identical(modules$datanames, "all")) {
         datanames
       } else if (is.character(modules$datanames)) {
+        extra_datanames <- setdiff(modules$datanames, datanames)
+        if (length(extra_datanames)) {
+          stop(
+            sprintf(
+              "Module %s has datanames that are not available in a 'data':\n %s not in %s",
+              modules$label,
+              toString(extra_datanames),
+              toString(datanames)
+            )
+          )
+        }
         datanames_adjusted <- intersect(modules$datanames, datanames)
         include_parent_datanames(dataname = datanames_adjusted, join_keys = join_keys)
       }
@@ -212,8 +225,10 @@ init <- function(data,
   res <- list(
     ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer),
     server = function(input, output, session) {
-      # copy object so that load won't be shared between the session
-      data <- data$copy(deep = TRUE)
+      if (inherits(data, "TealDataAbstract")) {
+        # copy TealData so that load won't be shared between the session
+        data <- data$copy(deep = TRUE)
+      }
       filter <- deep_copy_filter(filter)
       srv_teal_with_splash(id = id, data = data, modules = modules, filter = filter)
     }

R/module_nested_tabs.R

@@ -314,12 +314,14 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
     data,
     eventReactive(
       trigger_data(),
-      c(
-        get_rcode_str_install(),
-        get_rcode_libraries(),
-        get_datasets_code(datanames, datasets, hashes),
-        teal.slice::get_filter_expr(datasets, datanames)
-      )
+      {
+        c(
+          get_rcode_str_install(),
+          get_rcode_libraries(),
+          get_datasets_code(datanames, datasets, hashes),
+          teal.slice::get_filter_expr(datasets, datanames)
+        )
+      }
     ),
     datasets$get_join_keys(),
     metadata

R/module_teal.R

@@ -162,10 +162,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
 
     # loading the data -----
     env <- environment()
-    datasets_reactive <- reactive({
-      if (is.null(raw_data())) {
-        return(NULL)
-      }
+    datasets_reactive <- eventReactive(raw_data(), ignoreNULL = TRUE, {
       env$progress <- shiny::Progress$new(session)
       env$progress$set(0.25, message = "Setting data")
 
@@ -184,25 +181,9 @@ 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)) raw_data()$get_datanames() else modules$datanames
-          data_objects <- sapply(
-            datanames,
-            function(dataname) {
-              dataset <- raw_data()$get_dataset(dataname)
-              list(
-                dataset = dataset$get_raw_data(),
-                metadata = dataset$get_metadata(),
-                label = dataset$get_dataset_label()
-              )
-            },
-            simplify = FALSE
-          )
-          datasets_module <- teal.slice::init_filtered_data(
-            data_objects,
-            join_keys = raw_data()$get_join_keys(),
-            code = raw_data()$get_code_class(),
-            check = raw_data()$get_check()
-          )
+          datanames <- if (is.null(modules$datanames)) teal.data::get_dataname(raw_data()) else modules$datanames
+          # todo: subset tdata object to datanames
+          datasets_module <- teal.slice::init_filtered_data(raw_data())
 
           # set initial filters
           slices <- Filter(x = filter, f = function(x) {

R/module_teal_with_splash.R

@@ -22,16 +22,16 @@ ui_teal_with_splash <- function(id,
                                 title,
                                 header = tags$p("Add Title Here"),
                                 footer = tags$p("Add Footer Here")) {
-  checkmate::assert_class(data, "TealDataAbstract")
-  is_pulled_data <- teal.data::is_pulled(data)
+  checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data"))
   ns <- NS(id)
 
   # Startup splash screen for delayed loading
   # We use delayed loading in all cases, even when the data does not need to be fetched.
   # This has the benefit that when filtering the data takes a lot of time initially, the
   # Shiny app does not time out.
-  splash_ui <- if (is_pulled_data) {
-    # blank ui if data is already pulled
+  splash_ui <- if (inherits(data, "teal_data")) {
+    div()
+  } else if (teal.data::is_pulled(data)) {
     div()
   } else {
     message("App was initialized with delayed data loading.")
@@ -55,7 +55,7 @@ ui_teal_with_splash <- function(id,
 #' @return `reactive`, return value of [srv_teal()]
 #' @export
 srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
-  checkmate::assert_class(data, "TealDataAbstract")
+  checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data"))
   moduleServer(id, function(input, output, session) {
     logger::log_trace(
       "srv_teal_with_splash initializing module with data { paste(data$get_datanames(), collapse = ' ')}."
@@ -65,17 +65,33 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
       shinyjs::showLog()
     }
 
-    is_pulled_data <- teal.data::is_pulled(data)
     # raw_data contains TealDataAbstract, i.e. R6 object and container for data
     # reactive to get data through delayed loading
     # we must leave it inside the server because of callModule which needs to pick up the right session
-    if (is_pulled_data) {
-      raw_data <- reactiveVal(data) # will trigger by setting it
+    raw_data <- if (inherits(data, "teal_data")) {
+      reactiveVal(data)
+    } else if (teal.data::is_pulled(data)) {
+      new_data <- new_teal_data(
+        env = lapply(data$get_datasets(), function(x) x$get_raw_data()),
+        code = data$get_code(),
+        keys = data$get_join_keys()
+      )
+      reactiveVal(new_data) # will trigger by setting it
     } else {
-      raw_data <- data$get_server()(id = "startapp_module")
+      raw_data_old <- data$get_server()(id = "startapp_module")
+      raw_data <- reactive({
+        data <- raw_data_old()
+        new_teal_data(
+          env = lapply(data$get_datasets(), function(x) x$get_raw_data()),
+          code = data$get_code(),
+          keys = data$get_join_keys()
+        )
+      })
+
       if (!is.reactive(raw_data)) {
         stop("The delayed loading module has to return a reactive object.")
       }
+      raw_data
     }
 
     res <- srv_teal(id = "teal", modules = modules, raw_data = raw_data, filter = filter)