datanames slot in teal_transform (enhanced teal.data::datanames())

R/dummy_functions.R

@@ -21,7 +21,7 @@ example_module <- function(label = "example teal module", datanames = "all", tra
       checkmate::assert_class(isolate(data()), "teal_data")
       moduleServer(id, function(input, output, session) {
         datanames_rv <- reactive({
-          .teal_data_ls(req(data()))
+          teal.data::datanames(req(data()))
         })
 
         observeEvent(datanames_rv(), {

R/init.R

@@ -210,16 +210,16 @@ init <- function(data,
 
   ## `data` - `modules`
   if (inherits(data, "teal_data")) {
-    if (length(.teal_data_ls(data)) == 0) {
+    if (length(teal.data::datanames(data)) == 0) {
       stop("The environment of `data` is empty.")
     }
 
-    is_modules_ok <- check_modules_datanames(modules, .teal_data_ls(data))
+    is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data))
     if (!isTRUE(is_modules_ok) && length(unlist(extract_transformers(modules))) == 0) {
       lapply(is_modules_ok$string, warning, call. = FALSE)
     }
 
-    is_filter_ok <- check_filter_datanames(filter, .teal_data_ls(data))
+    is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data))
     if (!isTRUE(is_filter_ok)) {
       warning(is_filter_ok)
       # we allow app to continue if applied filters are outside

R/module_data_summary.R

@@ -63,7 +63,7 @@ srv_data_summary <- function(id, teal_data) {
       summary_table <- reactive({
         req(inherits(teal_data(), "teal_data"))
 
-        if (!length(.teal_data_ls(teal_data()))) {
+        if (!length(teal.data::datanames(teal_data()))) {
           return(NULL)
         }
 
@@ -139,7 +139,7 @@ srv_data_summary <- function(id, teal_data) {
 
 #' @rdname module_data_summary
 get_filter_overview <- function(teal_data) {
-  datanames <- .teal_data_ls(teal_data())
+  datanames <- teal.data::datanames(teal_data())
   joinkeys <- teal.data::join_keys(teal_data())
   filtered_data_objs <- sapply(
     datanames,

R/module_init_data.R

@@ -107,7 +107,7 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
         )
       }
 
-      is_filter_ok <- check_filter_datanames(filter, .teal_data_ls(data_validated()))
+      is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data_validated()))
       if (!isTRUE(is_filter_ok)) {
         showNotification(
           "Some filters were not applied because of incompatibility with data. Contact app developer.",
@@ -144,7 +144,6 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
 #' @keywords internal
 .add_signature_to_data <- function(data) {
   hashes <- .get_hashes_code(data)
-
   tdata <- do.call(
     teal.data::teal_data,
     c(
@@ -158,22 +157,22 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
       )
     )
   )
-
   tdata@verified <- data@verified
+  tdata@datanames <- data@datanames
   tdata
 }
 
 #' Get code that tests the integrity of the reproducible data
 #'
 #' @param data (`teal_data`) object holding the data
-#' @param datanames (`character`) names of `datasets`
 #'
 #' @return A character vector with the code lines.
 #' @keywords internal
 #'
-.get_hashes_code <- function(data, datanames = .teal_data_ls(data)) {
+.get_hashes_code <- function(data) {
+  checkmate::assert_class(data, "teal_data")
   vapply(
-    datanames,
+    teal.data::datanames(data),
     function(dataname, datasets) {
       hash <- rlang::hash(data[[dataname]])
       sprintf(

R/module_nested_tabs.R

@@ -299,13 +299,13 @@ srv_teal_module.teal_module <- function(id,
 }
 
 .resolve_module_datanames <- function(data, modules) {
-  stopifnot("data_rv must be teal_data object." = inherits(data, "teal_data"))
+  checkmate::assert_class(data, "teal_data")
   if (is.null(modules$datanames) || identical(modules$datanames, "all")) {
-    .teal_data_ls(data)
+    grep("._raw_", teal.data::datanames(data), invert = TRUE, value = TRUE)
   } else {
     intersect(
-      include_parent_datanames(modules$datanames, teal.data::join_keys(data)),
-      .teal_data_ls(data)
+      teal.data::datanames(data),
+      include_parent_datanames(modules$datanames, teal.data::join_keys(data))
     )
   }
 }

R/module_teal_data.R

@@ -161,7 +161,7 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length
 
     output$shiny_warnings <- renderUI({
       if (inherits(data_out_r(), "teal_data")) {
-        is_modules_ok <- check_modules_datanames(modules = modules, datanames = .teal_data_ls(data_validated()))
+        is_modules_ok <- check_modules_datanames(modules = modules, datanames = teal.data::datanames(data_validated()))
         if (!isTRUE(is_modules_ok)) {
           tags$div(
             is_modules_ok$html(

R/teal_data_utils.R

@@ -68,9 +68,3 @@ NULL
   teal.data::datanames(new_data) <- datanames
   new_data
 }
-
-#' @rdname teal_data_utilities
-.teal_data_ls <- function(data) {
-  checkmate::assert_class(data, "teal_data")
-  grep("._raw_", ls(teal.code::get_env(data), all.names = TRUE), value = TRUE, invert = TRUE)
-}

R/utils.R

@@ -65,7 +65,7 @@ include_parent_datanames <- function(dataname, join_keys) {
 #' @param datanames (`character`) vector of data set names to include; must be subset of `datanames(x)`
 #' @return A `FilteredData` object.
 #' @keywords internal
-teal_data_to_filtered_data <- function(x, datanames = .teal_data_ls(x)) {
+teal_data_to_filtered_data <- function(x, datanames = teal.data::datanames(x)) {
   checkmate::assert_class(x, "teal_data")
   checkmate::assert_character(datanames, min.chars = 1L, any.missing = FALSE)
   # Otherwise, FilteredData will be created in the modules' scope later

tests/testthat/test-module_teal.R

@@ -541,7 +541,7 @@ testthat::describe("srv_teal teal_modules", {
         session$setInputs(`teal_modules-active_tab` = "module_1")
         testthat::expect_identical(
           teal.data::datanames(modules_output$module_1()()),
-          c("iris", "iris_raw", "mtcars", "swiss")
+          c("iris", "mtcars", "swiss", "iris_raw")
         )
       }
     )
@@ -651,7 +651,16 @@ testthat::describe("srv_teal teal_modules", {
       app = srv_teal,
       args = list(
         id = "test",
-        data = reactive(teal_data(iris = iris, mtcars = mtcars, not_included = data.frame())),
+        data = reactive(
+          within(
+            teal_data(),
+            {
+              iris <- iris
+              mtcars <- mtcars
+              not_included <- data.frame()
+            }
+          )
+        ),
         modules = modules(
           module(
             label = "module_1",
@@ -679,7 +688,7 @@ testthat::describe("srv_teal teal_modules", {
     )
   })
 
-  testthat::it("does not receive transform datasets not specified in transform$datanames nor modue$datanames", {
+  testthat::it("does not receive transform datasets not specified in transform$datanames nor module$datanames", {
     shiny::testServer(
       app = srv_teal,
       args = list(
@@ -717,6 +726,89 @@ testthat::describe("srv_teal teal_modules", {
     )
   })
 
+  testthat::it("does not receive transform datasets when module$datanames = 'all' and @datanames specified", {
+    shiny::testServer(
+      app = srv_teal,
+      args = list(
+        id = "test",
+        data = reactive({
+          td <- within(teal_data(), {
+            iris <- iris
+            mtcars <- mtcars
+          })
+          teal.data::datanames(td) <- c("iris", "mtcars")
+          td
+        }),
+        modules = modules(
+          module(
+            label = "module_1",
+            server = function(id, data) data,
+            transformers = list(
+              teal_transform_module(
+                label = "Dummy",
+                server = function(id, data) {
+                  moduleServer(id, function(input, output, session) {
+                    reactive(within(data(), swiss <- swiss))
+                  })
+                }
+              )
+            ),
+            datanames = "all"
+          )
+        )
+      ),
+      expr = {
+        session$setInputs(`teal_modules-active_tab` = "module_1")
+        testthat::expect_identical(teal.data::datanames(modules_output$module_1()()), c("iris", "mtcars"))
+      }
+    )
+  })
+
+  testthat::it(
+    "receive transform datasets when module$datanames = 'all' only when @datanames re-specified in transform",
+    {
+      shiny::testServer(
+        app = srv_teal,
+        args = list(
+          id = "test",
+          data = reactive({
+            td <- within(teal_data(), {
+              iris <- iris
+              mtcars <- mtcars
+            })
+            teal.data::datanames(td) <- c("iris", "mtcars")
+            td
+          }),
+          modules = modules(
+            module(
+              label = "module_1",
+              server = function(id, data) data,
+              transformers = list(
+                teal_transform_module(
+                  label = "Dummy",
+                  server = function(id, data) {
+                    moduleServer(id, function(input, output, session) {
+                      reactive({
+                        data_obj <- within(data(), swiss <- swiss)
+                        teal.data::datanames(data_obj) <- c(teal.data::datanames(data_obj), "swiss")
+                        data_obj
+                      })
+                    })
+                  }
+                )
+              ),
+              datanames = "all"
+            )
+          )
+        ),
+        expr = {
+          session$setInputs(`teal_modules-active_tab` = "module_1")
+          testthat::expect_identical(teal.data::datanames(modules_output$module_1()()), c("iris", "mtcars", "swiss"))
+        }
+      )
+    }
+  )
+
   testthat::it("srv_teal_module.teal_module does not pass data if not in the args explicitly", {
     shiny::testServer(
       app = srv_teal,
@@ -1883,7 +1975,10 @@ testthat::describe("srv_teal summary table", {
       app = srv_teal,
       args = list(
         id = "test",
-        data = teal.data::teal_data(iris = iris),
+        data = within(
+          teal.data::teal_data(),
+          iris <- iris
+        ),
         modules = modules(
           module(
             "module_1",