Refactor

DESCRIPTION

@@ -33,6 +33,7 @@ Imports:
     shinyjs,
     stats,
     teal.logger (>= 0.1.1),
+    teal.code,
     utils,
     yaml (>= 1.1.0)
 Suggests:

NAMESPACE

@@ -12,6 +12,8 @@ S3method(get_code,default)
 S3method(get_dataname,TealDataAbstract)
 S3method(get_dataname,TealDataset)
 S3method(get_dataname,TealDatasetConnector)
+S3method(get_dataname,ddl)
+S3method(get_dataname,teal_data)
 S3method(get_dataset,TealDataAbstract)
 S3method(get_dataset,TealDataset)
 S3method(get_dataset,TealDatasetConnector)
@@ -20,6 +22,10 @@ S3method(get_dataset_label,TealDatasetConnector)
 S3method(get_datasets,TealDataAbstract)
 S3method(get_datasets,TealDataset)
 S3method(get_datasets,TealDatasetConnector)
+S3method(get_datasets,teal_data)
+S3method(get_join_keys,TealData)
+S3method(get_join_keys,ddl)
+S3method(get_join_keys,teal_data)
 S3method(get_key_duplicates,TealDataset)
 S3method(get_key_duplicates,data.frame)
 S3method(get_keys,TealDataAbstract)
@@ -55,6 +61,7 @@ S3method(to_relational_data,TealDataset)
 S3method(to_relational_data,TealDatasetConnector)
 S3method(to_relational_data,data.frame)
 S3method(to_relational_data,list)
+S3method(to_relational_data,teal_data)
 export("col_labels<-")
 export("data_label<-")
 export(as_cdisc)
@@ -79,6 +86,7 @@ export(dataset)
 export(dataset_connector)
 export(dataset_connector_file)
 export(dataset_file)
+export(ddl)
 export(example_cdisc_data)
 export(fun_cdisc_dataset_connector)
 export(fun_dataset_connector)
@@ -89,11 +97,11 @@ export(get_dataname)
 export(get_dataset)
 export(get_dataset_label)
 export(get_datasets)
+export(get_join_keys)
 export(get_key_duplicates)
 export(get_keys)
 export(get_labels)
 export(get_raw_data)
-export(is_pulled)
 export(join_key)
 export(join_keys)
 export(load_dataset)
@@ -102,6 +110,7 @@ export(mae_dataset)
 export(mutate_data)
 export(mutate_dataset)
 export(mutate_join_keys)
+export(new_teal_data)
 export(python_cdisc_dataset_connector)
 export(python_code)
 export(python_dataset_connector)
@@ -113,11 +122,16 @@ export(script_cdisc_dataset_connector)
 export(script_dataset_connector)
 export(set_args)
 export(set_keys)
+export(submit_button_server)
+export(submit_button_ui)
 export(teal_data)
 export(teal_data_file)
 export(to_relational_data)
 export(validate_metadata)
+exportClasses(teal_data)
+exportMethods(new_teal_data)
 import(shiny)
+import(teal.code)
 importFrom(digest,digest)
 importFrom(logger,log_trace)
 importFrom(shinyjs,show)

R/cdisc_data.R

@@ -68,58 +68,80 @@ cdisc_data <- function(...,
                        code = "",
                        check = FALSE) {
   data_objects <- list(...)
-  checkmate::assert_list(
-    data_objects,
-    types = c("TealDataset", "TealDatasetConnector", "TealDataConnector")
-  )
+
+  # todo: is it really important? - to remove
   if (inherits(join_keys, "JoinKeySet")) {
     join_keys <- teal.data::join_keys(join_keys)
   }
 
-  update_join_keys_to_primary(data_objects, join_keys)
+  if (
+    checkmate::test_list(data_objects, types = c("TealDataConnector", "TealDataset", "TealDatasetConnector"))
+  ) {
+    update_join_keys_to_primary(data_objects, join_keys)
 
-  retrieve_parents <- function(x) {
-    tryCatch(
-      x$get_parent(),
-      error = function(cond) rep(character(0), length(x$get_datanames()))
-    )
-  }
+    retrieve_parents <- function(x) {
+      lifecycle::deprecate_warn(
+        when = "0.3.1",
+        "cdisc_data(
+        data_objects = 'should use data directly. Using TealDatasetConnector and TealDataset is deprecated.'
+      )"
+      )
+      tryCatch(
+        x$get_parent(),
+        error = function(cond) rep(character(0), length(x$get_datanames()))
+      )
+    }
+
+    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 {
+          list(retrieve_parents(x))
+        }
+      })
+    }
+
+    new_parents <- unlist(new_parents_fun(data_objects), recursive = FALSE)
 
-  new_parents_fun <- function(data_objects) {
-    lapply(data_objects, function(x) {
+    names(new_parents) <- unlist(lapply(data_objects, function(x) {
       if (inherits(x, "TealDataConnector")) {
-        unlist(new_parents_fun(x$get_items()), recursive = FALSE)
+        lapply(x$get_items(), function(z) z$get_dataname())
       } else {
-        list(retrieve_parents(x))
+        x$get_datanames()
       }
-    })
-  }
-
-  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(z) z$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()
 
-  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)
 
-  x <- TealData$new(..., check = check, join_keys = join_keys)
+    if (length(code) > 0 && !identical(code, "")) {
+      x$set_pull_code(code = code)
+    }
 
-  if (length(code) > 0 && !identical(code, "")) {
-    x$set_pull_code(code = code)
-  }
+    x$check_reproducibility()
+    x$check_metadata()
 
-  x$check_reproducibility()
-  x$check_metadata()
-  return(x)
+    if (is_pulled(x)) {
+      new_teal_data(
+        env = lapply(x$get_datasets(), function(x) x$get_raw_data()),
+        code = x$get_code(),
+        keys = x$get_join_keys()
+      )
+    } else {
+      x
+    }
+  } else {
+    if (!checkmate::test_names(names(data_objects), type = "named")) {
+      stop("Dot (`...`) arguments on `teal_data()` must be named.")
+    }
+    new_teal_data(env = data_objects, code = code, keys = join_keys)
+  }
 }
 
 #' Load `TealData` object from a file

R/get_dataname.R

@@ -32,3 +32,9 @@ get_dataname.TealDatasetConnector <- function(x) { # nolint
 get_dataname.TealDataset <- function(x) { # nolint
   return(x$get_dataname())
 }
+
+#' @rdname get_dataname
+#' @export
+get_dataname.teal_data <- function(x) { # nolint
+  return(x@datanames)
+}

R/get_datasets.R

@@ -133,3 +133,9 @@ get_datasets.TealDatasetConnector <- function(x) { # nolint
 get_datasets.TealDataset <- function(x) {
   x
 }
+
+#' @rdname get_datasets
+#' @export
+get_datasets.teal_data <- function(x) {
+  as.list(x@env)[teal.data::get_dataname(x)]
+}

R/get_join_keys.R

@@ -0,0 +1,20 @@
+#' Function to get join keys from a `` object
+#' @param data `` - object to extract the join keys
+#' @return Either `JoinKeys` object or `NULL` if no join keys
+#' @export
+get_join_keys <- function(data) {
+  UseMethod("get_join_keys", data)
+}
+
+
+#' @rdname get_join_keys
+#' @export
+get_join_keys.teal_data <- function(data) {
+  data@join_keys
+}
+
+#' @rdname get_join_keys
+#' @export
+get_join_keys.TealData <- function(data) {
+  data$get_join_keys()
+}

R/is_pulled.R

@@ -6,7 +6,6 @@
 #' @param x ([`TealDatasetConnector`], [`TealDataset`] or [`TealDataAbstract`])
 #'
 #' @return (`logical`) `TRUE` if connector has been already pulled, else `FALSE`.
-#' @export
 is_pulled <- function(x) {
   UseMethod("is_pulled")
 }

R/teal_data-class.R

@@ -0,0 +1,78 @@
+setOldClass("JoinKeys")
+
+#' @import teal.code
+#' @export
+setClass(
+  Class = "teal_data",
+  contains = "qenv",
+  slots = c(join_keys = "JoinKeys", datanames = "character"),
+  prototype = list(
+    join_keys = join_keys(),
+    datanames = character(0)
+  )
+)
+
+#' Initialize `teal_data` object
+#'
+#' Initialize `teal_data` object.
+#' @name new_teal_data
+#'
+#' @param code (`character(1)` or `language`) code to evaluate. Accepts and stores comments also.
+#' @param env (`list`) List of data.
+#' @param keys (`JoinKeys`) object
+#' @param datanames (`character`) names of datasets in `env`. Needed when non-dataset
+#'   objects are needed in the `env` slot.
+#'
+#' @examples
+#' new_teal_data(env = list(a = 1), code = quote(a <- 1))
+#' new_teal_data(env = list(a = 1), code = parse(text = "a <- 1"))
+#' new_teal_data(env = list(a = 1), code = "a <- 1")
+#'
+#' @export
+setGeneric("new_teal_data", function(env = new.env(), code = expression(), keys = join_keys(), datanames = character()) {
+  standardGeneric("new_teal_data")
+})
+
+#' @rdname new_teal_data
+#' @export
+setMethod(
+  "new_teal_data",
+  signature = c(env = "list", code = "expression", keys = "ANY"),
+  function(env, code, keys = join_keys(), datanames = names(env)) {
+    new_env <- rlang::env_clone(list2env(env), parent = parent.env(.GlobalEnv))
+    lockEnvironment(new_env, bindings = TRUE)
+    id <- sample.int(.Machine$integer.max, size = length(code))
+    methods::new(
+      "teal_data",
+      env = new_env,
+      code = code,
+      warnings = rep("", length(code)),
+      messages = rep("", length(code)),
+      id = id,
+      join_keys = keys,
+      datanames = as.character(union(names(env), names(keys$get())))
+    )
+  }
+)
+
+#' @rdname new_teal_data
+#' @export
+setMethod(
+  "new_teal_data",
+  signature = c(env = "list", code = "language", keys = "ANY"),
+  function(env, code, keys = join_keys(), datanames = names(env)) {
+    code_expr <- as.expression(code)
+    new_teal_data(env = env, code = code_expr, keys = keys, datanames = datanames)
+  }
+)
+
+#' @rdname new_teal_data
+#' @export
+setMethod(
+  "new_teal_data",
+  signature = c(env = "list", code = "character", keys = "ANY"),
+  function(env, code, keys = join_keys(), datanames = names(env)) {
+    code_expr <- parse(text = code)
+    new_teal_data(env = env, code = code_expr, keys = keys, datanames = datanames)
+  }
+)

R/teal_data.R

@@ -36,27 +36,49 @@ teal_data <- function(...,
                       code = "",
                       check = FALSE) {
   data_objects <- list(...)
-  checkmate::assert_list(
-    data_objects,
-    types = c("TealDataset", "TealDatasetConnector", "TealDataConnector")
-  )
   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)
 
-  update_join_keys_to_primary(data_objects, join_keys)
-
-  x <- TealData$new(..., check = check, join_keys = join_keys)
+    x <- TealData$new(..., check = check, join_keys = join_keys)
+    if (length(code) > 0 && !identical(code, "")) {
+      x$set_pull_code(code = code)
+    }
+    x$check_reproducibility()
+    x$check_metadata()
 
-  if (length(code) > 0 && !identical(code, "")) {
-    x$set_pull_code(code = code)
+    if (is_pulled(x)) {
+      new_teal_data(
+        env = lapply(x$get_datasets(), function(x) x$get_raw_data()),
+        code = x$get_code(),
+        keys = x$get_join_keys()
+      )
+    } else {
+      x
+    }
+  } else {
+    if (!checkmate::test_names(names(data_objects), type = "named")) {
+      stop("Dot (`...`) arguments on `teal_data()` must be named.")
+    }
+    new_teal_data(
+      env = data_objects,
+      code = code,
+      keys = join_keys
+    )
   }
+}
 
-  x$check_reproducibility()
-  x$check_metadata()
 
-  return(x)
-}
 
 
 #' Load `TealData` object from a file