Add comprehensive test coverage for teal_modifiers.R and init.R to improve package coverage

R/TealAppDriver.R

@@ -1,5 +1,3 @@
-# FilteredData ------
-
 #' Drive a `teal` application
 #'
 #' Extension of the `shinytest2::AppDriver` class with methods for
@@ -27,8 +25,8 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
     #' @description
     #' Initialize a `TealAppDriver` object for testing a `teal` application.
     #'
-    #' @param data,modules,filter arguments passed to `init`
-    #' @param title_args,header,footer,landing_popup_args to pass into the modifier functions.
+    #' @param app (`teal_app`)
+    #' @param options (`list`) passed to `shinyApp(options)`. See [shiny::shinyApp()].
     #' @param timeout (`numeric`) Default number of milliseconds for any timeout or
     #' timeout_ parameter in the `TealAppDriver` class.
     #' Defaults to 20s.
@@ -44,65 +42,21 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
     #'
     #'
     #' @return  Object of class `TealAppDriver`
-    initialize = function(data,
-                          modules,
-                          filter = teal_slices(),
-                          title_args = list(),
-                          header = tags$p(),
-                          footer = tags$p(),
-                          landing_popup_args = NULL,
+    initialize = function(app,
+                          options = list(),
                           timeout = rlang::missing_arg(),
                           load_timeout = rlang::missing_arg(),
                           ...) {
-      private$data <- data
-      private$modules <- modules
-      private$filter <- filter
-
-      new_title <- modifyList(
-        list(
-          title = "Custom Teal App Title",
-          favicon = .teal_favicon
-        ),
-        title_args
-      )
-      app <- init(
-        data = data,
-        modules = modules,
-        filter = filter
-      ) |>
-        modify_title(title = new_title$title, favicon = new_title$favicon) |>
-        modify_header(header) |>
-        modify_footer(footer)
-
-      if (!is.null(landing_popup_args)) {
-        default_args <- list(
-          title = NULL,
-          content = NULL,
-          footer = modalButton("Accept")
-        )
-        landing_popup_args[names(default_args)] <- Map(
-          function(x, y) if (is.null(y)) x else y,
-          default_args,
-          landing_popup_args[names(default_args)]
-        )
-        app <- add_landing_modal(
-          app,
-          title = landing_popup_args$title,
-          content = landing_popup_args$content,
-          footer = landing_popup_args$footer
-        )
-      }
-
+      checkmate::assert_class(app, "teal_app")
       # Default timeout is hardcoded to 4s in shinytest2:::resolve_timeout
       # It must be set as parameter to the AppDriver
       suppressWarnings(
         super$initialize(
-          app_dir = shinyApp(app$ui, app$server),
+          shiny::shinyApp(ui = app$ui, server = app$server, options = options),
           name = "teal",
           variant = shinytest2::platform_variant(),
           timeout = rlang::maybe_missing(timeout, 20 * 1000),
-          load_timeout = rlang::maybe_missing(load_timeout, 100 * 1000),
-          ...
+          load_timeout = rlang::maybe_missing(load_timeout, 100 * 1000)
         )
       )
 
@@ -701,6 +655,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
       )
       active_base_id <- sub("-wrapper$", "", active_wrapper_id)
 
+      private$ns$module_container <- active_base_id
       private$ns$module <- shiny::NS(active_base_id, "module")
       private$ns$filter_panel <- shiny::NS(active_base_id, "filter_panel")
       private$ns$data_summary <- shiny::NS(active_base_id, "data_summary")

R/teal_modifiers.R

@@ -17,33 +17,16 @@ NULL
 #' @rdname teal_modifiers
 #' @keywords internal
 #' @noRd
-#' @param x One of:
-#'   - A `teal_app` object created using the `init` function.
-#'   - A `teal_module`, `teal_data_module`, or `teal_transform_module` object.
-#'   - A Shiny module UI function with `id` parameter
+#' @param x `teal_app` object created using the `init` function.
 #' @param selector (`character(1)`) CSS selector to find elements to replace
 teal_replace_ui <- function(x, selector, element) {
-  if (inherits(x, c("teal_app", "teal_module", "teal_data_module", "teal_transform_module"))) {
-    x$ui <- teal_replace_ui(x$ui, selector, element)
-    x
-  } else if (checkmate::test_function(x, args = "request")) {
-    # shiny ui function from teal_app
-    function(request) {
-      ui_tq <- htmltools::tagQuery(x(request = request))
-      ui_tq$find(selector)$empty()$append(element)$allTags()
-    }
-  } else if (checkmate::test_function(x, args = "id")) {
-    # shiny module ui function
-    function(id, ...) {
-      ui_tq <- htmltools::tagQuery(x(id = id, ...))
-      if (grepl("^#[a-zA-Z0-9_-]+$", selector)) {
-        selector <- paste0("#", NS(id, gsub("^#", "", selector)))
-      }
-      ui_tq$find(selector)$empty()$append(element)$allTags()
-    }
-  } else {
-    stop("Invalid UI object")
+  checkmate::assert_class(x, "teal_app")
+  new_x <- x
+  new_x$ui <- function(request) {
+    ui_tq <- htmltools::tagQuery(x$ui(request = request))
+    ui_tq$find(selector)$empty()$append(element)$allTags()
   }
+  new_x
 }
 
 #' @rdname teal_modifiers
@@ -200,16 +183,12 @@ add_landing_modal <- function(
 #' @keywords internal
 teal_extend_server <- function(x, custom_server, module_id = character(0)) {
   checkmate::assert_class(x, "teal_app")
-  checkmate::assert_function(custom_server)
+  checkmate::assert_function(custom_server, args = c("input", "output", "session"))
   old_server <- x$server
 
   x$server <- function(input, output, session) {
     old_server(input, output, session)
-    if (all(c("input", "output", "session") %in% names(formals(custom_server)))) {
-      callModule(custom_server, module_id)
-    } else if ("id" %in% names(formals(custom_server))) {
-      custom_server(module_id)
-    }
+    callModule(custom_server, module_id)
   }
   x
 }

tests/testthat/test-init.R

@@ -145,3 +145,120 @@ testthat::test_that("init throws when dataname in filter incompatible w/ datanam
     "Filter 'iris Species' refers to dataname not available in 'data'"
   )
 })
+
+# filter module_specific tests ----
+testthat::test_that("init throws error when filter mapping has invalid module names", {
+  testthat::expect_error(
+    init(
+      data = teal.data::teal_data(iris = iris),
+      modules = modules(example_module(label = "mod1")),
+      filter = teal_slices(
+        teal_slice(dataname = "iris", varname = "Species"),
+        module_specific = TRUE,
+        mapping = list(nonexistent_module = "iris Species")
+      )
+    ),
+    "Some module names in the mapping arguments don't match module labels"
+  )
+})
+
+testthat::test_that("init throws error when modules have duplicate labels with module_specific filter", {
+  testthat::expect_error(
+    init(
+      data = teal.data::teal_data(iris = iris),
+      modules = modules(
+        example_module(label = "duplicate_label"),
+        example_module(label = "duplicate_label")
+      ),
+      filter = teal_slices(
+        teal_slice(dataname = "iris", varname = "Species"),
+        module_specific = TRUE,
+        mapping = list(duplicate_label = "iris Species")
+      )
+    ),
+    "Module labels should be unique when teal_slices\\(mapping = TRUE\\)"
+  )
+})
+
+testthat::test_that("init accepts valid module_specific filter with proper mapping", {
+  testthat::expect_no_error(
+    init(
+      data = teal.data::teal_data(iris = iris, mtcars = mtcars),
+      modules = modules(
+        example_module(label = "iris_module"),
+        example_module(label = "mtcars_module")
+      ),
+      filter = teal_slices(
+        teal_slice(dataname = "iris", varname = "Species"),
+        teal_slice(dataname = "mtcars", varname = "cyl"),
+        module_specific = TRUE,
+        mapping = list(
+          iris_module = "iris Species",
+          global_filters = "mtcars cyl"
+        )
+      )
+    )
+  )
+})
+
+# reporter tests ----
+testthat::test_that("init accepts NULL reporter to disable reporting", {
+  testthat::expect_no_error(
+    init(
+      data = teal.data::teal_data(iris = iris),
+      modules = modules(example_module()),
+      reporter = NULL
+    )
+  )
+})
+
+testthat::test_that("init accepts Reporter object", {
+  testthat::expect_no_error(
+    init(
+      data = teal.data::teal_data(iris = iris),
+      modules = modules(example_module()),
+      reporter = teal.reporter::Reporter$new()
+    )
+  )
+})
+
+# deprecated parameters tests ----
+testthat::test_that("init shows deprecation warning for title parameter", {
+  lifecycle::expect_deprecated(
+    init(
+      data = teal.data::teal_data(iris = iris),
+      modules = modules(example_module()),
+      title = "Deprecated Title"
+    )
+  )
+})
+
+testthat::test_that("init shows deprecation warning for header parameter", {
+  lifecycle::expect_deprecated(
+    init(
+      data = teal.data::teal_data(iris = iris),
+      modules = modules(example_module()),
+      header = tags$div("Deprecated Header")
+    )
+  )
+})
+
+testthat::test_that("init shows deprecation warning for footer parameter", {
+  lifecycle::expect_deprecated(
+    init(
+      data = teal.data::teal_data(iris = iris),
+      modules = modules(example_module()),
+      footer = tags$div("Deprecated Footer")
+    )
+  )
+})
+
+testthat::test_that("init shows deprecation warning for id parameter", {
+  lifecycle::expect_deprecated(
+    init(
+      data = teal.data::teal_data(iris = iris),
+      modules = modules(example_module()),
+      id = "test_id"
+    )
+  )
+})

tests/testthat/test-shinytest2-data_summary.R

@@ -1,8 +1,10 @@
 testthat::test_that("e2e: data summary just list the unfilterable objects at the bottom when provided", {
   skip_if_too_deep(5)
   app <- TealAppDriver$new(
-    data = teal.data::teal_data(x = 1, y = "z", foo = function() NULL),
-    modules = example_module()
+    init(
+      data = teal.data::teal_data(x = 1, y = "z", foo = function() NULL),
+      modules = example_module()
+    )
   )
 
   testthat::expect_match(
@@ -16,8 +18,10 @@ testthat::test_that("e2e: data summary just list the unfilterable objects at the
 testthat::test_that("e2e: data summary table is displayed with 2 columns data without keys", {
   skip_if_too_deep(5)
   app <- TealAppDriver$new(
-    data = simple_teal_data(), # iris, mtcars
-    modules = example_module()
+    init(
+      data = simple_teal_data(), # iris, mtcars
+      modules = example_module()
+    )
   )
 
   testthat::expect_identical(
@@ -41,7 +45,7 @@ testthat::test_that("e2e: data summary table displays datasets by topological_so
     teal.data::join_key("mtcars2", "mtcars1", keys = c("am"))
   )
 
-  app <- TealAppDriver$new(data = data, modules = example_module())
+  app <- TealAppDriver$new(init(data = data, modules = example_module()))
 
   testthat::expect_identical(
     as.data.frame(app$get_active_data_summary_table())[["Data Name"]],
@@ -60,7 +64,7 @@ testthat::test_that("e2e: data summary table is displayed with 3 columns for dat
     teal.data::join_key("mtcars2", "mtcars1", keys = c("am"))
   )
 
-  app <- TealAppDriver$new(data = data, modules = example_module())
+  app <- TealAppDriver$new(init(data = data, modules = example_module()))
 
   testthat::expect_identical(
     as.data.frame(app$get_active_data_summary_table()),
@@ -96,7 +100,7 @@ testthat::test_that("e2e: data summary table does not list unsupported objects",
     teal.data::join_key("mtcars2", "mtcars1", keys = c("am"))
   )
 
-  app <- TealAppDriver$new(data = data, modules = example_module())
+  app <- TealAppDriver$new(init(data = data, modules = example_module()))
 
   testthat::expect_identical(
     as.data.frame(app$get_active_data_summary_table()),
@@ -119,7 +123,7 @@ testthat::test_that("e2e: data summary table displays datasets by names() order
 
   data <- teal.data::teal_data(mtcars1 = mtcars, mtcars2 = data.frame(am = c(0, 1), test = c("a", "b")))
 
-  app <- TealAppDriver$new(data = data, modules = example_module())
+  app <- TealAppDriver$new(init(data = data, modules = example_module()))
 
   testthat::expect_identical(
     as.data.frame(app$get_active_data_summary_table())[["Data Name"]],
@@ -133,7 +137,7 @@ testthat::test_that("e2e: data summary UI can be collpased and expanded (`bslib`
   skip_if_too_deep(5)
 
   data <- teal.data::teal_data(mtcars1 = mtcars, mtcars2 = data.frame(am = c(0, 1), test = c("a", "b")))
-  app <- TealAppDriver$new(data = data, modules = example_module())
+  app <- TealAppDriver$new(init(data = data, modules = example_module()))
 
   # Visible by default
   testthat::expect_true(app$is_visible(".teal-active-data-summary-panel .accordion-collapse"))