Adjust teal after introduction of [.qenv in teal.code and after changes of @code, @warnings, @messages and @id slots

R/module_nested_tabs.R

@@ -294,7 +294,7 @@ srv_teal_module.teal_module <- function(id,
         req(inherits(transformed_teal_data(), "teal_data"))
         all_teal_data <- transformed_teal_data()
         module_datanames <- .resolve_module_datanames(data = all_teal_data, modules = modules)
-        .subset_teal_data(all_teal_data, module_datanames)
+        all_teal_data[c(module_datanames, ".raw_data")]
       })
 
       srv_validate_reactive_teal_data(

R/teal_data_utils.R

@@ -11,7 +11,6 @@
 #' @param data (`teal_data`)
 #' @param code (`character`) code to append to the object's code slot.
 #' @param objects (`list`) objects to append to object's environment.
-#' @param datanames (`character`) names of the datasets
 #' @return modified `teal_data`
 #' @keywords internal
 #' @name teal_data_utilities
@@ -20,10 +19,7 @@ NULL
 #' @rdname teal_data_utilities
 .append_evaluated_code <- function(data, code) {
   checkmate::assert_class(data, "teal_data")
-  data@code <- c(data@code, code)
-  data@id <- c(data@id, max(data@id) + 1L + seq_along(code))
-  data@messages <- c(data@messages, rep("", length(code)))
-  data@warnings <- c(data@warnings, rep("", length(code)))
+  data@code <- c(data@code, code2list(code))
   methods::validObject(data)
   data
 }
@@ -37,27 +33,3 @@ NULL
   [email protected] <- new_env
   data
 }
-
-#' @rdname teal_data_utilities
-.subset_teal_data <- function(data, datanames) {
-  checkmate::assert_class(data, "teal_data")
-  checkmate::assert_class(datanames, "character")
-  datanames_corrected <- intersect(datanames, names(data))
-  datanames_corrected_with_raw <- c(datanames_corrected, ".raw_data")
-  if (!length(datanames_corrected)) {
-    return(teal_data())
-  }
-
-  new_data <- do.call(
-    teal.data::teal_data,
-    args = c(
-      mget(x = datanames_corrected_with_raw, envir = as.environment(data)),
-      list(
-        code = teal.code::get_code(data, names = datanames_corrected_with_raw),
-        join_keys = teal.data::join_keys(data)[datanames_corrected]
-      )
-    )
-  )
-  new_data@verified <- data@verified
-  new_data
-}

R/zzz.R

@@ -37,3 +37,4 @@ RcodeBlock <- getFromNamespace("RcodeBlock", "teal.reporter") # nolint: object_n
 # Use non-exported function(s) from teal.code
 # This one is here because lang2calls should not be exported from teal.code
 lang2calls <- getFromNamespace("lang2calls", "teal.code")
+code2list <- getFromNamespace("code2list", "teal.data")

tests/testthat/test-module_teal.R

@@ -1413,10 +1413,10 @@ testthat::describe("srv_teal filters", {
             c(
               "iris <- iris",
               "mtcars <- mtcars",
-              sprintf('stopifnot(rlang::hash(iris) == "%s")', rlang::hash(iris)),
-              sprintf('stopifnot(rlang::hash(mtcars) == "%s")', rlang::hash(mtcars)),
+              sprintf('stopifnot(rlang::hash(iris) == "%s") # @linksto iris', rlang::hash(iris)),
+              sprintf('stopifnot(rlang::hash(mtcars) == "%s") # @linksto mtcars', rlang::hash(mtcars)),
               ".raw_data <- list2env(list(iris = iris, mtcars = mtcars))",
-              "lockEnvironment(.raw_data)",
+              "lockEnvironment(.raw_data) # @linksto .raw_data",
               "mtcars <- dplyr::filter(mtcars, cyl == 4)"
             ),
             collapse = "\n"
@@ -1591,10 +1591,10 @@ testthat::describe("srv_teal teal_module(s) transformer", {
         expected_code <- paste(collapse = "\n", c(
           "iris <- iris",
           "mtcars <- mtcars",
-          sprintf('stopifnot(rlang::hash(iris) == "%s")', rlang::hash(iris)),
-          sprintf('stopifnot(rlang::hash(mtcars) == "%s")', rlang::hash(mtcars)),
+          sprintf('stopifnot(rlang::hash(iris) == "%s") # @linksto iris', rlang::hash(iris)),
+          sprintf('stopifnot(rlang::hash(mtcars) == "%s") # @linksto mtcars', rlang::hash(mtcars)),
           ".raw_data <- list2env(list(iris = iris, mtcars = mtcars))",
-          "lockEnvironment(.raw_data)",
+          "lockEnvironment(.raw_data) # @linksto .raw_data",
           'iris <- dplyr::filter(iris, Species == "versicolor")',
           "mtcars <- dplyr::filter(mtcars, cyl == 6)",
           "iris <- head(iris, n = 6)",
@@ -1637,10 +1637,10 @@ testthat::describe("srv_teal teal_module(s) transformer", {
         expected_code <- paste(collapse = "\n", c(
           "iris <- iris",
           "mtcars <- mtcars",
-          sprintf('stopifnot(rlang::hash(iris) == "%s")', rlang::hash(iris)),
-          sprintf('stopifnot(rlang::hash(mtcars) == "%s")', rlang::hash(mtcars)),
+          sprintf('stopifnot(rlang::hash(iris) == "%s") # @linksto iris', rlang::hash(iris)),
+          sprintf('stopifnot(rlang::hash(mtcars) == "%s") # @linksto mtcars', rlang::hash(mtcars)),
           ".raw_data <- list2env(list(iris = iris, mtcars = mtcars))",
-          "lockEnvironment(.raw_data)",
+          "lockEnvironment(.raw_data) # @linksto .raw_data",
           "mtcars <- dplyr::filter(mtcars, cyl == 4)",
           "iris <- head(iris, n = 6)",
           "mtcars <- head(mtcars, n = 6)"
@@ -2445,7 +2445,7 @@ testthat::describe("Datanames with special symbols", {
           }
         ),
         modules = modules(
-          module("module_1", server = function(id, data) data, , datanames = c("iris"))
+          module("module_1", server = function(id, data) data, datanames = c("iris"))
         ),
         filter = teal_slices(
           module_specific = TRUE
@@ -2483,7 +2483,7 @@ testthat::describe("teal.data code with a function defined", {
           }
         })),
         modules = modules(module("module_1", server = function(id, data) data))
-      ), ,
+      ),
       expr = {
         session$setInputs("teal_modules-active_tab" = "module_1")
         session$flushReact()
@@ -2545,9 +2545,9 @@ testthat::describe("teal.data code with a function defined", {
             "y <- x + 1",
             "y + 3",
             "}",
-            sprintf("stopifnot(rlang::hash(deparse1(fun)) == \"%s\")", local_env$hash),
+            sprintf("stopifnot(rlang::hash(deparse1(fun)) == \"%s\") # @linksto fun", local_env$hash),
             ".raw_data <- list2env(list(fun = fun))",
-            "lockEnvironment(.raw_data)"
+            "lockEnvironment(.raw_data) # @linksto .raw_data"
           )
         )
       }

tests/testthat/test-shinytest2-show-rcode.R

@@ -42,16 +42,15 @@ testthat::test_that("e2e: teal app initializes with Show R Code modal", {
   )
 
   # Check R code output.
-  testthat::expect_identical(
-    app$get_text(app$active_module_element("rcode-verbatim_content")),
-    paste(
+  testthat::expect_setequal(
+    strsplit(app$get_text(app$active_module_element("rcode-verbatim_content")), "\n")[[1]],
+    c(
       "iris <- iris",
       "mtcars <- mtcars",
-      sprintf('stopifnot(rlang::hash(iris) == "%s")', rlang::hash(iris)),
-      sprintf('stopifnot(rlang::hash(mtcars) == "%s")', rlang::hash(mtcars)),
+      sprintf('stopifnot(rlang::hash(iris) == "%s") # @linksto iris', rlang::hash(iris)),
+      sprintf('stopifnot(rlang::hash(mtcars) == "%s") # @linksto mtcars', rlang::hash(mtcars)),
       ".raw_data <- list2env(list(iris = iris, mtcars = mtcars))",
-      "lockEnvironment(.raw_data)",
-      sep = "\n"
+      "lockEnvironment(.raw_data) # @linksto .raw_data"
     )
   )