471 remove CodeClass from FilteredData (#964)

Preprocessing code is no longer kept in `FilteredData$code` but attached
to a `FilteredData` as an attribute.
Necessary adjustments were made in `teal_data_to_filtered_data` and in
`get_datasets_code`.

[companion](insightsengineering/teal.slice#488)

---------

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>

DESCRIPTION

@@ -31,7 +31,7 @@ BugReports: https://github.com/insightsengineering/teal/issues
 Depends:
     R (>= 4.0),
     shiny (>= 1.7.0),
-    teal.data (>= 0.3.0.9010),
+    teal.data (>= 0.3.0.9011),
     teal.slice (>= 0.4.0.9023),
     teal.transform (>= 0.4.0.9007)
 Imports:

NEWS.md

@@ -10,6 +10,7 @@
 
 * Enhanced a `module` validation checks so that it won't throw messages about `data` argument unnecessarily.
 * Added argument to `teal_slices` and made modifications to `init` to enable tagging `teal_slices` with an app id to safely upload snapshots from disk.
+* `FilteredData` no longer stores pre-processing code in specific slots. Code is now attached as attribute. Adjusted appropriately.
 
 ### Bug fixes
 

R/get_rcode_utils.R

@@ -38,28 +38,18 @@ get_rcode_str_install <- function() {
 #' @param datasets (`FilteredData`) object
 #' @param hashes named (`list`) of hashes per dataset
 #'
-#' @return `character(3)` containing following elements:
-#'  - code from `CodeClass` (data loading code)
+#' @return `character(3)` containing the following elements:
+#'  - data pre-processing code (from `data` argument in `init`)
 #'  - hash check of loaded objects
+#'  - filter code
 #'
 #' @keywords internal
 get_datasets_code <- function(datanames, datasets, hashes) {
-  str_code <- datasets$get_code(datanames)
-  if (length(str_code) == 0 || (length(str_code) == 1 && str_code == "")) {
-    str_code <- "message('Preprocessing is empty')"
-  } else if (length(str_code) > 0) {
-    str_code <- paste0(str_code, "\n\n")
-  }
-
-  if (!datasets$get_check()) {
-    check_note_string <- paste0(
-      c(
-        "message(paste(\"Reproducibility of data import and preprocessing was not explicitly checked\",",
-        "   \" ('check = FALSE' is set). Contact app developer if this is an issue.\n\"))"
-      ),
-      collapse = "\n"
-    )
-    str_code <- paste0(str_code, "\n\n", check_note_string)
+  str_prepro <- teal.data:::get_code_dependency(attr(datasets, "preprocessing_code"), names = datanames)
+  if (length(str_prepro) == 0) {
+    str_prepro <- "message('Preprocessing is empty')"
+  } else if (length(str_prepro) > 0) {
+    str_prepro <- paste0(str_prepro, "\n\n")
   }
 
   str_hash <- paste(
@@ -80,5 +70,7 @@ get_datasets_code <- function(datanames, datasets, hashes) {
     "\n\n"
   )
 
-  c(str_code, str_hash)
+  str_filter <- teal.slice::get_filter_expr(datasets, datanames)
+
+  c(str_prepro, str_hash, str_filter)
 }

R/init.R

@@ -10,10 +10,6 @@
 #' End-users: This is the most important function for you to start a
 #' teal app that is composed out of teal modules.
 #'
-#' **Notes for developers**:
-#' This is a wrapper function around the `module_teal.R` functions. Unless you are
-#' an end-user, don't use this function, but instead this module.
-#'
 #' @param data (`TealData` or `TealDataset` or `TealDatasetConnector` or `list` or `data.frame`
 #' or `MultiAssayExperiment`, `teal_data`, `teal_data_module`)\cr
 #' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()],

R/module_nested_tabs.R

@@ -311,8 +311,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
   )
 
   hashes <- calculate_hashes(datanames, datasets)
-  metadata <- lapply(datanames, datasets$get_metadata)
-  names(metadata) <- datanames
+  metadata <- sapply(datanames, datasets$get_metadata, simplify = FALSE)
 
   new_tdata(
     data,
@@ -322,8 +321,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
         c(
           get_rcode_str_install(),
           get_rcode_libraries(),
-          get_datasets_code(datanames, datasets, hashes),
-          teal.slice::get_filter_expr(datasets, datanames)
+          get_datasets_code(datanames, datasets, hashes)
         )
       }
     ),

R/module_teal.R

@@ -173,6 +173,7 @@ srv_teal <- function(id, modules, teal_data_rv, filter = teal_slices()) {
       # create a list of data following structure of the nested modules list structure.
       # Because it's easier to unpack modules and datasets when they follow the same nested structure.
       datasets_singleton <- teal_data_to_filtered_data(teal_data_rv())
+
       # Singleton starts with only global filters active.
       filter_global <- Filter(function(x) x$id %in% attr(filter, "mapping")$global_filters, filter)
       datasets_singleton$set_filter_state(filter_global)

R/module_teal_with_splash.R

@@ -76,7 +76,11 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
     # teal_data_rv contains teal_data object
     # either passed to teal::init or returned from teal_data_module
     teal_data_rv <- if (inherits(data, "teal_data_module")) {
-      data$server(id = "teal_data_module")
+      data <- data$server(id = "teal_data_module")
+      if (!is.reactive(data)) {
+        stop("The `teal_data_module` must return a reactive expression.", call. = FALSE)
+      }
+      data
     } else if (inherits(data, "teal_data")) {
       reactiveVal(data)
     } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) {
@@ -109,10 +113,6 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
       raw_data
     }
 
-    if (!is.reactive(teal_data_rv)) {
-      stop("The `teal_data_module` must return a reactive expression.", call. = FALSE)
-    }
-
     teal_data_rv_validate <- reactive({
       # custom module can return error
       data <- tryCatch(teal_data_rv(), error = function(e) e)
@@ -141,7 +141,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
         validate(
           need(
             FALSE,
-            paste0(
+            paste(
               "Error when executing `teal_data_module`:\n ",
               paste(data$message, collpase = "\n"),
               "\n Check your inputs or contact app developer if error persists."

R/utils.R

@@ -53,21 +53,21 @@ include_parent_datanames <- function(dataname, join_keys) {
 #'
 #' Create a `FilteredData` object from a `teal_data` object
 #' @param x (`teal_data`) object
+#' @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)) {
   checkmate::assert_class(x, "teal_data")
-  checkmate::assert_character(datanames)
+  checkmate::assert_character(datanames, min.len = 1L, any.missing = FALSE)
+  checkmate::assert_subset(datanames, teal.data::datanames(x))
 
-  teal.slice::init_filtered_data(
-    x = as.list(x@env)[datanames],
-    join_keys = join_keys(x)[datanames],
-    code = teal.data:::CodeClass$new(
-      code = paste(teal.code::get_code(x), collapse = "\n"),
-      dataname = teal.data::get_dataname(x)
-    ),
-    check = FALSE
+  ans <- teal.slice::init_filtered_data(
+    x = sapply(datanames, function(dn) x[[dn]], simplify = FALSE),
+    join_keys = teal.data::join_keys(x)
   )
+  # Piggy-back entire pre-processing code so that filtering code can be appended later.
+  attr(ans, "preprocessing_code") <- teal.code::get_code(x)
+  ans
 }
 
 #' Template Function for `TealReportCard` Creation and Customization

tests/testthat/test-module_nested_tabs.R

@@ -1,6 +1,8 @@
-filtered_data <- teal.slice::init_filtered_data(
-  list(iris = list(dataset = head(iris)))
-)
+teal_data <- teal.data::teal_data()
+teal_data <- within(teal_data, iris <- head(iris))
+teal_data <- teal.data::teal_data() |> within(iris <- head(iris))
+datanames(teal_data) <- "iris"
+filtered_data <- teal_data_to_filtered_data(teal_data)
 
 test_module1 <- module(
   label = "test1",
@@ -36,22 +38,12 @@ test_module_wdata <- function(datanames) {
 }
 
 get_example_filtered_data <- function() {
-  d1 <- data.frame(id = 1:5, pk = c(2, 3, 2, 1, 4), val = 1:5)
-  d2 <- data.frame(id = 1:5, value = 1:5)
-
-  cc <- teal.data:::CodeClass$new()
-  cc$set_code("d1 <- data.frame(id = 1:5, pk = c(2,3,2,1,4), val = 1:5)", "d1")
-  cc$set_code("d2 <- data.frame(id = 1:5, value = 1:5)", "d2")
-
-  teal.slice::init_filtered_data(
-    x = list(
-      d1 = list(dataset = d1, metadata = list("A" = 1)),
-      d2 = list(dataset = d2)
-    ),
-    join_keys = teal.data::join_keys(teal.data::join_key("d1", "d2", c("pk" = "id"))),
-    code = cc,
-    check = TRUE
-  )
+  td <- teal.data::teal_data()
+  td <- within(td, d1 <- data.frame(id = 1:5, pk = c(2, 3, 2, 1, 4), val = 1:5))
+  td <- within(td, d2 <- data.frame(id = 1:5, value = 1:5))
+  datanames(td) <- c("d1", "d2")
+  teal.data::join_keys(td) <- teal.data::join_keys(teal.data::join_key("d1", "d2", c("pk" = "id")))
+  teal_data_to_filtered_data(td)
 }
 
 
@@ -461,22 +453,15 @@ testthat::test_that(".datasets_to_data returns tdata object", {
     c(
       get_rcode_str_install(),
       get_rcode_libraries(),
-      "d1 <- data.frame(id = 1:5, pk = c(2, 3, 2, 1, 4), val = 1:5)\nd2 <- data.frame(id = 1:5, value = 1:5)\n\n",
+      "d1 <- data.frame(id = 1:5, pk = c(2, 3, 2, 1, 4), val = 1:5)\n\n",
+      "d2 <- data.frame(id = 1:5, value = 1:5)\n\n",
       paste0(
         "stopifnot(rlang::hash(d1) == \"f6f90d2c133ca4abdeb2f7a7d85b731e\")\n",
         "stopifnot(rlang::hash(d2) == \"6e30be195b7d914a1311672c3ebf4e4f\") \n\n"
       ),
       ""
     )
   )
-
-  # metadata
-  testthat::expect_equal(
-    get_metadata(data, "d1"),
-    list(A = 1)
-  )
-
-  testthat::expect_null(get_metadata(data, "d2"))
 })
 
 testthat::test_that("calculate_hashes takes a FilteredData and vector of datanames as input", {

tests/testthat/test-module_tabs_with_filters.R

@@ -1,9 +1,8 @@
-filtered_data <- teal.slice::init_filtered_data(
-  list(
-    iris = list(dataset = head(iris)),
-    mtcars = list(dataset = head(mtcars))
-  )
-)
+teal_data <- teal.data::teal_data()
+teal_data <- within(teal_data, iris <- head(iris))
+teal_data <- within(teal_data, mtcars <- head(mtcars))
+datanames(teal_data) <- c("iris", "mtcars")
+filtered_data <- teal_data_to_filtered_data(teal_data)
 
 test_module1 <- module(
   label = "iris tab",

tests/testthat/test-module_teal_with_splash.R

@@ -96,7 +96,7 @@ testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws then qenv
       id = "test",
       data = teal_data_module(
         ui = function(id) div(),
-        server = function(id) reactive(teal_data() |> within(stop("not good")))
+        server = function(id) reactive(teal_data() %>% within(stop("not good")))
       ),
       modules = modules(example_module())
     ),