443 rcycle@main (#637)

* full input cycle * Dawid reco
insightsengineering · Jun 15, 2022 · 8adc87e · 8adc87e
1 parent 7741bf3
commit 8adc87e
Show file tree

Hide file tree

Showing 7 changed files with 144 additions and 53 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,8 @@
 # teal 0.11.1.9001
 
+### Enhancements
+* Enhanced the initial shiny input cycle, all encoding inputs are available from the beginning when each module server is executed.
+
 # teal 0.11.1
 
 ### Enhancements

diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R
@@ -68,7 +68,11 @@ ui_nested_tabs.teal_modules <- function(id, modules, datasets, depth = 0L) {
       # 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",
+        # select inexisting initially to not trigger reactive cycle
+        # tab is selected by js event after initialization of shiny inputs
+        #  - see wait_for_element in init.js
+        selected = if (depth == 0L) "__none_selected" else NULL
       ),
       lapply(
         names(modules$children),
@@ -155,6 +159,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 {
@@ -180,18 +185,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)
+
+    if (is_reporter_used(modules)) {
+      args <- c(args, list(reporter = reporter))
+    }
 
-  args <- c(list(id = id, datasets = datasets), modules$server_args)
-  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
 }
diff --git a/R/module_teal.R b/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(),

diff --git a/inst/js/init.js b/inst/js/init.js
@@ -3,3 +3,32 @@
 
 // this code alows the show R code "copy to clipbaord" button to work
 var clipboard = new ClipboardJS('.btn[data-clipboard-target]');
+
+// this code alows to click the first tab when then main teal UI is inserted
+// it is needed to achieve the full initial shiny input cycle
+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();
+});
+
diff --git a/tests/testthat/test-module_nested_tabs.R b/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))
 })
 
 

diff --git a/tests/testthat/test-module_tabs_with_filters.R b/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")

diff --git a/vignettes/creating-custom-modules.Rmd b/vignettes/creating-custom-modules.Rmd
@@ -202,11 +202,5 @@ if (interactive()) {
 }
 ```
 
-## `shiny` input cycle
-
-When teal modules are run inside the `teal::init` the initial shiny input cycle is empty for each of them.
-In practice, this means that some inputs might be initialized with `NULL` value, unnecessary triggering some
-observers. A developer has to be aware of this situation as often It will require `shiny::req` or `ignoreInit` argument in observers or `reactive` expressions. This side effect is caused by the `shiny::insertUI` function. We are aware of this inconvenience and have already started to look for a solution.
-
 ## Adding reporting to a module
 Refer to `vignette("adding_support_for_reporting")` to read about adding support for reporting in your `teal` module.