feat: adds tests and simplifies cdisc_data

R/CallableFunction.R

@@ -144,7 +144,6 @@ CallableFunction <- R6::R6Class( # nolint
     # @return nothing
     refresh = function() {
       if (!is.null(private$fun_name) || !identical(private$fun_name, character(0))) {
-
         # replaced str2lang found at:
         # https://rlang.r-lib.org/reference/call2.html
         private$call <- as.call(

R/JoinKeys.R

@@ -401,13 +401,21 @@ join_keys <- function(...) {
 #' cdisc_join_keys(join_key("dataset_A", "dataset_B", c("col_1" = "col_a")), "ADTTE")
 #'
 cdisc_join_keys <- function(...) {
-  x <- list(...)
+  data_objects <- list(...)
 
-  x_parsed <- lapply(seq_along(x), function(ix) {
-    item <- x[[ix]]
+  data_objects_parsed <- lapply(seq_along(data_objects), function(ix) {
+    item <- data_objects[[ix]]
+    name <- names(data_objects)[ix] %||% item # fallback to value if names are not set
 
-    name <- names(x)[ix] %||% item # fallback to value if names are not set
     if (
+      checkmate::test_r6(item) &&
+        checkmate::test_multi_class(
+          item,
+          classes = c("TealDataConnector", "TealDataset", "TealDatasetConnector")
+        )
+    ) {
+      return(NULL)
+    } else if (
       checkmate::test_class(item, "JoinKeySet") ||
         !checkmate::test_string(name, min.chars = 1) ||
         !name %in% names(default_cdisc_keys)) {
@@ -424,9 +432,10 @@ cdisc_join_keys <- function(...) {
     # Add JoinKey with parent dataset (if exists)
     append(result, list(join_key(name, keys_list$parent, keys = keys_list$foreign)))
   })
-  x_parsed <- do.call(c, x_parsed)
 
-  do.call(join_keys, x_parsed)
+  data_objects_parsed <- do.call(c, data_objects_parsed)
+
+  do.call(join_keys, as.list(data_objects_parsed[!is.null(data_objects_parsed)]))
 }
 
 # wrappers ====

R/cdisc_data.R

@@ -37,25 +37,24 @@ cdisc_data <- function(...,
                        code = "",
                        check = FALSE) {
   data_objects <- list(...)
+  deprecated_join_keys_extract(data_objects, join_keys)
+  teal_data(..., join_keys = join_keys, code = code, check = check)
+}
 
-  # todo: is it really important? - to remove
-  if (inherits(join_keys, "JoinKeySet")) {
-    join_keys <- teal.data::join_keys(join_keys)
-  }
-
-  if (
-    checkmate::test_list(data_objects, types = c("TealDataConnector", "TealDataset", "TealDatasetConnector"))
-  ) {
-    lifecycle::deprecate_warn(
-      when = "0.3.1",
-      "cdisc_data(
-        data_objects = 'should use data directly. Using TealDatasetConnector and TealDataset is deprecated.'
-      )"
-    )
-    update_join_keys_to_primary(data_objects, join_keys)
+#' Extrapolate parents from `TealData` classes
+#'
+#' note: This function will be removed once the following classes are defunct:
+#'  `TealDataConnector`, `TealDataset`, `TealDatasetConnector`
+#'
+#' @keywords internal
+deprecated_join_keys_extract <- function(data_objects, join_keys) {
+  # TODO: check if redundant with same call in teal_data body
+  update_join_keys_to_primary(data_objects, join_keys)
 
-    new_parents_fun <- function(data_objects) {
-      lapply(data_objects, function(x) {
+  new_parents_fun <- function(data_objects) {
+    lapply(
+      data_objects,
+      function(x) {
         if (inherits(x, "TealDataConnector")) {
           unlist(new_parents_fun(x$get_items()), recursive = FALSE)
         } else {
@@ -66,40 +65,27 @@ cdisc_data <- function(...,
             )
           )
         }
-      })
-    }
-
-    new_parents <- unlist(new_parents_fun(data_objects), recursive = FALSE)
-
-    names(new_parents) <- unlist(lapply(data_objects, function(x) {
-      if (inherits(x, "TealDataConnector")) {
-        lapply(x$get_items(), function(y) y$get_dataname())
-      } else {
-        x$get_datanames()
       }
-    }))
-
-    if (is_dag(new_parents)) {
-      stop("Cycle detected in a parent and child dataset graph.")
-    }
-    join_keys$set_parents(new_parents)
-    join_keys$update_keys_given_parents()
+    )
+  }
 
-    x <- TealData$new(..., check = check, join_keys = join_keys)
+  new_parents <- unlist(new_parents_fun(data_objects), recursive = FALSE)
 
-    if (length(code) > 0 && !identical(code, "")) {
-      x$set_pull_code(code = code)
+  names(new_parents) <- unlist(lapply(data_objects, function(x) {
+    if (inherits(x, "TealDataConnector")) {
+      lapply(x$get_items(), function(y) y$get_dataname())
+    } else {
+      x$get_datanames()
     }
+  }))
 
-    x$check_reproducibility()
-    x$check_metadata()
-    x
-  } else {
-    if (!checkmate::test_names(names(data_objects), type = "named")) {
-      stop("Dot (`...`) arguments on `teal_data()` must be named.")
-    }
-    new_teal_data(data = data_objects, code = code, keys = join_keys)
+  if (is_dag(new_parents)) {
+    stop("Cycle detected in a parent and child dataset graph.")
   }
+  join_keys$set_parents(new_parents)
+  join_keys$update_keys_given_parents()
+
+  join_keys
 }
 
 #' Load `TealData` object from a file

tests/testthat/helper-get_join_keys.R

@@ -0,0 +1,45 @@
+#' Generate a teal_data dataset with sample data and JoinKeys
+helper_generator_teal_data <- function() {
+  iris2 <- iris
+  iris2$id <- rnorm(NROW(iris2))
+  iris2$id <- apply(iris2, 1, rlang::hash)
+  new_teal_data(
+    list(
+      ds1 = iris2,
+      ds2 = iris2
+    ),
+    code = "ds1 <- iris2; ds2 <- iris2",
+    keys = helper_generator_JoinKeys("ds1", keys = c("id"))
+  )
+}
+
+#' Generate a JoinKeys
+helper_generator_JoinKeys <- function(dataset_1 = "ds1", keys = c("id")) {
+  join_keys(
+    join_key(dataset_1, keys = keys)
+  )
+}
+
+#' Test suite for default get_join generated by helper
+helper_test_get_join_keys <- function(obj, dataset_1 = "ds1") {
+  jk <- get_join_keys(obj)
+
+  expect_s3_class(jk, c("JoinKey", "R6"))
+  expect_length(jk$get(), 1)
+  expect_length(jk$get(dataset_1), 1)
+
+  obj
+}
+
+#' Test suite for JoinKeys after manual adding a primary key
+helper_test_get_join_keys_add <- function(obj, dataset_1 = "ds1", new_dataset_1 = "ds2", new_keys = c("id")) {
+  obj <- helper_test_get_join_keys(obj, dataset_1)
+  get_join_keys(obj)[new_dataset_1] <- c(new_keys)
+
+  jk <- get_join_keys(obj)
+
+  checkmate::expect_r6(jk, c("JoinKeys"))
+  expect_length(jk$get(), 2)
+  expect_length(jk$get(dataset_1), 1)
+  expect_length(jk$get(new_dataset_1), 1)
+}

tests/testthat/test-JoinKeys.R

@@ -1,3 +1,34 @@
+test_that("[.JoinKeys returns the primary key if arguments only have 1 dataset", {
+  jk <- join_keys(join_key("ds1", keys = c("id")))
+
+  expect_failure(expect_identical(jk$get("ds1"), jk["ds1"]))
+  checkmate::expect_character(jk["ds1"])
+})
+
+test_that("[.JoinKeys subsets relationship pair successfully", {
+  jk <- join_keys(join_key("ds1", keys = c("id")))
+
+  expect_identical(jk$get("ds1", "ds1"), jk["ds1"])
+})
+
+test_that("[<-.JoinKeys assigns new relationship pair", {
+  jk <- join_keys(join_key("ds1", keys = c("id")))
+
+  expect_length(jk$get("ds1", "ds2"), 0)
+
+  jk["ds1", "ds2"] <- c("id")
+  expect_identical(jk$get("ds1", "ds2"), c(id = "id"))
+  expect_identical(jk$get("ds1", "ds2"), jk["ds1", "ds2"])
+})
+
+test_that("[<-.JoinKeys modifies existing relationship pair", {
+  jk <- join_keys(join_key("ds1", keys = c("id")))
+
+  jk["ds1", "ds1"] <- c("Species")
+  expect_failure(expect_identical(jk$get("ds1", "ds1"), c(id = "id")))
+  expect_identical(jk$get("ds1", "ds1"), c(Species = "Species"))
+})
+
 test_that("join_key throws error with invalid keys arguments", {
   # invalid types
   expect_error(join_key("d1", "d2", keys = NULL))

tests/testthat/test-cdisc_data.R

@@ -33,7 +33,7 @@ cdisc_data_mixed_call <- function(check = TRUE, join_keys1 = join_keys()) {
 }
 
 testthat::test_that("cdisc_data accepts TealDataset, TealDatasetConnector, TealDataConnector objects", {
-  testthat::expect_silent(data <- cdisc_data_mixed_call())
+  lifecycle::expect_deprecated(data <- cdisc_data_mixed_call(), "should use data directly")
   testthat::expect_identical(data$get_datanames(), c("ADSL", "ADTTE", "ADAE"))
 })
 

tests/testthat/test-get_join_keys.R

@@ -0,0 +1,23 @@
+test_that("get_join_keys.teal_data will successfully obtain object from teal_data", {
+  obj <- helper_generator_teal_data()
+
+  expect_identical(obj@join_keys, get_join_keys(obj))
+  helper_test_get_join_keys(obj, "ds1")
+})
+
+test_that("get_join_keys.JoinKeys will return itself", {
+  obj <- helper_generator_JoinKeys()
+
+  expect_identical(obj, get_join_keys(obj))
+  helper_test_get_join_keys(obj, "ds1")
+})
+
+test_that("get_join_keys<-.teal_data", {
+  obj <- helper_generator_teal_data()
+  helper_test_get_join_keys_add(obj, "ds1", "ds2")
+})
+
+test_that("get_join_keys<-.JoinKeys", {
+  obj <- helper_generator_JoinKeys()
+  helper_test_get_join_keys_add(obj, "ds1", "ds2")
+})