@chlebowa @ruckip review

NEWS.md

@@ -2,7 +2,7 @@
 
 ### New features
 
-* `data` argument in `init` accepts now `teal_data` and `teal_data_module`.
+* `data` argument in `init` now accepts `teal_data` and `teal_data_module`.
 * Added `landing_popup_module` function which creates a module that will display a popup when the app starts. The popup will block access to the app until it is dismissed.
 * Filter state snapshots can now be uploaded from file. See `?snapshot`.
 

R/dummy_functions.R

@@ -75,7 +75,6 @@ example_datasets <- function() { # nolint
 #'
 #' @description `r lifecycle::badge("experimental")`
 #' @inheritParams module
-#' @param src (`logical(1)`) whether to display reproducible R code in the module.
 #' @return A `teal` module which can be included in the `modules` argument to [teal::init()].
 #' @examples
 #' app <- init(
@@ -89,7 +88,7 @@ example_datasets <- function() { # nolint
 #'   shinyApp(app$ui, app$server)
 #' }
 #' @export
-example_module <- function(label = "example teal module", datanames = "all", src = TRUE) {
+example_module <- function(label = "example teal module", datanames = "all") {
   checkmate::assert_string(label)
   module(
     label,
@@ -110,9 +109,7 @@ example_module <- function(label = "example teal module", datanames = "all", src
         output = verbatimTextOutput(ns("text")),
         encoding = div(
           selectInput(ns("dataname"), "Choose a dataset", choices = names(data)),
-          if (src) {
-            teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
-          }
+          teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
         )
       )
     },

R/init.R

@@ -190,6 +190,10 @@ init <- function(data,
   }
 
   if (inherits(data, "teal_data")) {
+    if (length(teal.data::datanames(data)) == 0) {
+      stop("`data` object has no datanames. Specify `datanames(data)` and try again.")
+    }
+
     # in case of teal_data_module this check is postponed to the srv_teal_with_splash
     is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data))
     if (!isTRUE(is_modules_ok)) {
@@ -200,7 +204,6 @@ 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

@@ -110,7 +110,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
     }
 
     if (!is.reactive(raw_data)) {
-      stop("The delayed loading module has to return a reactive object.")
+      stop("The `teal_data_module` has to return a reactive object.", call. = FALSE)
     }
 
     raw_data_checked <- reactive({
@@ -128,9 +128,9 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
           need(
             FALSE,
             paste(
-              "Error when executing `teal_data_module`:\n",
+              "Error when executing `teal_data_module`:\n ",
               data$message,
-              "\n Check your inputs or contact app developer if error persist"
+              "\n Check your inputs or contact app developer if error persists"
             )
           )
         )
@@ -142,9 +142,9 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
           need(
             FALSE,
             paste0(
-              "Error when executing `teal_data_module`:",
+              "Error when executing `teal_data_module`:\n ",
               attr(data, "condition")$message,
-              "\n Check your inputs or contact app developer if error persist"
+              "\n Check your inputs or contact app developer if error persists"
             )
           )
         )
@@ -154,19 +154,22 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
         need(
           inherits(data, "teal_data"),
           paste(
-            "Error: `teal_data_module` didn't return `teal_data` object",
-            "\n Check your inputs or contact app developer if error persist"
+            "Error: `teal_data_module` did not return `teal_data` object",
+            "\n Check your inputs or contact app developer if error persists"
           )
         )
       )
 
+      validate(need(teal.data::datanames(data), "Data has no datanames. Contact app developer"))
+
+
       is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data))
       is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data))
 
       validate(need(isTRUE(is_modules_ok), is_modules_ok))
 
       if (!isTRUE(is_filter_ok)) {
-        showNotification(is_filter_ok, type = "warning")
+        showNotification(is_filter_ok, type = "warning", duration = 10)
         logger::log_warn(is_filter_ok)
       }
 

R/utils.R

@@ -160,7 +160,7 @@ check_modules_datanames <- function(modules, datanames) {
       extra_datanames <- setdiff(modules$datanames, c("all", datanames))
       if (length(extra_datanames)) {
         sprintf(
-          "- Module '%s' uses different datanames than available in the 'data': (%s) not in (%s)",
+          "- Module '%s' uses datanames not available in the 'data': (%s) not in (%s)",
           modules$label,
           toString(dQuote(extra_datanames, q = FALSE)),
           toString(dQuote(datanames, q = FALSE))
@@ -178,7 +178,7 @@ check_modules_datanames <- function(modules, datanames) {
 
 #' Check `datanames` in filters
 #'
-#' This function check `datanames` in filters correspond to those in `data`,
+#' This function checks whether `datanames` in filters correspond to those in `data`,
 #' returning character vector with error messages or TRUE if all checks pass.
 #'
 #' @param filters (`teal_slices`) object
@@ -188,20 +188,22 @@ check_modules_datanames <- function(modules, datanames) {
 #' @keywords internal
 check_filter_datanames <- function(filters, datanames) {
   # check teal_slices against datanames
-  out <- sapply(
+  out <- unlist(sapply(
     filters, function(filter) {
       dataname <- shiny::isolate(filter$dataname)
       if (!dataname %in% datanames) {
         sprintf(
-          "- Filter '%s' refers to dataname that in unavailable to 'data':\n %s not in (%s)",
+          "- Filter '%s' refers to dataname not available in 'data':\n %s not in (%s)",
           shiny::isolate(filter$id),
           dQuote(dataname, q = FALSE),
           toString(dQuote(datanames, q = FALSE))
         )
       }
     }
-  )
-  if (length(unlist(out))) {
+  ))
+
+
+  if (length(out)) {
     paste(out, collapse = "\n")
   } else {
     TRUE

tests/testthat/test-init.R

@@ -192,20 +192,31 @@ testthat::test_that("init filter accepts `teal_slices`", {
   )
 })
 
-testthat::test_that("init throws when incompatible module's datanames", {
+testthat::test_that("init throws when data has no datanames", {
   testthat::expect_error(
-    init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))),
-    "Module 'example teal module' uses different datanames than available in the 'data'"
+    init(data = teal_data(), modules = list(example_module())),
+    "has no datanames"
+  )
+})
+
+testthat::test_that("init throws when incompatible module's datanames", {
+  msg <- "Module 'example teal module' uses datanames not available in the 'data'"
+  testthat::expect_output(
+    testthat::expect_error(
+      init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))),
+      msg
+    ),
+    msg
   )
 })
 
 testthat::test_that("init throws when incompatible filter's datanames", {
-  testthat::expect_warning(
+  testthat::expect_output(
     init(
       data = teal_data(mtcars = mtcars),
       modules = modules(example_module()),
       filter = teal_slices(teal_slice(dataname = "iris", varname = "Species"))
     ),
-    "Filter 'iris Species' refers to dataname that in unavailable to 'data'"
+    "Filter 'iris Species' refers to dataname not available in 'data'"
   )
 })

tests/testthat/test-module_teal_with_splash.R

@@ -23,7 +23,7 @@ testthat::test_that("srv_teal_with_splash throws when teal_data_module doesn't r
       ),
       expr = {}
     ),
-    "The delayed loading module has to return a reactive object."
+    "The `teal_data_module` has to return a reactive object."
   )
 })
 
@@ -47,7 +47,7 @@ testthat::test_that("srv_teal_with_splash passes teal_data to reactiveVal", {
     app = srv_teal_with_splash,
     args = list(
       id = "test",
-      data = teal_data(),
+      data = teal_data(iris = iris),
       modules = modules(example_module())
     ),
     expr = {
@@ -57,6 +57,20 @@ testthat::test_that("srv_teal_with_splash passes teal_data to reactiveVal", {
   )
 })
 
+testthat::test_that("srv_teal_with_splash throws when datanames are empty", {
+  shiny::testServer(
+    app = srv_teal_with_splash,
+    args = list(
+      id = "test",
+      data = teal_data(),
+      modules = modules(example_module())
+    ),
+    expr = {
+      testthat::expect_error(raw_data_checked(), "Data has no datanames")
+    }
+  )
+})
+
 testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data_module returns error", {
   shiny::testServer(
     app = srv_teal_with_splash,
@@ -106,7 +120,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data
     ),
     expr = {
       testthat::expect_is(raw_data_checked, "reactive")
-      testthat::expect_error(raw_data_checked(), "didn't return `teal_data`")
+      testthat::expect_error(raw_data_checked(), "did not return `teal_data`")
     }
   )
 })
@@ -158,7 +172,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when incompati
       testthat::expect_is(raw_data_checked, "reactive")
       testthat::expect_error(
         raw_data_checked(),
-        "Module 'example teal module' uses different datanames than available in the 'data'"
+        "Module 'example teal module' uses datanames not available in the 'data'"
       )
     }
   )