wrapper for get_code.tdata (#739)

NAMESPACE

@@ -25,6 +25,7 @@ export(.log)
 export(bookmarkableShinyApp)
 export(default_filter)
 export(example_module)
+export(get_code_tdata)
 export(get_join_keys)
 export(get_metadata)
 export(get_rcode)

NEWS.md

@@ -14,7 +14,7 @@
 * Updated `teal_module` to have `data` argument which receives a list of reactive filter data with `"code"` and `"join_keys"` attributes.
 * Updated `teal_module` to have `filter_panel_api` argument which receives a `FilterPanelAPI` object.
 * Updated the internals of `module_teal` to reflect changes in `teal.slice`.
-* Updated vignettes and README content.
+
 
 ### Breaking changes
 

R/tdata.R

@@ -55,7 +55,7 @@ new_tdata <- function(data, code = "", join_keys = NULL, metadata = NULL) {
     isolate(checkmate::assert_class(code(), "character", .var.name = "code"))
   }
 
-  #create reactive data.frames
+  # create reactive data.frames
   for (x in names(data)) {
     if (!is.reactive(data[[x]])) {
       data[[x]] <- do.call(reactive, list(as.name(x)), envir = list2env(data[x]))
@@ -106,6 +106,19 @@ get_code.tdata <- function(x, ...) {
 }
 
 
+#' Wrapper for `get_code.tdata`
+#' This wrapper is to be used by downstream packages to extract the code of a `tdata` object
+#'
+#' @param data (`tdata`) object
+#'
+#' @return (`character`) code used in the `tdata` object.
+#' @export
+get_code_tdata <- function(data) {
+  checkmate::assert_class(data, "tdata")
+  get_code(data)
+}
+
+
 #' Function to get join keys from a `tdata` object
 #' @param data `tdata` - object to extract the join keys
 #' @return Either `JoinKeys` object or `NULL` if no join keys
@@ -114,6 +127,7 @@ get_join_keys <- function(data) {
   UseMethod("get_join_keys", data)
 }
 
+
 #' @rdname get_join_keys
 #' @export
 get_join_keys.tdata <- function(data) {

tests/testthat/test-tdata.R

@@ -159,6 +159,29 @@ testthat::test_that("get_code returns character of code if tdata object has code
   testthat::expect_equal(isolate(get_code(my_tdata)), code_string)
 })
 
+# ---- get_code wrapper ----
+
+testthat::test_that("get_code_tdata accepts tdata", {
+  data <- new_tdata(data = list(iris = iris), code = "iris <- iris")
+  testthat::expect_error(isolate(get_code_tdata(data)), NA)
+})
+
+testthat::test_that("get_code_tdata throws error when input is not tdata", {
+  testthat::expect_error(
+    isolate(get_code_tdata(iris)),
+    "Assertion on 'data' failed: Must inherit from class 'tdata', but has class 'data.frame'."
+  )
+
+  testthat::expect_error(
+    isolate(get_code_tdata("iris")),
+    "Assertion on 'data' failed: Must inherit from class 'tdata', but has class 'character'."
+  )
+})
+
+testthat::test_that("get_code_tdata returns character code", {
+  data <- new_tdata(data = list(iris = iris), code = "iris <- iris")
+  testthat::expect_identical(isolate(get_code_tdata(data)), "iris <- iris")
+})
 
 # ---- tdata2env ----
 testthat::test_that("tdata2env returns environment containing tdata contents ", {