From 8adc87e3bd1ecb09d2cfe602968cb11b3626f60f Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Wed, 15 Jun 2022 15:04:07 +0200 Subject: [PATCH] 443 rcycle@main (#637) * full input cycle * Dawid reco --- NEWS.md | 3 + R/module_nested_tabs.R | 35 +++++++----- R/module_teal.R | 37 +++++++------ inst/js/init.js | 29 ++++++++++ tests/testthat/test-module_nested_tabs.R | 32 ++++++----- .../testthat/test-module_tabs_with_filters.R | 55 ++++++++++++++++++- vignettes/creating-custom-modules.Rmd | 6 -- 7 files changed, 144 insertions(+), 53 deletions(-) diff --git a/NEWS.md b/NEWS.md index 7257264f43..b6c65b3653 100644 --- 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 index a03a05ca16..384ebd67e7 100644 --- 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 index c1f6f98094..2c65a9c82d 100644 --- 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 index 01aba99b0b..fef29b0da2 100644 --- 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 index 1906bfa08a..49d6b92c90 100644 --- 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 index dd39a4842f..e84e1cf8ad 100644 --- 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 index 99b196a587..dd18047035 100644 --- 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.