From a2c59c05a94040436c585c21c9109e07d21e8c22 Mon Sep 17 00:00:00 2001
From: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com>
Date: Wed, 22 Nov 2023 14:03:11 +0100
Subject: [PATCH] 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](https://github.com/insightsengineering/teal.slice/pull/488)

---------

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
---
 DESCRIPTION                                   |  2 +-
 NEWS.md                                       |  1 +
 R/get_rcode_utils.R                           | 30 +++++---------
 R/init.R                                      |  4 --
 R/module_nested_tabs.R                        |  6 +--
 R/module_teal.R                               |  1 +
 R/module_teal_with_splash.R                   | 12 +++---
 R/utils.R                                     | 18 ++++----
 man/get_datasets_code.Rd                      |  5 ++-
 man/init.Rd                                   |  4 --
 man/teal_data_to_filtered_data.Rd             |  2 +
 tests/testthat/test-module_nested_tabs.R      | 41 ++++++-------------
 .../testthat/test-module_tabs_with_filters.R  | 11 +++--
 tests/testthat/test-module_teal_with_splash.R |  2 +-
 14 files changed, 55 insertions(+), 84 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 6bb860a50c..4735155cca 100644
--- a/DESCRIPTION
+++ b/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:
diff --git a/NEWS.md b/NEWS.md
index 8926433360..49123b59c7 100644
--- a/NEWS.md
+++ b/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
 
diff --git a/R/get_rcode_utils.R b/R/get_rcode_utils.R
index 610dbf01a5..e53bb9918a 100644
--- a/R/get_rcode_utils.R
+++ b/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)
 }
diff --git a/R/init.R b/R/init.R
index 8035815e7d..77e668019b 100644
--- a/R/init.R
+++ b/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()],
diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R
index 0a35f7aaf5..73e8e1b2a8 100644
--- a/R/module_nested_tabs.R
+++ b/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)
         )
       }
     ),
diff --git a/R/module_teal.R b/R/module_teal.R
index c1c4952271..cc4c08dcfe 100644
--- a/R/module_teal.R
+++ b/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)
diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R
index e8a5ae92be..8d4afc59ae 100644
--- a/R/module_teal_with_splash.R
+++ b/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."
diff --git a/R/utils.R b/R/utils.R
index 65647163fc..3a33619688 100644
--- a/R/utils.R
+++ b/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
diff --git a/man/get_datasets_code.Rd b/man/get_datasets_code.Rd
index ad0457094c..f7256b8340 100644
--- a/man/get_datasets_code.Rd
+++ b/man/get_datasets_code.Rd
@@ -14,10 +14,11 @@ get_datasets_code(datanames, datasets, hashes)
 \item{hashes}{named (\code{list}) of hashes per dataset}
 }
 \value{
-\code{character(3)} containing following elements:
+\code{character(3)} containing the following elements:
 \itemize{
-\item code from \code{CodeClass} (data loading code)
+\item data pre-processing code (from \code{data} argument in \code{init})
 \item hash check of loaded objects
+\item filter code
 }
 }
 \description{
diff --git a/man/init.Rd b/man/init.Rd
index f03437f1b3..0e7ef57199 100644
--- a/man/init.Rd
+++ b/man/init.Rd
@@ -61,10 +61,6 @@ named list with \code{server} and \code{ui} function
 \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}}
 End-users: This is the most important function for you to start a
 teal app that is composed out of teal modules.
-
-\strong{Notes for developers}:
-This is a wrapper function around the \code{module_teal.R} functions. Unless you are
-an end-user, don't use this function, but instead this module.
 }
 \examples{
 new_iris <- transform(iris, id = seq_len(nrow(iris)))
diff --git a/man/teal_data_to_filtered_data.Rd b/man/teal_data_to_filtered_data.Rd
index 440abd4504..2528930eb5 100644
--- a/man/teal_data_to_filtered_data.Rd
+++ b/man/teal_data_to_filtered_data.Rd
@@ -8,6 +8,8 @@ teal_data_to_filtered_data(x, datanames = teal.data::datanames(x))
 }
 \arguments{
 \item{x}{(\code{teal_data}) object}
+
+\item{datanames}{(\code{character}) vector of data set names to include; must be subset of \code{datanames(x)}}
 }
 \value{
 (\code{FilteredData}) object
diff --git a/tests/testthat/test-module_nested_tabs.R b/tests/testthat/test-module_nested_tabs.R
index 87b2b78ea4..db0890ceb7 100644
--- a/tests/testthat/test-module_nested_tabs.R
+++ b/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,7 +453,8 @@ 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"
@@ -469,14 +462,6 @@ testthat::test_that(".datasets_to_data returns tdata object", {
       ""
     )
   )
-
-  # 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", {
diff --git a/tests/testthat/test-module_tabs_with_filters.R b/tests/testthat/test-module_tabs_with_filters.R
index a82042cc81..1c9d1f8385 100644
--- a/tests/testthat/test-module_tabs_with_filters.R
+++ b/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",
diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R
index 577e997582..a68f047f02 100644
--- a/tests/testthat/test-module_teal_with_splash.R
+++ b/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())
     ),