diff --git a/R/module_data_summary.R b/R/module_data_summary.R index 0d2bc7b52..e6e26fe73 100644 --- a/R/module_data_summary.R +++ b/R/module_data_summary.R @@ -55,19 +55,19 @@ ui_data_summary <- function(id) { } #' @rdname module_data_summary -srv_data_summary <- function(id, teal_data) { - assert_reactive(teal_data) +srv_data_summary <- function(id, data) { + assert_reactive(data) moduleServer( id = id, function(input, output, session) { logger::log_debug("srv_data_summary initializing") summary_table <- reactive({ - req(inherits(teal_data(), "teal_data")) - if (!length(teal_data())) { + req(inherits(data(), "teal_data")) + if (!length(data())) { return(NULL) } - get_filter_overview_wrapper(teal_data) + get_filter_overview_wrapper(data) }) output$table <- renderUI({ @@ -123,7 +123,7 @@ srv_data_summary <- function(id, teal_data) { " (", vapply( summary_table()[is_unsupported, "dataname"], - function(x) class(teal_data()[[x]])[1], + function(x) class(data()[[x]])[1], character(1L) ), ")" diff --git a/R/module_filter_data.R b/R/module_filter_data.R index 14dc7b4ec..f5b84e106 100644 --- a/R/module_filter_data.R +++ b/R/module_filter_data.R @@ -24,7 +24,7 @@ ui_filter_data <- function(id) { } #' @rdname module_filter_data -srv_filter_data <- function(id, datasets, active_datanames, data_rv, is_active) { +srv_filter_data <- function(id, datasets, active_datanames, data, is_active) { assert_reactive(datasets) moduleServer(id, function(input, output, session) { active_corrected <- reactive(intersect(active_datanames(), datasets()$datanames())) @@ -42,10 +42,10 @@ srv_filter_data <- function(id, datasets, active_datanames, data_rv, is_active) }) }) - trigger_data <- .observe_active_filter_changed(datasets, is_active, active_corrected, data_rv) + trigger_data <- .observe_active_filter_changed(datasets, is_active, active_corrected, data) eventReactive(trigger_data(), { - .make_filtered_teal_data(modules, data = data_rv(), datasets = datasets(), datanames = active_corrected()) + .make_filtered_teal_data(modules, data = data(), datasets = datasets(), datanames = active_corrected()) }) }) } @@ -69,12 +69,12 @@ srv_filter_data <- function(id, datasets, active_datanames, data_rv, is_active) } #' @rdname module_filter_data -.observe_active_filter_changed <- function(datasets, is_active, active_datanames, data_rv) { +.observe_active_filter_changed <- function(datasets, is_active, active_datanames, data) { previous_signature <- reactiveVal(NULL) filter_changed <- reactive({ req(inherits(datasets(), "FilteredData")) new_signature <- c( - teal.code::get_code(data_rv()), + teal.code::get_code(data()), .get_filter_expr(datasets = datasets(), datanames = active_datanames()) ) if (!identical(previous_signature(), new_signature)) { diff --git a/R/module_init_data.R b/R/module_init_data.R index 3bbe7d8bb..c4f588d2d 100644 --- a/R/module_init_data.R +++ b/R/module_init_data.R @@ -53,8 +53,6 @@ srv_init_data <- function(id, data) { moduleServer(id, function(input, output, session) { logger::log_debug("srv_data initializing.") - # data_rv contains teal_data object - # either passed to teal::init or returned from teal_data_module data_out <- if (inherits(data, "teal_data_module")) { output$data <- renderUI(data$ui(id = session$ns("teal_data_module"))) data$server("teal_data_module") diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index e26533cc9..aedc1349d 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -8,7 +8,7 @@ #' #' @inheritParams module_teal #' -#' @param data_rv (`reactive` returning `teal_data`) +#' @param data (`reactive` returning `teal_data`) #' #' @param slices_global (`reactiveVal` returning `modules_teal_slices`) #' see [`module_filter_manager`] @@ -138,7 +138,7 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) { #' @rdname module_teal_module srv_teal_module <- function(id, - data_rv, + data, modules, datasets = NULL, slices_global, @@ -146,7 +146,7 @@ srv_teal_module <- function(id, data_load_status = reactive("ok"), is_active = reactive(TRUE)) { checkmate::assert_string(id) - assert_reactive(data_rv) + assert_reactive(data) checkmate::assert_multi_class(modules, c("teal_modules", "teal_module")) assert_reactive(datasets, null.ok = TRUE) checkmate::assert_class(slices_global, ".slicesGlobal") @@ -158,7 +158,7 @@ srv_teal_module <- function(id, #' @rdname module_teal_module #' @export srv_teal_module.default <- function(id, - data_rv, + data, modules, datasets = NULL, slices_global, @@ -171,7 +171,7 @@ srv_teal_module.default <- function(id, #' @rdname module_teal_module #' @export srv_teal_module.teal_modules <- function(id, - data_rv, + data, modules, datasets = NULL, slices_global, @@ -201,7 +201,7 @@ srv_teal_module.teal_modules <- function(id, function(module_id) { srv_teal_module( id = module_id, - data_rv = data_rv, + data = data, modules = modules$children[[module_id]], datasets = datasets, slices_global = slices_global, @@ -223,7 +223,7 @@ srv_teal_module.teal_modules <- function(id, #' @rdname module_teal_module #' @export srv_teal_module.teal_module <- function(id, - data_rv, + data, modules, datasets = NULL, slices_global, @@ -235,13 +235,13 @@ srv_teal_module.teal_module <- function(id, module_out <- reactiveVal() active_datanames <- reactive({ - .resolve_module_datanames(data = data_rv(), modules = modules) + .resolve_module_datanames(data = data(), modules = modules) }) if (is.null(datasets)) { - datasets <- eventReactive(data_rv(), { - req(inherits(data_rv(), "teal_data")) + datasets <- eventReactive(data(), { + req(inherits(data(), "teal_data")) logger::log_debug("srv_teal_module@1 initializing module-specific FilteredData") - teal_data_to_filtered_data(data_rv(), datanames = active_datanames()) + teal_data_to_filtered_data(data(), datanames = active_datanames()) }) } @@ -257,7 +257,7 @@ srv_teal_module.teal_module <- function(id, "filter_panel", datasets = datasets, active_datanames = active_datanames, - data_rv = data_rv, + data = data, is_active = is_active ) is_transform_failed <- reactiveValues() @@ -318,7 +318,9 @@ srv_teal_module.teal_module <- function(id, } # This function calls a module server function. -.call_teal_module <- function(modules, datasets, filtered_teal_data, reporter) { +.call_teal_module <- function(modules, datasets, data, reporter) { + assert_reactive(data) + # collect arguments to run teal_module args <- c(list(id = "module"), modules$server_args) if (is_arg_used(modules$server, "reporter")) { @@ -331,7 +333,7 @@ srv_teal_module.teal_module <- function(id, } if (is_arg_used(modules$server, "data")) { - args <- c(args, data = list(filtered_teal_data)) + args <- c(args, data = list(data)) } if (is_arg_used(modules$server, "filter_panel_api")) { @@ -346,7 +348,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")) + stopifnot("data must be teal_data object." = inherits(data, "teal_data")) if (is.null(modules$datanames) || identical(modules$datanames, "all")) { names(data) } else { diff --git a/R/module_teal.R b/R/module_teal.R index 66cddbfce..7834d1d8a 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -186,7 +186,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { } ) - data_pulled <- srv_init_data("data", data = data) + data_handled <- srv_init_data("data", data = data) validate_ui <- tags$div( id = session$ns("validate_messages"), @@ -195,13 +195,13 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { ui_validate_error(session$ns("silent_error")), ui_check_module_datanames(session$ns("datanames_warning")) ) - srv_check_class_teal_data("class_teal_data", data_pulled) - srv_validate_error("silent_error", data_pulled, validate_shiny_silent_error = FALSE) - srv_check_module_datanames("datanames_warning", data_pulled, modules) + srv_check_class_teal_data("class_teal_data", data_handled) + srv_validate_error("silent_error", data_handled, validate_shiny_silent_error = FALSE) + srv_check_module_datanames("datanames_warning", data_handled, modules) - data_validated <- .trigger_on_success(data_pulled) + data_validated <- .trigger_on_success(data_handled) - data_rv <- reactive({ + data_signatured <- reactive({ req(inherits(data_validated(), "teal_data")) is_filter_ok <- check_filter_datanames(filter, names(data_validated())) if (!isTRUE(is_filter_ok)) { @@ -216,7 +216,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { }) data_load_status <- reactive({ - if (inherits(data_pulled(), "teal_data")) { + if (inherits(data_handled(), "teal_data")) { "ok" } else if (inherits(data, "teal_data_module")) { "teal_data_module failed" @@ -226,10 +226,10 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { }) datasets_rv <- if (!isTRUE(attr(filter, "module_specific"))) { - eventReactive(data_rv(), { - req(inherits(data_rv(), "teal_data")) + eventReactive(data_signatured(), { + req(inherits(data_signatured(), "teal_data")) logger::log_debug("srv_teal@1 initializing FilteredData") - teal_data_to_filtered_data(data_rv()) + teal_data_to_filtered_data(data_signatured()) }) } @@ -252,7 +252,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { ) if (attr(data, "once")) { - observeEvent(data_rv(), once = TRUE, { + observeEvent(data_signatured(), once = TRUE, { logger::log_debug("srv_teal@2 removing data tab.") # when once = TRUE we pull data once and then remove data tab removeTab("teal_modules-active_tab", target = "teal_data_module") @@ -271,7 +271,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { slices_global <- methods::new(".slicesGlobal", filter, module_labels) modules_output <- srv_teal_module( id = "teal_modules", - data_rv = data_rv, + data = data_signatured, datasets = datasets_rv, modules = modules, slices_global = slices_global, diff --git a/R/module_teal_data.R b/R/module_teal_data.R index bc8d92239..8619b7ced 100644 --- a/R/module_teal_data.R +++ b/R/module_teal_data.R @@ -37,7 +37,10 @@ NULL #' @rdname module_teal_data -ui_teal_data <- function(id, data_module = function(id) NULL) { +#' @aliases ui_teal_data +#' @note +#' `ui_teal_data_module` was renamed from `ui_teal_data`. +ui_teal_data_module <- function(id, data_module = function(id) NULL) { checkmate::assert_string(id) checkmate::assert_function(data_module, args = "id") ns <- NS(id) @@ -49,23 +52,26 @@ ui_teal_data <- function(id, data_module = function(id) NULL) { } #' @rdname module_teal_data -srv_teal_data <- function(id, - data_module = function(id) NULL, - modules = NULL, - validate_shiny_silent_error = TRUE, - is_transform_failed = reactiveValues()) { +#' @aliases srv_teal_data +#' @note +#' `srv_teal_data_module` was renamed from `srv_teal_data`. +srv_teal_data_module <- function(id, + data_module = function(id) NULL, + modules = NULL, + validate_shiny_silent_error = TRUE, + is_transform_failed = reactiveValues()) { checkmate::assert_string(id) checkmate::assert_function(data_module, args = "id") checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"), null.ok = TRUE) checkmate::assert_class(is_transform_failed, "reactivevalues") moduleServer(id, function(input, output, session) { - logger::log_debug("srv_teal_data initializing.") + logger::log_debug("srv_teal_data_module initializing.") is_transform_failed[[id]] <- FALSE - data_out <- data_module(id = "data") - data_handled <- reactive(tryCatch(data_out(), error = function(e) e)) - observeEvent(data_handled(), { - if (!inherits(data_handled(), "teal_data")) { + module_out <- data_module(id = "data") + try_module_out <- reactive(tryCatch(module_out(), error = function(e) e)) + observeEvent(try_module_out(), { + if (!inherits(try_module_out(), "teal_data")) { is_transform_failed[[id]] <- TRUE } else { is_transform_failed[[id]] <- FALSE @@ -89,7 +95,7 @@ srv_teal_data <- function(id, srv_validate_reactive_teal_data( "validate", - data = data_handled, + data = try_module_out, modules = modules, validate_shiny_silent_error = validate_shiny_silent_error, hide_validation_error = is_previous_failed @@ -126,7 +132,7 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length checkmate::assert_flag(validate_shiny_silent_error) moduleServer(id, function(input, output, session) { - # there is an empty reactive cycle on `init` and `data_rv` has `shiny.silent.error` class + # there is an empty reactive cycle on `init` and `data` has `shiny.silent.error` class srv_validate_error("silent_error", data, validate_shiny_silent_error) srv_check_class_teal_data("class_teal_data", data) srv_check_module_datanames("shiny_warnings", data, modules) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index dff1bef14..fa95ec9f4 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -33,13 +33,13 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function( }, server = function(id) { moduleServer(id, function(input, output, session) { - teal_data_rv <- object$server("mutate_inner") - td <- eventReactive(teal_data_rv(), + data <- object$server("mutate_inner") + td <- eventReactive(data(), { - if (inherits(teal_data_rv(), c("teal_data", "qenv.error"))) { - eval_code(teal_data_rv(), code) + if (inherits(data(), c("teal_data", "qenv.error"))) { + eval_code(data(), code) } else { - teal_data_rv() + data() } }, ignoreNULL = FALSE diff --git a/man/module_data_summary.Rd b/man/module_data_summary.Rd index 7deaf4d81..72a0db582 100644 --- a/man/module_data_summary.Rd +++ b/man/module_data_summary.Rd @@ -12,7 +12,7 @@ \usage{ ui_data_summary(id) -srv_data_summary(id, teal_data) +srv_data_summary(id, data) get_filter_overview_wrapper(teal_data) diff --git a/man/module_filter_data.Rd b/man/module_filter_data.Rd index 61d527b9e..a98b9d6b9 100644 --- a/man/module_filter_data.Rd +++ b/man/module_filter_data.Rd @@ -11,11 +11,11 @@ \usage{ ui_filter_data(id) -srv_filter_data(id, datasets, active_datanames, data_rv, is_active) +srv_filter_data(id, datasets, active_datanames, data, is_active) .make_filtered_teal_data(modules, data, datasets = NULL, datanames) -.observe_active_filter_changed(datasets, is_active, active_datanames, data_rv) +.observe_active_filter_changed(datasets, is_active, active_datanames, data) .get_filter_expr(datasets, datanames) } @@ -30,7 +30,7 @@ which implies in filter-panel to be "global". When \code{NULL} then filter-panel \item{active_datanames}{(\code{reactive} returning \code{character}) this module's data names} -\item{data_rv}{(\code{reactive} returning \code{teal_data})} +\item{data}{(\code{reactive} returning \code{teal_data})} \item{modules}{(\code{list} or \code{teal_modules} or \code{teal_module}) Nested list of \code{teal_modules} or \code{teal_module} objects or a single diff --git a/man/module_teal_data.Rd b/man/module_teal_data.Rd index 9c2e756b5..1a8afe9bf 100644 --- a/man/module_teal_data.Rd +++ b/man/module_teal_data.Rd @@ -2,15 +2,17 @@ % Please edit documentation in R/module_teal_data.R \name{module_teal_data} \alias{module_teal_data} +\alias{ui_teal_data_module} \alias{ui_teal_data} +\alias{srv_teal_data_module} \alias{srv_teal_data} \alias{ui_validate_reactive_teal_data} \alias{srv_validate_reactive_teal_data} \title{Execute and validate \code{teal_data_module}} \usage{ -ui_teal_data(id, data_module = function(id) NULL) +ui_teal_data_module(id, data_module = function(id) NULL) -srv_teal_data( +srv_teal_data_module( id, data_module = function(id) NULL, modules = NULL, @@ -52,6 +54,11 @@ This is a low level module to handle \code{teal_data_module} execution and valid \code{\link[=srv_teal]{srv_teal()}} accepts various \code{data} objects and eventually they are all transformed to \code{reactive} \code{\link[teal.data:teal_data]{teal.data::teal_data()}} which is a standard data class in whole \code{teal} framework. } +\note{ +\code{ui_teal_data_module} was renamed from \code{ui_teal_data}. + +\code{srv_teal_data_module} was renamed from \code{srv_teal_data}. +} \section{data validation}{ diff --git a/man/module_teal_module.Rd b/man/module_teal_module.Rd index bc46f86c6..9c4d80361 100644 --- a/man/module_teal_module.Rd +++ b/man/module_teal_module.Rd @@ -22,7 +22,7 @@ ui_teal_module(id, modules, depth = 0L) srv_teal_module( id, - data_rv, + data, modules, datasets = NULL, slices_global, @@ -33,7 +33,7 @@ srv_teal_module( \method{srv_teal_module}{default}( id, - data_rv, + data, modules, datasets = NULL, slices_global, @@ -44,7 +44,7 @@ srv_teal_module( \method{srv_teal_module}{teal_modules}( id, - data_rv, + data, modules, datasets = NULL, slices_global, @@ -55,7 +55,7 @@ srv_teal_module( \method{srv_teal_module}{teal_module}( id, - data_rv, + data, modules, datasets = NULL, slices_global, @@ -78,7 +78,7 @@ more details.} \item{depth}{(\code{integer(1)}) number which helps to determine depth of the modules nesting.} -\item{data_rv}{(\code{reactive} returning \code{teal_data})} +\item{data}{(\code{reactive} returning \code{teal_data})} \item{datasets}{(\code{reactive} returning \code{FilteredData} or \code{NULL}) When \code{datasets} is passed from the parent module (\code{srv_teal}) then \code{dataset} is a singleton diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R index b4eced130..12d0c1c0e 100644 --- a/tests/testthat/test-module_teal.R +++ b/tests/testthat/test-module_teal.R @@ -395,7 +395,7 @@ testthat::describe("srv_teal teal_modules", { ), expr = { testthat::expect_null(modules_output$module_1()) - testthat::expect_s3_class(data_pulled(), "shiny.silent.error") + testthat::expect_s3_class(data_handled(), "shiny.silent.error") session$setInputs(`teal_modules-active_tab` = "module_1") testthat::expect_null(modules_output$module_1()) } @@ -422,7 +422,7 @@ testthat::describe("srv_teal teal_modules", { ), expr = { testthat::expect_null(modules_output$module_1()) - testthat::expect_s3_class(data_pulled(), "simpleError") + testthat::expect_s3_class(data_handled(), "simpleError") session$setInputs(`teal_modules-active_tab` = "module_1") testthat::expect_null(modules_output$module_1()) } @@ -449,7 +449,7 @@ testthat::describe("srv_teal teal_modules", { ), expr = { testthat::expect_null(modules_output$module_1()) - testthat::expect_s3_class(data_pulled(), "qenv.error") + testthat::expect_s3_class(data_handled(), "qenv.error") session$setInputs(`teal_modules-active_tab` = "module_1") testthat::expect_null(modules_output$module_1()) }