Merge branch 'main' into 518-pkgs_imports@main

insightsengineering · Dec 19, 2024 · 669420e · 669420e
2 parents 8bcaa47 + 84683cd
commit 669420e
Show file tree

Hide file tree

Showing 14 changed files with 88 additions and 75 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Type: Package
 Package: teal
 Title: Exploratory Web Apps for Analyzing Clinical Trials Data
-Version: 0.15.2.9093
-Date: 2024-12-18
+Version: 0.15.2.9094
+Date: 2024-12-19
 Authors@R: c(
     person("Dawid", "Kaledkowski", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-9533-457X")),

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# teal 0.15.2.9093
+# teal 0.15.2.9094
 
 ### New features
 

diff --git 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
@@ -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
@@ -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
@@ -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,15 +138,15 @@ 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,
                             reporter = teal.reporter::Reporter$new(),
                             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
@@ -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
@@ -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
@@ -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