diff --git a/R/dummy_functions.R b/R/dummy_functions.R index 7e6765dfbc..d4071c6fbc 100644 --- a/R/dummy_functions.R +++ b/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(), { diff --git a/R/init.R b/R/init.R index 805bf1ee2e..b4547ddc6b 100644 --- a/R/init.R +++ b/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 diff --git a/R/module_data_summary.R b/R/module_data_summary.R index 271bf346a0..07e756bc42 100644 --- a/R/module_data_summary.R +++ b/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, diff --git a/R/module_init_data.R b/R/module_init_data.R index 7990a2bb0a..a96df548ed 100644 --- a/R/module_init_data.R +++ b/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( diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 7bc3a72fbf..df1037a457 100644 --- a/R/module_nested_tabs.R +++ b/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)) ) } } diff --git a/R/module_teal_data.R b/R/module_teal_data.R index f1c6087575..93a9c0253b 100644 --- a/R/module_teal_data.R +++ b/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( diff --git a/R/teal_data_utils.R b/R/teal_data_utils.R index 2867d0a763..b5c49d896e 100644 --- a/R/teal_data_utils.R +++ b/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) -} diff --git a/R/utils.R b/R/utils.R index 0813740b0c..2750e42707 100644 --- a/R/utils.R +++ b/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 diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R index b1162c9924..c00d597a9b 100644 --- a/tests/testthat/test-module_teal.R +++ b/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",