Make JoinKeys related changes due to refactor

NAMESPACE

@@ -2,9 +2,9 @@
 
 S3method(c,teal_slices)
 S3method(get_code,tdata)
-S3method(get_join_keys,tdata)
 S3method(get_metadata,default)
 S3method(get_metadata,tdata)
+S3method(join_keys,tdata)
 S3method(print,teal_module)
 S3method(print,teal_modules)
 S3method(srv_nested_tabs,default)

R/init.R

@@ -145,7 +145,7 @@ init <- function(data,
 
   # Calculate app id that will be used to stamp filter state snapshots.
   # App id is a hash of the app's data and modules.
-  # See "transferring snapshots" section in ?snapshot.
+  # See "transferring snapshots" section in ?snapshot. Raw data must be extracted from environments.
   hashables <- mget(c("data", "modules"))
   hashables$data <- if (inherits(hashables$data, "teal_data")) {
     as.list(hashables$data@env)

R/module_nested_tabs.R

@@ -288,7 +288,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
 #' @param trigger_data (`reactiveVal`) to trigger getting the filtered data
 #' @return list of reactive datasets with following attributes:
 #' - `code` (`character`) containing datasets reproducible code.
-#' - `join_keys` (`JoinKeys`) containing relationships between datasets.
+#' - `join_keys` (`join_keys`) containing relationships between datasets.
 #' - `metadata` (`list`) containing metadata of datasets.
 #'
 #' @keywords internal

R/module_teal_with_splash.R

@@ -85,7 +85,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
         c(
           lapply(data$get_datasets(), function(x) x$get_raw_data()),
           code = data$get_code(),
-          join_keys = data$get_join_keys()
+          join_keys = teal.data::join_keys(data)
         )
       )
       reactiveVal(new_data) # will trigger by setting it
@@ -101,7 +101,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
             c(
               lapply(data$get_datasets(), function(x) x$get_raw_data()),
               code = data$get_code(),
-              join_keys = data$get_join_keys()
+              join_keys = teal.data::join_keys(data)
             )
           )
         }

R/tdata.R

@@ -4,7 +4,7 @@
 #' (or `MultiAssayExperiment`), with attributes:
 #' \itemize{
 #'   \item{`code` (`reactive`) containing code used to generate the data}
-#'   \item{join_keys (`JoinKeys`) containing the relationships between the data}
+#'   \item{join_keys (`join_keys`) containing the relationships between the data}
 #'   \item{metadata (`named list`) containing any metadata associated with the data frames}
 #' }
 #' @name tdata
@@ -15,7 +15,7 @@
 #'   the code used to generate the data. This should be `reactive` if the code is changing
 #'   during a reactive context (e.g. if filtering changes the code). Inside this
 #'   object `code` will be made reactive
-#' @param join_keys A `teal.data::JoinKeys` object containing relationships between the
+#' @param join_keys A `teal.data::join_keys` object containing relationships between the
 #'   datasets.
 #' @param metadata A `named list` each element contains a list of metadata about the named data.frame
 #' Each element of these list should be atomic and length one.
@@ -46,7 +46,7 @@ new_tdata <- function(data, code = "", join_keys = NULL, metadata = NULL) {
     any.missing = FALSE, names = "unique",
     types = c("data.frame", "reactive", "MultiAssayExperiment")
   )
-  checkmate::assert_class(join_keys, "JoinKeys", null.ok = TRUE)
+  checkmate::assert_class(join_keys, "join_keys", null.ok = TRUE)
   checkmate::assert_multi_class(code, c("character", "reactive"))
 
   checkmate::assert_list(metadata, names = "unique", null.ok = TRUE)
@@ -123,15 +123,15 @@ get_code_tdata <- function(data) {
   get_code(data)
 }
 
-#' Extract `JoinKeys` from `tdata`
-#' @rdname get_join_keys
-#' @param data (`tdata`) object
-#' @keywords internal
+#' Extract `join_keys` from `tdata`
+#' @param data A `tdata` object
+#' @param ... Additional arguments (not used)
 #' @export
-get_join_keys.tdata <- function(data) {
+join_keys.tdata <- function(data, ...) {
   attr(data, "join_keys")
 }
 
+
 #' Function to get metadata from a `tdata` object
 #' @param data `tdata` - object to extract the data from
 #' @param dataname `character(1)` the dataset name whose metadata is requested

R/utils.R

@@ -38,7 +38,7 @@ include_parent_datanames <- function(dataname, join_keys) {
   parents <- character(0)
   for (i in dataname) {
     while (length(i) > 0) {
-      parent_i <- join_keys$get_parent(i)
+      parent_i <- teal.data::parent(join_keys, i)
       parents <- c(parent_i, parents)
       i <- parent_i
     }
@@ -106,7 +106,7 @@ report_card_template <- function(title, label, description = NULL, with_filter,
 #' When `datanames` is set to `"all"` it is replaced with all available datasets names.
 #' @param modules (`teal_modules`) object
 #' @param datanames (`character`) names of datasets available in the `data` object
-#' @param join_keys (`JoinKeys`) object
+#' @param join_keys (`join_keys`) object
 #' @return `teal_modules` with resolved `datanames`
 #' @keywords internal
 resolve_modules_datanames <- function(modules, datanames, join_keys) {

_pkgdown.yml

@@ -119,6 +119,7 @@ reference:
       - get_metadata
       - tdata2env
       - show_rcode_modal
+      - join_keys.tdata
   # - title: Functions Moved to Other Packages
     # desc: These functions have been moved from teal and will be deprecated
     # contents:

tests/testthat/test-module_nested_tabs.R

@@ -451,7 +451,7 @@ testthat::test_that(".datasets_to_data returns tdata object", {
 
   # join_keys
   testthat::expect_equal(
-    get_join_keys(data),
+    join_keys(data),
     teal.data::join_keys(teal.data::join_key("d1", "d2", c("pk" = "id")))
   )
 

tests/testthat/test-tdata.R

@@ -62,14 +62,14 @@ testthat::test_that("new_tdata accepts character and reactive characters for cod
   )
 })
 
-testthat::test_that("new_tdata throws error if join_keys is not of class JoinKeys", {
+testthat::test_that("new_tdata throws error if join_keys is not of class join_keys", {
   testthat::expect_error(
     new_tdata(list(x = iris), join_keys = "x"),
-    "Assertion on 'join_keys' failed: Must inherit from class 'JoinKeys'"
+    "Assertion on 'join_keys' failed: Must inherit from class 'join_keys'"
   )
 })
 
-testthat::test_that("new_tdata throws no error if join_keys is of class JoinKeys", {
+testthat::test_that("new_tdata throws no error if join_keys is of class join_keys", {
   testthat::expect_error(
     new_tdata(list(x = iris), join_keys = teal.data::join_keys()),
     NA
@@ -200,12 +200,12 @@ testthat::test_that("tdata2env throws error if argument is not tdata", {
 })
 
 # ---- get_join_keys ----
-testthat::test_that("get_join_keys returns NULL if no JoinKeys object exists inside tdata", {
+testthat::test_that("join_keys returns NULL if no join_keys object exists inside tdata", {
   my_tdata <- new_tdata(data = list(iris = iris, mae = reactive(miniACC)))
-  testthat::expect_null(get_join_keys(my_tdata))
+  testthat::expect_null(join_keys(my_tdata))
 })
 
-testthat::test_that("get_join_keys returns JoinKeys object if it exists inside tdata", {
+testthat::test_that("join_keys returns join_keys object if it exists inside tdata", {
   jk <- teal.data::join_keys(teal.data::join_key("A", "B", c("id" = "fk")))
 
   my_tdata <- new_tdata(
@@ -216,5 +216,5 @@ testthat::test_that("get_join_keys returns JoinKeys object if it exists inside t
     join_keys = jk
   )
 
-  testthat::expect_equal(get_join_keys(my_tdata), jk)
+  testthat::expect_equal(join_keys(my_tdata), jk)
 })

vignettes/creating-custom-modules.Rmd

@@ -114,7 +114,7 @@ srv_histogram_example <- function(id, data, histogram_var) {
       id = "histogram_var",
       datasets = data,
       data_extract_spec = histogram_var,
-      join_keys = get_join_keys(data)
+      join_keys = teal.data::join_keys(data)
     )
 
     dataname <- reactive(extracted()$dataname)