From 02edb149eb6fd4b544035b1a946276dda550367f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= <185338939+llrs-roche@users.noreply.github.com> Date: Thu, 19 Dec 2024 10:41:15 +0100 Subject: [PATCH] Rename teal_data_module.R functions (#1430) # Pull Request Renamed parameters to data, and renamed data_rv, filtered_teal_data and teal_data parameter to data. This simplifies the different parameters used across teal and instead of having 3 diferents parameters we will have one. This will avoid affecting the end users and issues with documentation diverging on different places. Internal module objects were also renamed to be more consistent. The data parameter may refer to different classes, but developers should rely on the assertions to know which class is accepted instead of the name. Fixes #1323 Due to the renaming I had to change some tests. --------- Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> --- R/module_data_summary.R | 12 ++++++------ R/module_filter_data.R | 10 +++++----- R/module_init_data.R | 2 -- R/module_nested_tabs.R | 32 ++++++++++++++++--------------- R/module_teal.R | 24 +++++++++++------------ R/module_teal_data.R | 32 ++++++++++++++++++------------- R/teal_data_module-eval_code.R | 10 +++++----- man/module_data_summary.Rd | 2 +- man/module_filter_data.Rd | 6 +++--- man/module_teal_data.Rd | 11 +++++++++-- man/module_teal_module.Rd | 10 +++++----- tests/testthat/test-module_teal.R | 6 +++--- 12 files changed, 85 insertions(+), 72 deletions(-) diff --git a/R/module_data_summary.R b/R/module_data_summary.R index 0d2bc7b526..e6e26fe734 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 14dc7b4ecf..f5b84e1060 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 3bbe7d8bb2..c4f588d2df 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 e26533cc92..aedc1349d5 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 66cddbfce8..7834d1d8ad 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 bc8d92239b..8619b7cedd 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 dff1bef14c..fa95ec9f4b 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 7deaf4d81b..72a0db582c 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 61d527b9ef..a98b9d6b95 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 9c2e756b5b..1a8afe9bf2 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 bc46f86c61..9c4d80361f 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 b4eced1301..12d0c1c0e1 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()) }