443 rcycle@main

R/module_nested_tabs.R

@@ -53,18 +53,19 @@ ui_nested_tabs.default <- function(id, modules, datasets, depth = 0L) {
   stop("Modules class not supported: ", paste(class(modules), collapse = " "))
 }
 
-#' @rdname ui_nested_tabs
-#' @export
+
 #' @keywords internal
-ui_nested_tabs.teal_modules <- function(id, modules, datasets, depth = 0L) {
+ui_nested_tabs_base <- function(id, modules, datasets, depth = 0L, selected) {
   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"
+        type = if (modules$label == "root") "pills" else "tabs",
+        # some random name to select nothing
+        selected = selected
       ),
       lapply(
         names(modules$children),
@@ -80,6 +81,18 @@ ui_nested_tabs.teal_modules <- function(id, modules, datasets, depth = 0L) {
   )
 }
 
+#' @keywords internal
+ui_nested_tabs_init <- function(id, modules, datasets, depth = 0L) {
+  ui_nested_tabs_base(id, modules, datasets, depth, "none")
+}
+
+#' @rdname ui_nested_tabs
+#' @export
+#' @keywords internal
+ui_nested_tabs.teal_modules <- function(id, modules, datasets, depth = 0L) {
+  ui_nested_tabs_base(id, modules, datasets, depth, NULL)
+}
+
 #' @rdname ui_nested_tabs
 #' @export
 #' @keywords internal
@@ -151,6 +164,7 @@ srv_nested_tabs.teal_modules <- function(id, datasets, modules, reporter) {
 
     get_active_module <- reactive({
       if (length(modules$children) == 1L) {
+        req(input$active_tab)
         # single tab is active by default
         modules_reactive[[1]]()
       } else {
@@ -176,18 +190,22 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, reporter) {
     )
   )
 
-  modules$server_args <- teal.transform::resolve_delayed(modules$server_args, datasets)
-  is_module_server <- isTRUE("id" %in% names(formals(modules$server)))
+  module_reactive <- reactive({
+    modules$server_args <- teal.transform::resolve_delayed(modules$server_args, datasets)
+    is_module_server <- isTRUE("id" %in% names(formals(modules$server)))
+    args <- c(list(id = id, datasets = datasets), modules$server_args)
 
-  args <- c(list(id = id, datasets = datasets), modules$server_args)
-  if (is_reporter_used(modules)) {
-    args <- c(args, list(reporter = reporter))
-  }
+    if (is_reporter_used(modules)) {
+      args <- c(args, list(reporter = reporter))
+    }
+
+    if (is_module_server) {
+      do.call(modules$server, args)
+    } else {
+      do.call(callModule, c(args, list(module = modules$server)))
+    }
+    modules
+  })
 
-  if (is_module_server) {
-    do.call(modules$server, args)
-  } else {
-    do.call(callModule, c(args, list(module = modules$server)))
-  }
-  reactive(modules)
+  module_reactive
 }

R/module_tabs_with_filters.R

@@ -97,7 +97,7 @@ ui_tabs_with_filters <- function(id, modules, datasets) {
   filter_and_info_ui <- datasets$ui_filter_panel(ns("filter_panel"))
 
   # modules must be teal_modules, not teal_module; otherwise we will get the UI and not a tabsetPanel of UIs
-  teal_ui <- ui_nested_tabs(ns("root"), modules = modules, datasets)
+  teal_ui <- ui_nested_tabs_init(ns("root"), modules = modules, datasets)
 
   filter_panel_btn <- tags$li(
     style = "flex-grow : 1;",

R/module_teal.R

@@ -89,17 +89,15 @@ ui_teal <- function(id,
     )
   )
 
-  res <- shinyUI(
-    fluidPage(
-      title = title,
-      include_teal_css_js(),
-      tags$header(header),
-      tags$hr(style = "margin: 7px 0;"),
-      shiny_busy_message_panel,
-      splash_ui,
-      tags$hr(),
-      tags$footer(div(footer, textOutput(ns("identifier"))))
-    )
+  res <- fluidPage(
+    title = title,
+    include_teal_css_js(),
+    tags$header(header),
+    tags$hr(style = "margin: 7px 0;"),
+    shiny_busy_message_panel,
+    splash_ui,
+    tags$hr(),
+    tags$footer(div(footer, textOutput(ns("identifier"))))
   )
   return(res)
 }
@@ -216,13 +214,17 @@ srv_teal <- function(id, modules, raw_data, filter = list()) {
         where = "beforeEnd",
         # we put it into a div, so it can easily be removed as a whole, also when it is a tagList (and not
         # just the first item of the tagList)
-        ui = div(ui_tabs_with_filters(
-          session$ns("main_ui"),
-          modules = modules,
-          datasets = datasets_reactive()
-        )),
+        ui = div(
+          # This id is linked with a inst/js/init.js code which activates the app
+          id = "teal_main_modules_ui",
+          ui_tabs_with_filters(
+            session$ns("main_ui"),
+            modules = modules,
+            datasets = datasets_reactive()
+          )
+        ),
         # needed so that the UI inputs are available and can be immediately updated, otherwise, updating may not
-        # have any effect as they are ignored when not present, see note in `module_add_filter_variable.R`
+        # have any effect as they are ignored when not present
         immediate = TRUE
       )
 
@@ -232,7 +234,6 @@ srv_teal <- function(id, modules, raw_data, filter = list()) {
 
       # must make sure that this is only executed once as modules assume their observers are only
       # registered once (calling server functions twice would trigger observers twice each time)
-      # `once = TRUE` ensures this
       active_module <- srv_tabs_with_filters(
         id = "main_ui",
         datasets = datasets_reactive(),

inst/js/init.js

@@ -3,3 +3,30 @@
 
 // this code alows the show R code "copy to clipbaord" button to work
 var clipboard = new ClipboardJS('.btn[data-clipboard-target]');
+
+function wait_for_element(selector) {
+    return new Promise(resolve => {
+        let init_check = document.querySelector(selector);
+        if (init_check) {
+            return resolve(init_check);
+        }
+
+        const observer = new MutationObserver(() => {
+            let obs_check = document.querySelector(selector);
+            if (obs_check) {
+                resolve(obs_check);
+                observer.disconnect();
+            }
+        });
+
+        observer.observe(document.body, {
+            childList: true,
+            subtree: true
+        });
+    });
+}
+
+wait_for_element('div#teal_main_modules_ui').then(() => {
+  $("div#teal_main_modules_ui a[data-toggle='tab']")[0].click();
+});
+

tests/testthat/test-module_nested_tabs.R

@@ -1,5 +1,6 @@
 filtered_data <- teal.slice:::FilteredData$new()
 filtered_data$set_dataset(teal.data::dataset(dataname = "iris", x = head(iris)))
+
 test_module1 <- module(
   label = "test1",
   ui = function(id, ...) NULL,
@@ -33,23 +34,24 @@ testthat::test_that("srv_nested_tabs throws error if reporter is not inherited f
 })
 
 # server -------
-testthat::test_that("passed shiny module is initialized", {
-  testthat::expect_message(
-    shiny::testServer(
-      app = srv_nested_tabs,
-      args = list(
-        id = "test",
-        datasets = filtered_data,
-        modules = modules(test_module1),
-        reporter = teal.reporter::Reporter$new()
-      ),
-      expr = NULL
-    ),
-    "1"
+testthat::test_that("passed shiny module is initialized, empty as is delayed", {
+  testthat::expect_true(
+    is.null(
+      shiny::testServer(
+        app = srv_nested_tabs,
+        args = list(
+          id = "test",
+          datasets = filtered_data,
+          modules = modules(test_module1),
+          reporter = teal.reporter::Reporter$new()
+        ),
+        expr = NULL
+      )
+    )
   )
 })
 
-testthat::test_that("nested teal-modules are initialized", {
+testthat::test_that("nested teal-modules are initialized, empty as is delayed", {
   out <- testthat::capture_messages(
     shiny::testServer(
       app = srv_nested_tabs,
@@ -65,7 +67,7 @@ testthat::test_that("nested teal-modules are initialized", {
       expr = NULL
     )
   )
-  testthat::expect_identical(out, c("1\n", "2\n", "3\n", "4\n"))
+  testthat::expect_identical(out, character(0))
 })
 
 

tests/testthat/test-module_tabs_with_filters.R

@@ -4,10 +4,22 @@ filtered_data$set_dataset(teal.data::dataset(dataname = "mtcars", x = head(mtcar
 
 test_module1 <- module(
   label = "iris tab",
+  ui = function(id, ...) NULL,
+  server = function(id, datasets) moduleServer(id, function(input, output, session) message("1")),
   filters = "iris"
 )
+
 test_module2 <- module(
   label = "mtcars tab",
+  ui = function(id, ...) NULL,
+  server = function(id, datasets) moduleServer(id, function(input, output, session) message("2")),
+  filters = "mtcars"
+)
+
+test_module3 <- module(
+  label = "mtcars tab2",
+  ui = function(id, ...) NULL,
+  server = function(id, datasets) moduleServer(id, function(input, output, session) message("3")),
   filters = "mtcars"
 )
 
@@ -18,6 +30,46 @@ testthat::test_that("srv_tabs_with_filters throws error if reporter is not of cl
   )
 })
 
+testthat::test_that("passed shiny module is initialized when its tab is activated (clicked)", {
+  testthat::expect_message(
+    shiny::testServer(
+      app = srv_tabs_with_filters,
+      args = list(
+        id = "test",
+        datasets = filtered_data,
+        modules = modules(test_module3),
+        filter = list(),
+        reporter = teal.reporter::Reporter$new()
+      ),
+      expr = {
+        session$setInputs(`root-active_tab` = "mtcars_tab")
+      }
+    ),
+    "3"
+  )
+})
+
+testthat::test_that("passed shiny modules are initialized when their tab is activated (clicked)", {
+  out <- testthat::capture_messages(
+    shiny::testServer(
+      app = srv_tabs_with_filters,
+      args = list(
+        id = "test",
+        datasets = filtered_data,
+        modules = modules(test_module1, test_module2, test_module3),
+        filter = list(),
+        reporter = teal.reporter::Reporter$new()
+      ),
+      expr = {
+        session$setInputs(`root-active_tab` = "iris_tab")
+        session$setInputs(`root-active_tab` = "mtcars_tab")
+        session$setInputs(`root-active_tab` = "mtcars_tab2")
+      }
+    )
+  )
+  testthat::expect_identical(out, c("1\n", "2\n", "3\n"))
+})
+
 testthat::test_that("active_datanames() returns dataname from single tab", {
   shiny::testServer(
     app = srv_tabs_with_filters,
@@ -29,6 +81,7 @@ testthat::test_that("active_datanames() returns dataname from single tab", {
       reporter = teal.reporter::Reporter$new()
     ),
     expr = {
+      session$setInputs(`root-active_tab` = "iris_tab")
       testthat::expect_identical(active_datanames(), "iris")
     }
   )
@@ -45,7 +98,7 @@ testthat::test_that("active_datanames() returns dataname from active tab after c
       reporter = teal.reporter::Reporter$new()
     ),
     expr = {
-      testthat::expect_error(active_datanames()) # to trigger active_module
+      testthat::expect_error(active_datanames())
       session$setInputs(`root-active_tab` = "iris_tab")
       testthat::expect_identical(active_datanames(), "iris")
       session$setInputs(`root-active_tab` = "mtcars_tab")