Fix broken examples (#351)

Closes insightsengineering/teal.slice#492

We don't accept data in module UI anymore & there was a missing dataname
in one example.

---------

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
Co-authored-by: Daniel Sabanes Bove <[email protected]>

R/adtteSpec.R

@@ -219,7 +219,7 @@ adtteSpecInput <- function(inputId, # nolint
 #'       dplyr::mutate(is_event = .data$CNSR == 0)
 #'     MAE <- hermes::multi_assay_experiment
 #'   })
-#'   datanames <- c("ADTTE", "MAE")
+#'   datanames <- c("ADSL", "ADTTE", "MAE")
 #'   datanames(data) <- datanames
 #'   join_keys(data) <- default_cdisc_join_keys[datanames]
 #'

R/experimentSpec.R

@@ -128,23 +128,10 @@ h_gene_data <- function(object, name_annotation) {
 #'
 #' @examples
 #' ui <- function(id,
-#'                data,
 #'                mae_name) {
 #'   ns <- NS(id)
 #'   teal.widgets::standard_layout(
-#'     encoding = div(
-#'       experimentSpecInput(
-#'         ns("my_experiment"),
-#'         data,
-#'         mae_name,
-#'         label_experiments = "Please choose experiment"
-#'       ),
-#'       selectInput(
-#'         ns("property"),
-#'         "Please choose property",
-#'         c("data", "name", "genes", "assays")
-#'       )
-#'     ),
+#'     encoding = uiOutput(ns("encoding_ui")),
 #'     output = div(
 #'       verbatimTextOutput(ns("summary")),
 #'       verbatimTextOutput(ns("head"))
@@ -157,13 +144,29 @@ h_gene_data <- function(object, name_annotation) {
 #'                    filter_panel_api,
 #'                    mae_name) {
 #'   moduleServer(id, function(input, output, session) {
+#'     output$encoding_ui <- renderUI({
+#'       div(
+#'         experimentSpecInput(
+#'           session$ns("my_experiment"),
+#'           data,
+#'           mae_name,
+#'           label_experiments = "Please choose experiment"
+#'         ),
+#'         selectInput(
+#'           session$ns("property"),
+#'           "Please choose property",
+#'           c("data", "name", "genes", "assays")
+#'         )
+#'       )
+#'     })
 #'     experiment <- experimentSpecServer(
 #'       "my_experiment",
 #'       data,
 #'       filter_panel_api,
 #'       mae_name
 #'     )
 #'     result <- reactive({
+#'       req(input$property)
 #'       switch(input$property,
 #'         data = experiment$data(),
 #'         name = experiment$name(),

tests/testthat/adtteSpec/app.R

@@ -1,12 +1,11 @@
 library(teal.modules.hermes)
 
-ui <- function(id,
-               data) {
+ui <- function(id) {
   ns <- NS(id)
 
   teal.widgets::standard_layout(
     encoding = div(
-      experimentSpecInput(ns("experiment"), data = data, mae_name = "MAE"),
+      uiOutput(ns("experiment_ui")),
       assaySpecInput(ns("assay")),
       geneSpecInput(ns("genes"), funs = list(Mean = colMeans)),
       adtteSpecInput(ns("adtte"))
@@ -19,6 +18,9 @@ server <- function(id,
                    data,
                    filter_panel_api) {
   moduleServer(id, function(input, output, session) {
+    output$experiment_ui <- renderUI({
+      experimentSpecInput(session$ns("experiment"), data = data, mae_name = "MAE")
+    })
     experiment <- experimentSpecServer(
       "experiment",
       data = data,

tests/testthat/assaySpec/app.R

@@ -1,16 +1,11 @@
 library(teal.modules.hermes)
 
-ui <- function(id,
-               data) {
+ui <- function(id) {
   ns <- NS(id)
 
   teal.widgets::standard_layout(
     encoding = div(
-      experimentSpecInput(
-        ns("experiment"),
-        data = data,
-        mae_name = "MAE"
-      ),
+      uiOutput(ns("experiment_ui")),
       assaySpecInput(
         ns("assay"),
         label_assays = "Please choose assay"
@@ -22,8 +17,16 @@ ui <- function(id,
 
 server <- function(id,
                    data,
-                   filter_panel_api) {
+                   filter_panel_api,
+                   mae_name) {
   moduleServer(id, function(input, output, session) {
+    output$experiment_ui <- renderUI({
+      experimentSpecInput(
+        session$ns("experiment"),
+        data = data,
+        mae_name = "MAE"
+      )
+    })
     experiment <- experimentSpecServer(
       "experiment",
       data = data,

tests/testthat/experimentSpec/app.R

@@ -1,17 +1,10 @@
 library(teal.modules.hermes)
 
-ui <- function(id,
-               data,
-               mae_name) {
+ui <- function(id) {
   ns <- NS(id)
   teal.widgets::standard_layout(
     encoding = div(
-      experimentSpecInput(
-        ns("my_experiment"),
-        data,
-        mae_name,
-        label_experiments = "Please choose experiment"
-      ),
+      uiOutput(ns("experiment_ui")),
       selectInput(
         ns("property"),
         "Please choose property",
@@ -30,6 +23,14 @@ server <- function(id,
                    filter_panel_api,
                    mae_name) {
   moduleServer(id, function(input, output, session) {
+    output$experiment_ui <- renderUI({
+      experimentSpecInput(
+        session$ns("my_experiment"),
+        data,
+        mae_name,
+        label_experiments = "Please choose experiment"
+      )
+    })
     experiment <- experimentSpecServer(
       "my_experiment",
       data,
@@ -63,9 +64,8 @@ my_app <- function() {
       teal::module(
         label = "experimentSpec example",
         server = server,
-        server_args = list(mae_name = mae_name),
+        server_args = list(mae_name = "MAE"),
         ui = ui,
-        ui_args = list(mae_name = mae_name),
         datanames = "all"
       )
     )

tests/testthat/geneSpec/app.R

@@ -1,8 +1,6 @@
 library(teal.modules.hermes)
 
-ui <- function(id,
-               data,
-               funs) {
+ui <- function(id, funs) {
   ns <- NS(id)
   teal.widgets::standard_layout(
     encoding = div(

tests/testthat/helper-shinytest2.R

@@ -10,6 +10,7 @@ module_ns_shiny2 <- function(app) {
 }
 
 ns2 <- NS("teal-main_ui-filter_panel")
+default_app_seed <- 123
 
 # expect_select_screenshot ----
 shinytest2::AppDriver$set(