append_join_keys for teal_data object

DESCRIPTION

@@ -63,6 +63,7 @@ Collate:
     'deprecated.R'
     'dummy_function.R'
     'join_key.R'
+    'join_keys-append.R'
     'join_keys-c.R'
     'join_keys-extract.R'
     'join_keys-names.R'

NAMESPACE

@@ -25,6 +25,7 @@ export("col_labels<-")
 export("datanames<-")
 export("join_keys<-")
 export("parents<-")
+export(append_join_keys)
 export(cdisc_data)
 export(col_labels)
 export(col_relabel)

R/join_keys-append.R

@@ -0,0 +1,32 @@
+#' Append elements to join_keys
+#'
+#' This function appends elements to the join_keys slot of a teal_data object.
+#' It follows the same pattern as base R's append() function.
+#'
+#' @param x A teal_data object
+#' @param values (`join_keys`) object to append
+#' @param after Integer, the position after which the elements are to be appended.
+#'   If negative or zero, the values are prepended to the join_keys.
+#'   If missing, the values are appended at the end.
+#'
+#' @return A teal_data object with updated join_keys
+#'
+#' @examples
+#' data <- teal_data()
+#' keys1 <- join_keys(
+#'   join_key("ADSL", "ADSL", "USUBJID"),
+#'   join_key("ADAE", "ADAE", "USUBJID"),
+#'   join_key("ADSL", "ADAE", c(USUBJID = "USUBJID"))
+#' )
+#' data <- append_join_keys(data, keys1)
+#' join_keys(data)
+#'
+#' @export
+append_join_keys <- function(x, values, after = length(join_keys(x))) {
+  checkmate::assert_class(x, "teal_data")
+  checkmate::assert_int(after, lower = 0, upper = length(join_keys(x)), null.ok = TRUE)
+  checkmate::assert_class(value, "join_keys")
+
+  join_keys(x) <- append(join_keys(x), values, after = after)
+  x
+} 

R/teal_data-class.R

@@ -35,11 +35,7 @@ setOldClass("join_keys")
 setClass(
   Class = "teal_data",
   contains = "qenv",
-  slots = c(join_keys = "join_keys", verified = "logical"),
-  prototype = list(
-    join_keys = join_keys(),
-    verified = logical(0)
-  )
+  slots = c(join_keys = "join_keys", verified = "logical")
 )
 
 #' It initializes the `teal_data` class
@@ -50,13 +46,12 @@ setClass(
 setMethod(
   "initialize",
   "teal_data",
-  function(.Object, .xData = list(), join_keys = join_keys(), code = list(), ...) { # nolint: object_name.
-    # Allow .xData to be a list and convert it to an environment
-    if (!missing(.xData) && inherits(.xData, "list")) {
-      .xData <- rlang::env_clone(list2env(.xData), parent = parent.env(.GlobalEnv)) # nolint: object_name.
-      lockEnvironment(.xData, bindings = TRUE)
-    }
+  function(.Object, .xData, join_keys, code, ...) { # nolint: object_name.
+    if (missing(.xData)) .xData <- new.env()
+    if (missing(join_keys)) join_keys <- teal.data::join_keys()
+    if (missing(code)) code <- character(0L)
     args <- list(...)
+
     checkmate::assert_environment(.xData)
     checkmate::assert_class(join_keys, "join_keys")
     checkmate::assert_list(args, names = "named")
@@ -67,15 +62,12 @@ setMethod(
     if (is.language(code)) {
       code <- paste(lang2calls(code), collapse = "\n")
     }
-    if (length(code)) {
-      code <- paste(code, collapse = "\n")
-    }
 
     methods::callNextMethod(
       .Object,
       .xData,
       join_keys = join_keys,
-      verified = (length(args$code) == 0L && length(.xData) == 0L),
+      verified = (length(code) == 0L && length(.xData) == 0L),
       code = code2list(code),
       ...
     )
@@ -97,6 +89,7 @@ code2list <- function(code) {
   if (length(code) == 0) {
     return(list())
   }
+  code <- paste(code, collapse = "\n")
 
   parsed_code <- parse(text = code, keep.source = TRUE)
 

R/teal_data-constructor.R

@@ -48,13 +48,12 @@ teal_data <- function(...,
   if (inherits(join_keys, "join_key_set")) {
     join_keys <- teal.data::join_keys(join_keys)
   }
-
   if (length(data_objects) > 0 && !checkmate::test_names(names(data_objects), type = "named")) {
     stop("Dot (`...`) arguments on `teal_data()` must be named.")
   }
   methods::new(
     "teal_data",
-    .xData = data_objects,
+    .xData = list2env(data_objects),
     code = code,
     join_keys = join_keys
   )

R/teal_data-show.R

@@ -12,9 +12,9 @@
 #' @export
 setMethod("show", signature = "teal_data", function(object) {
   if (object@verified) {
-    cat("\u2705\ufe0e", "verified teal_data object\n")
+    cat("\u2705\ufe0e", "code verified\n")
   } else {
-    cat("\u2716", "unverified teal_data object\n")
+    cat("\u2716", "code unverified\n")
   }
   methods::callNextMethod(object)
   invisible(object)