- add asserts on datanames in teal::init

- more tests
- address @chlebowa comments

R/init.R

@@ -147,7 +147,7 @@ init <- function(data,
   hashables$data <- if (inherits(hashables$data, "teal_data")) {
     as.list(hashables$data@env)
   } else if (inherits(data, "teal_data_module")) {
-    # what?
+    body(data$server)
   } else if (hashables$data$is_pulled()) {
     sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) {
       hashables$data$get_dataset(dn)$get_raw_data()
@@ -198,6 +198,7 @@ init <- function(data,
     is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data))
     if (!isTRUE(is_filter_ok)) {
       logger::log_warn(is_filter_ok)
+      warning(is_filter_ok)
       # we allow app to continue if applied filters are outside
       # of possible data range
     }

R/module_teal_with_splash.R

@@ -31,7 +31,7 @@ ui_teal_with_splash <- function(id,
   # Shiny app does not time out.
 
   splash_ui <- if (inherits(data, "teal_data_module")) {
-    data$ui(ns("data"))
+    data$ui(ns("teal_data_module"))
   } else if (inherits(data, "teal_data")) {
     div()
   } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) {
@@ -71,10 +71,10 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
     # raw_data contains teal_data object
     # either passed to teal::init or returned from ddl
     raw_data <- if (inherits(data, "teal_data_module")) {
-      ddl_out <- do.call(
+      do.call(
         data$server,
         append(
-          list(id = "data"),
+          list(id = "teal_data_module"),
           attr(data, "server_args") # might be NULL or list() - both are fine
         ),
         quote = TRUE
@@ -130,7 +130,6 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
         return(NULL)
       }
 
-
       is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data))
       is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data))
 

R/teal_data_module.R

@@ -6,6 +6,9 @@
 #'  `shiny` `ui` module with `id` argument
 #' @param server (`function(id)`)\cr
 #'  `shiny` server function with `id` as argument. Module should return reactive `teal_data`.
+#'
+#' @return object of class `teal_data_module`
+#'
 #' @examples
 #' data <- teal_data_module(
 #'   ui = function(id) {

R/utils.R

@@ -150,7 +150,7 @@ check_modules_datanames <- function(modules, datanames) {
       extra_datanames <- setdiff(modules$datanames, c("all", datanames))
       if (length(extra_datanames)) {
         sprintf(
-          "- Module %s has a different dataname than available in a 'data': %s not in %s",
+          "- Module '%s' has a different dataname than available in a 'data': %s not in %s",
           modules$label,
           toString(dQuote(extra_datanames, q = FALSE)),
           toString(dQuote(datanames, q = FALSE))
@@ -174,10 +174,10 @@ check_filter_datanames <- function(filters, datanames) {
       dataname <- shiny::isolate(filter$dataname)
       if (!dataname %in% datanames) {
         sprintf(
-          "- Filter %s has a different dataname than available in a 'data':\n %s not in %s",
-          filter$label,
-          dQuote(dataname),
-          toString(dQuote(datanames))
+          "- Filter '%s' has a different dataname than available in a 'data':\n %s not in %s",
+          shiny::isolate(filter$id),
+          dQuote(dataname, q = FALSE),
+          toString(dQuote(datanames, q = FALSE))
         )
       }
     }

tests/testthat/test-init.R

@@ -192,5 +192,20 @@ testthat::test_that("init filter accepts `teal_slices`", {
   )
 })
 
-# todo: when modules datanames not matching datanames(data)
-# todo: when filters datanames not matching datanames(data)
+testthat::test_that("init throws when incompatible module's datanames", {
+  testthat::expect_error(
+    init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))),
+    '"iris" not in "mtcars"'
+  )
+})
+
+testthat::test_that("init throws when incompatible filter's datanames", {
+  testthat::expect_warning(
+    init(
+      data = teal_data(mtcars = mtcars),
+      modules = modules(example_module()),
+      filter = teal_slices(teal_slice(dataname = "iris", varname = "Species"))
+    ),
+    '"iris" not in "mtcars"'
+  )
+})

tests/testthat/test-module_teal_with_splash.R

@@ -109,7 +109,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL if incom
       testthat::expect_is(raw_data_checked, "reactive")
       testthat::expect_output(
         testthat::expect_null(raw_data_checked()),
-        "“iris” not in “mtcars”"
+        '"iris" not in "mtcars"'
       )
     }
   )