From 5c17ccfd780fe7e22a62212fee77fbeec4e00620 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 4 Oct 2023 13:51:20 +0200 Subject: [PATCH] following new teal_data class --- R/init.R | 24 ++++++++++++++++++++---- R/module_nested_tabs.R | 14 ++++++++------ R/module_teal.R | 27 ++++----------------------- R/module_teal_with_splash.R | 18 ++++++++++-------- 4 files changed, 42 insertions(+), 41 deletions(-) diff --git a/R/init.R b/R/init.R index 4fdb147951..d76a9ef750 100644 --- a/R/init.R +++ b/R/init.R @@ -116,7 +116,10 @@ init <- function(data, 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 +141,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 +150,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 +226,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) } diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 443587b07e..0a012f32dd 100644 --- a/R/module_nested_tabs.R +++ b/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 diff --git a/R/module_teal.R b/R/module_teal.R index fbce6ed5bd..d61dc42a67 100644 --- a/R/module_teal.R +++ b/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) { diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 2a4b19e3e9..910c346fcb 100644 --- a/R/module_teal_with_splash.R +++ b/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,19 @@ 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)) { + reactiveVal(data) # will trigger by setting it } else { raw_data <- data$get_server()(id = "startapp_module") 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)