999 set default datanames to ls(data@env)

R/init.R

@@ -183,19 +183,17 @@ 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.")
+    if (length(teal.data::datanames(data)) == 0 && length(ls(data@env)) == 0) {
+      stop("`data` object has no datanames and its environment is empty. 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))
+    is_modules_ok <- check_modules_datanames(modules, teal_data_datanames(data))
     if (!isTRUE(is_modules_ok)) {
       logger::log_error(is_modules_ok)
-      checkmate::assert(is_modules_ok, .var.name = "modules")
+      # we allow app to continue if datanames are not available.
     }
 
-
-    is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data))
+    is_filter_ok <- check_filter_datanames(filter, teal_data_datanames(data))
     if (!isTRUE(is_filter_ok)) {
       logger::log_warn(is_filter_ok)
       # we allow app to continue if applied filters are outside

R/module_teal.R

@@ -189,7 +189,7 @@ srv_teal <- function(id, modules, teal_data_rv, filter = teal_slices()) {
           # null controls a display of filter panel but data should be still passed
           datanames <- if (is.null(modules$datanames) || modules$datanames == "all") {
             include_parent_datanames(
-              teal.data::datanames(teal_data_rv()),
+              teal_data_datanames(teal_data_rv()),
               teal_data_rv()@join_keys
             )
           } else {

R/module_teal_with_splash.R

@@ -126,13 +126,16 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
         )
       )
 
-      validate(need(teal.data::datanames(data), "Data has no datanames. Contact app developer."))
-
+      if (!length(teal.data::datanames(data))) {
+        warning("`data` object has no datanames. Default datanames are set using `teal_data`'s environment.")
+      }
 
-      is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data))
-      validate(need(isTRUE(is_modules_ok), is_modules_ok))
+      is_modules_ok <- check_modules_datanames(modules, teal_data_datanames(data))
+      if (!isTRUE(is_modules_ok)) {
+        logger::log_warn(is_modules_ok)
+      }
 
-      is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data))
+      is_filter_ok <- check_filter_datanames(filter, teal_data_datanames(data))
       if (!isTRUE(is_filter_ok)) {
         showNotification(
           "Some filters were not applied because of incompatibility with data. Contact app developer.",

R/tdata.R

@@ -72,13 +72,6 @@ new_tdata <- function(data, code = "", join_keys = NULL, metadata = NULL) {
   for (x in names(data)) {
     if (!is.reactive(data[[x]])) {
       data[[x]] <- do.call(reactive, list(as.name(x)), envir = list2env(data[x]))
-    } else {
-      isolate(
-        checkmate::assert_multi_class(
-          data[[x]](), c("data.frame", "MultiAssayExperiment"),
-          .var.name = "data"
-        )
-      )
     }
   }
 
@@ -191,12 +184,12 @@ as_tdata <- function(x) {
   }
   if (is.reactive(x)) {
     checkmate::assert_class(isolate(x()), "teal_data")
-    datanames <- isolate(teal.data::datanames(x()))
+    datanames <- isolate(teal_data_datanames(x()))
     datasets <- sapply(datanames, function(dataname) reactive(x()[[dataname]]), simplify = FALSE)
     code <- reactive(teal.code::get_code(x()))
     join_keys <- isolate(teal.data::join_keys(x()))
   } else if (inherits(x, "teal_data")) {
-    datanames <- teal.data::datanames(x)
+    datanames <- teal_data_datanames(x)
     datasets <- sapply(datanames, function(dataname) reactive(x[[dataname]]), simplify = FALSE)
     code <- reactive(teal.code::get_code(x))
     join_keys <- isolate(teal.data::join_keys(x))

R/utils.R

@@ -56,10 +56,9 @@ include_parent_datanames <- function(dataname, join_keys) {
 #' @param datanames (`character`) vector of data set names to include; must be subset of `datanames(x)`
 #' @return (`FilteredData`) object
 #' @keywords internal
-teal_data_to_filtered_data <- function(x, datanames = teal.data::datanames(x)) {
+teal_data_to_filtered_data <- function(x, datanames = teal_data_datanames(x)) {
   checkmate::assert_class(x, "teal_data")
-  checkmate::assert_character(datanames, min.len = 1L, any.missing = FALSE)
-  checkmate::assert_subset(datanames, teal.data::datanames(x))
+  checkmate::assert_character(datanames, min.chars = 1L, any.missing = FALSE)
 
   ans <- teal.slice::init_filtered_data(
     x = sapply(datanames, function(dn) x[[dn]], simplify = FALSE),
@@ -215,3 +214,19 @@ check_filter_datanames <- function(filters, datanames) {
     TRUE
   }
 }
+
+#' Wrapper on `teal.data::datanames`
+#'
+#' Special function used in internals of `teal` to return names of datasets even if `datanames`
+#' has not been set.
+#' @param data (`teal_data`)
+#' @return `character`
+# @keywords internal
+teal_data_datanames <- function(data) {
+  checkmate::assert_class(data, "teal_data")
+  if (length(teal.data::datanames(data))) {
+    teal.data::datanames(data)
+  } else {
+    ls(data@env)
+  }
+}

tests/testthat/test-init.R

@@ -84,18 +84,18 @@ testthat::test_that("init filter accepts `teal_slices`", {
 testthat::test_that("init throws when data has no datanames", {
   testthat::expect_error(
     init(data = teal_data(), modules = list(example_module())),
-    "has no datanames"
+    "`data` object has no datanames and its environment is empty"
   )
 })
 
 testthat::test_that("init throws when incompatible module's datanames", {
   msg <- "Module 'example teal module' uses datanames not available in 'data'"
   testthat::expect_output(
-    testthat::expect_error(
-      init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))),
-      msg
+    init(
+      data = teal_data(mtcars = mtcars),
+      modules = list(example_module(datanames = "iris"))
     ),
-    msg
+    "Module 'example teal module' uses datanames not available in 'data'"
   )
 })
 

tests/testthat/test-module_teal_with_splash.R

@@ -57,17 +57,21 @@ testthat::test_that("srv_teal_with_splash passes teal_data to reactive", {
   )
 })
 
-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())
+testthat::test_that("srv_teal_with_splash passes when datanames are empty with warning", {
+  testthat::expect_warning(
+    shiny::testServer(
+      app = srv_teal_with_splash,
+      args = list(
+        id = "test",
+        data = teal_data(),
+        modules = modules(example_module())
+      ),
+      expr = {
+        testthat::expect_is(teal_data_rv_validate, "reactive")
+        testthat::expect_s4_class(teal_data_rv_validate(), "teal_data")
+      }
     ),
-    expr = {
-      testthat::expect_error(teal_data_rv_validate(), "Data has no datanames")
-    }
+    "`data` object has no datanames. Default datanames are set using `teal_data`'s environment."
   )
 })
 
@@ -128,7 +132,7 @@ testthat::test_that(
   }
 )
 
-testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws when incompatible module's datanames", {
+testthat::test_that("srv_teal_with_splash teal_data_rv_validate passes with  when incompatible module's datanames", {
   shiny::testServer(
     app = srv_teal_with_splash,
     args = list(
@@ -138,7 +142,7 @@ testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws when inco
     ),
     expr = {
       testthat::expect_is(teal_data_rv_validate, "reactive")
-      testthat::expect_error(
+      testthat::expect_output(
         teal_data_rv_validate(),
         "Module 'example teal module' uses datanames not available in 'data'"
       )
@@ -157,6 +161,10 @@ testthat::test_that("srv_teal_with_splash teal_data_rv_validate returns teal_dat
     ),
     expr = {
       testthat::expect_is(teal_data_rv_validate, "reactive")
+      testthat::expect_output(
+        teal_data_rv_validate(),
+        "Filter 'iris Species' refers to dataname not available in 'data'"
+      )
       testthat::expect_s4_class(teal_data_rv_validate(), "teal_data")
     }
   )

tests/testthat/test-tdata.R

@@ -35,11 +35,6 @@ testthat::test_that("new_tdata throws error if contents of data list are not of
   testthat::expect_error(
     new_tdata(list(x = 1)), "May only contain the following types: \\{data.frame,reactive,MultiAssayExperiment\\}"
   )
-
-  testthat::expect_error(
-    new_tdata(list(x = reactive(1))),
-    "Must inherit from class 'data.frame'/'MultiAssayExperiment'"
-  )
 })
 
 testthat::test_that("new_tdata throws error if code is not character or reactive character", {

tests/testthat/test-utils.R

@@ -36,3 +36,23 @@ testthat::test_that("report_card_template function returns TealReportCard object
   testthat::expect_equal(card$get_name(), "Card title")
   testthat::expect_length(card$get_content(), 1)
 })
+
+test_that("teal_data_to_filtered_data return FilteredData class", {
+  teal_data <- teal.data::teal_data()
+  teal_data <- within(teal_data, iris <- head(iris))
+  datanames(teal_data) <- "iris"
+
+  testthat::expect_s3_class(teal_data_to_filtered_data(teal_data), "FilteredData")
+})
+
+test_that("teal_data_datanames return datanames", {
+  teal_data <- teal.data::teal_data()
+  teal_data <- within(teal_data, {
+    iris <- head(iris)
+    mtcars <- head(mtcars)
+  })
+  testthat::expect_equal(teal_data_datanames(teal_data), c("iris", "mtcars"))
+
+  datanames(teal_data) <- "iris"
+  testthat::expect_equal(teal_data_datanames(teal_data), "iris")
+})