move tabs management to srv_teal_module

insightsengineering · Sep 16, 2024 · 3d3f3f1 · 3d3f3f1
1 parent 60e4666
commit 3d3f3f1
Show file tree

Hide file tree

Showing 5 changed files with 113 additions and 85 deletions.
diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R
@@ -20,6 +20,17 @@
 #'  When `datasets` is passed from the parent module (`srv_teal`) then `dataset` is a singleton
 #'  which implies in filter-panel to be "global". When `NULL` then filter-panel is "module-specific".
 #'
+#' @param status (`reactive` returning `character`)
+#'  Determines action dependent on a data loading status:
+#'  - `"ok"` when `teal_data` is returned from a data loading.
+#'  - `"disable"` when [teal_data_module()] didn't returned a `teal_data`. Disables tabs buttons
+#'  - `"hide"` when a `reactive` passed to `srv_teal(data)` didn't returned a `teal_data`. Hides the whole tabs
+#'    content.
+#'
+#' @param once (`logical(1)`)
+#'  if [teal_data_module()] has a flag `once = TRUE` then data tab is removed when data is loaded
+#'  succesfully.
+#'
 #' @return
 #' output of currently active module.
 #' - `srv_teal_module.teal_module` returns `reactiveVal` containing output of the called module.
@@ -45,31 +56,34 @@ ui_teal_module.default <- function(id, modules, depth = 0L) {
 #' @export
 ui_teal_module.teal_modules <- function(id, modules, depth = 0L) {
   ns <- NS(id)
-  do.call(
-    tabsetPanel,
-    c(
-      # by giving an id, we can reactively respond to tab changes
-      list(
-        id = ns("active_tab"),
-        type = if (modules$label == "root") "pills" else "tabs"
-      ),
-      lapply(
-        names(modules$children),
-        function(module_id) {
-          module_label <- modules$children[[module_id]]$label
-          if (is.null(module_label)) {
-            module_label <- icon("fas fa-database")
-          }
-          tabPanel(
-            title = module_label,
-            value = module_id, # when clicked this tab value changes input$<tabset panel id>
-            ui_teal_module(
-              id = ns(module_id),
-              modules = modules$children[[module_id]],
-              depth = depth + 1L
+  tags$div(
+    id = ns("wrapper"),
+    do.call(
+      tabsetPanel,
+      c(
+        # by giving an id, we can reactively respond to tab changes
+        list(
+          id = ns("active_tab"),
+          type = if (modules$label == "root") "pills" else "tabs"
+        ),
+        lapply(
+          names(modules$children),
+          function(module_id) {
+            module_label <- modules$children[[module_id]]$label
+            if (is.null(module_label)) {
+              module_label <- icon("fas fa-database")
+            }
+            tabPanel(
+              title = module_label,
+              value = module_id, # when clicked this tab value changes input$<tabset panel id>
+              ui_teal_module(
+                id = ns(module_id),
+                modules = modules$children[[module_id]],
+                depth = depth + 1L
+              )
             )
-          )
-        }
+          }
+        )
       )
     )
   )
@@ -146,6 +160,8 @@ srv_teal_module <- function(id,
                             datasets = NULL,
                             slices_global,
                             reporter = teal.reporter::Reporter$new(),
+                            status = reactive("ok"),
+                            once = FALSE,
                             is_active = reactive(TRUE)) {
   checkmate::assert_string(id)
   assert_reactive(data_rv)
@@ -164,6 +180,8 @@ srv_teal_module.default <- function(id,
                                     datasets = NULL,
                                     slices_global,
                                     reporter = teal.reporter::Reporter$new(),
+                                    status = reactive("ok"),
+                                    once = FALSE,
                                     is_active = reactive(TRUE)) {
   stop("Modules class not supported: ", paste(class(modules), collapse = " "))
 }
@@ -176,12 +194,36 @@ srv_teal_module.teal_modules <- function(id,
                                          datasets = NULL,
                                          slices_global,
                                          reporter = teal.reporter::Reporter$new(),
+                                         status = reactive("ok"),
+                                         once = FALSE,
                                          is_active = reactive(TRUE)) {
   moduleServer(id = id, module = function(input, output, session) {
     logger::log_debug("srv_teal_module.teal_modules initializing the module { deparse1(modules$label) }.")
 
+    observeEvent(status(), {
+      tabs_selector <- sprintf("#%s li a", session$ns("active_tab"))
+      if (identical(status(), "ok")) {
+        shinyjs::show("wrapper")
+        shinyjs::enable(selector = tabs_selector)
+      } else if (identical(status(), "hide")) {
+        shinyjs::hide("wrapper")
+      } else if (identical(status(), "disable")) {
+        shinyjs::disable(selector = tabs_selector)
+      }
+    })
+
+    module_ids <- names(modules$children)
+
+    if (once) {
+      observeEvent(data_rv(), once = TRUE, {
+        # when once = TRUE we pull data once and then remove data tab
+        removeUI(selector = sprintf("#%s a[data-value='teal_data_module']", session$ns("wrapper")))
+        updateTabsetPanel(inputId = "active_tab", selected = module_ids[1])
+      })
+    }
+
     modules_output <- sapply(
-      names(modules$children),
+      module_ids,
       function(module_id) {
         srv_teal_module(
           id = module_id,
@@ -208,6 +250,8 @@ srv_teal_module.teal_module <- function(id,
                                         datasets = NULL,
                                         slices_global,
                                         reporter = teal.reporter::Reporter$new(),
+                                        status = reactive("ok"),
+                                        once = FALSE,
                                         is_active = reactive(TRUE)) {
   logger::log_debug("srv_teal_module.teal_module initializing the module: { deparse1(modules$label) }.")
   moduleServer(id = id, module = function(input, output, session) {

diff --git a/R/module_teal.R b/R/module_teal.R
@@ -46,7 +46,6 @@ ui_teal <- function(id,
                     header = tags$p(),
                     footer = tags$p()) {
   checkmate::assert_character(id, max.len = 1, any.missing = FALSE)
-  checkmate::assert_multi_class(data, "teal_data_module", null.ok = TRUE)
   checkmate::assert(
     .var.name = "title",
     checkmate::check_string(title),
@@ -200,41 +199,6 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
       modules = modules,
       validate_shiny_silent_error = FALSE
     )
-
-    is_failed <- reactive(!inherits(data_pulled(), "teal_data"))
-    if (inherits(data, "teal_data_module")) {
-      # don't display is data_tab is active
-      observeEvent(is_failed(), {
-        if (is_failed()) {
-          shinyjs::disable(selector = ".nav li a:not(.active)")
-        } else {
-          showNotification("Data loaded successfully.", duration = 5)
-          shinyjs::enable(selector = ".nav li a:not(.active)")
-        }
-      })
-      if (isTRUE(attr(data, "once"))) {
-        observeEvent(data_validated(), once = TRUE, {
-          # when once = TRUE we pull data once and then remove data tab
-          removeUI(selector = .data_tab_selector(session$ns))
-          .click_first_module_tab(session$ns)
-        })
-      }
-    }
-
-    if (inherits(data, "reactive")) {
-      observeEvent(is_failed(), {
-        if (is_failed()) {
-          shinyjs::hide("tabpanel_wrapper")
-        } else {
-          showNotification("Data loaded successfully.", duration = 5)
-          shinyjs::show("tabpanel_wrapper")
-        }
-      })
-      removeUI(selector = .data_tab_selector(session$ns))
-      .click_first_module_tab(session$ns)
-    }
-
-
     data_init <- reactive({
       req(inherits(data_validated(), "teal_data"))
       is_filter_ok <- check_filter_datanames(filter, .teal_data_ls(data_validated()))
@@ -246,10 +210,19 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
         )
         warning(is_filter_ok)
       }
-
       .add_signature_to_data(data_validated())
     })
 
+    status <- reactive({
+      if (inherits(data_pulled(), "teal_data")) {
+        "ok"
+      } else if (inherits(data, "teal_data_module")) {
+        "disable"
+      } else {
+        "hide"
+      }
+    })
+
     datasets_rv <- if (!isTRUE(attr(filter, "module_specific"))) {
       eventReactive(data_init(), {
         req(inherits(data_init(), "teal_data"))
@@ -266,7 +239,9 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
       data_rv = data_init,
       datasets = datasets_rv,
       modules = modules,
-      slices_global = slices_global
+      slices_global = slices_global,
+      status = status,
+      once = isTRUE(attr(data, "once")) || test_reactive(data)
     )
     mapping_table <- srv_filter_manager_panel("filter_manager_panel", slices_global = slices_global)
     snapshots <- srv_snapshot_manager_panel("snapshot_manager_panel", slices_global = slices_global)
@@ -279,15 +254,3 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
 
   invisible(NULL)
 }
-
-
-.data_tab_selector <- function(ns) {
-  sprintf("#%s a[data-value='teal_data_module']", ns("tabpanel_wrapper"))
-}
-
-.click_first_module_tab <- function(ns) {
-  shinyjs::runjs(sprintf(
-    "document.querySelector('#%s .nav li:nth-child(2) a').click();",
-    ns("tabpanel_wrapper")
-  ))
-}
diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R
@@ -24,7 +24,7 @@ ui_teal_with_splash <- function(id,
     what = "ui_teal_with_splash()",
     details = "Deprecated, please use `ui_teal` instead"
   )
-  ui_teal(id = id, data = data, title = title, header = header, footer = footer)
+  ui_teal(id = id, title = title, header = header, footer = footer)
 }
 
 #' @export

diff --git a/man/module_teal_module.Rd b/man/module_teal_module.Rd
diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R
@@ -167,7 +167,7 @@ testthat::describe("srv_teal teal_modules", {
         )
       ),
       expr = {
-        testthat::expect_null(data_init(), NULL)
+        testthat::expect_error(data_init(), NULL)
         testthat::expect_null(modules_output$module_1())
         testthat::expect_null(modules_output$module_2())
       }
@@ -186,7 +186,7 @@ testthat::describe("srv_teal teal_modules", {
         )
       ),
       expr = {
-        testthat::expect_null(data_init())
+        testthat::expect_error(data_init())
         session$setInputs(`teal_modules-active_tab` = "module_1")
         testthat::expect_identical(modules_output$module_1(), 101L)
         testthat::expect_null(modules_output$module_2())
@@ -209,7 +209,7 @@ testthat::describe("srv_teal teal_modules", {
         )
       ),
       expr = {
-        testthat::expect_null(data_init())
+        testthat::expect_error(data_init())
         session$setInputs(`teal_modules-active_tab` = "module_1")
         testthat::expect_identical(modules_output$module_1(), 101L)
         testthat::expect_null(modules_output$module_2())
@@ -240,7 +240,7 @@ testthat::describe("srv_teal teal_modules", {
         )
       ),
       expr = {
-        testthat::expect_null(data_init())
+        testthat::expect_error(data_init())
         session$setInputs(`teal_modules-active_tab` = "module_1")
         testthat::expect_identical(modules_output$module_1(), 101L)
         testthat::expect_null(modules_output$module_2())
@@ -263,7 +263,7 @@ testthat::describe("srv_teal teal_modules", {
         )
       ),
       expr = {
-        testthat::expect_null(data_init())
+        testthat::expect_error(data_init())
         session$setInputs(`teal_modules-active_tab` = "module_1")
         testthat::expect_s4_class(modules_output$module_1()(), "teal_data")
       }
@@ -290,7 +290,7 @@ testthat::describe("srv_teal teal_modules", {
       ),
       expr = {
         testthat::expect_null(modules_output$module_1())
-        testthat::expect_null(data_init())
+        testthat::expect_error(data_init())
         session$setInputs(`teal_modules-active_tab` = "module_1")
         testthat::expect_null(modules_output$module_1())
       }
@@ -317,7 +317,7 @@ testthat::describe("srv_teal teal_modules", {
       ),
       expr = {
         testthat::expect_null(modules_output$module_1())
-        testthat::expect_null(data_init())
+        testthat::expect_error(data_init())
         session$setInputs(`teal_modules-active_tab` = "module_1")
         testthat::expect_null(modules_output$module_1())
       }
@@ -344,7 +344,7 @@ testthat::describe("srv_teal teal_modules", {
       ),
       expr = {
         testthat::expect_null(modules_output$module_1())
-        testthat::expect_null(data_init())
+        testthat::expect_error(data_init())
         session$setInputs(`teal_modules-active_tab` = "module_1")
         testthat::expect_null(modules_output$module_1())
       }
@@ -371,7 +371,7 @@ testthat::describe("srv_teal teal_modules", {
       ),
       expr = {
         testthat::expect_null(modules_output$module_1())
-        testthat::expect_null(data_init())
+        testthat::expect_error(data_init())
         session$setInputs(`teal_modules-active_tab` = "module_1")
         testthat::expect_null(modules_output$module_1())
       }