#' Names of data sets in `teal_data` object

#'

#' Get or set the value of the `datanames` slot.

#'

#' The `@datanames` slot in a `teal_data` object specifies which of the variables stored in its environment

#' (the `@env` slot) are data sets to be taken into consideration.

#' The contents of `@datanames` can be specified upon creation and default to all variables in `@env`.

#' Variables created later, which may well be data sets, are not automatically considered such.

#' Use this function to update the slot.

#'

#' @param x (`teal_data`) object to access or modify

#' @param value (`character`) new value for `@datanames`; all elements must be names of variables existing in `@env`

#'

#' @return The contents of `@datanames` or `teal_data` object with updated `@datanames`.

#'

#' @examples

#' td <- teal_data(iris = iris)

#' td <- within(td, mtcars <- mtcars)

#' datanames(td)

#'

#' datanames(td) <- c("iris", "mtcars")

#' datanames(td)

#'

#' @name datanames

#' @aliases datanames,teal_data-method

#' @aliases datanames<-,teal_data,character-method

#' @aliases datanames,qenv.error-method

#' @aliases datanames<-,qenv.error,character-method

#' @rdname datanames

#' @export

setMethod("datanames", signature = "teal_data", definition = function(x) {

})

setMethod("datanames", signature = "qenv.error", definition = function(x) {

})

#' @rdname datanames

#' @export

setMethod("datanames<-", signature = c("teal_data", "character"), definition = function(x, value) {

})

setMethod("datanames<-", signature = c("qenv.error", "character"), definition = function(x, value) {

})

#' Create a relationship between a pair of datasets

#'

#' @description

#' `r lifecycle::badge("stable")`

#'

#' Create a relationship between two datasets, `dataset_1` and `dataset_2`.

#' By default, this function establishes a directed relationship with `dataset_1` as the parent.

#' If `dataset_2` is not specified, the function creates a primary key for `dataset_1`.

#'

#' @param dataset_1,dataset_2 (`character(1)`) Dataset names. When `dataset_2` is omitted,

#' a primary key for `dataset_1` is created.

#' @param keys (optionally named `character`) Column mapping between the datasets,

#' where `names(keys)` maps columns in `dataset_1` corresponding to columns of

#' `dataset_2` given by the elements of `keys`.

#' - If unnamed, the same column names are used for both datasets.

#' - If any element of the `keys` vector is empty with a non-empty name, then the name is

#' used for both datasets.

#' @param directed (`logical(1)`) Flag that indicates whether it should create

#' a parent-child relationship between the datasets.

#'  - `TRUE` (default) `dataset_1` is the parent of `dataset_2`;

#'  - `FALSE` when the relationship is undirected.

#'

#' @return object of class `join_key_set` to be passed into `join_keys` function.

#'

#' @examples

#' join_key("d1", "d2", c("A"))

#' join_key("d1", "d2", c("A" = "B"))

#' join_key("d1", "d2", c("A" = "B", "C"))

#'

#' @export

#' @seealso [join_keys()], [parents()]

#'

join_key <- function(dataset_1, dataset_2 = dataset_1, keys, directed = TRUE) {

    }

    # Remove keys with empty value and without name

    }

    # Set name of keys without one: c("A") -> c("A" = "A")

    }

    # Set value of keys with empty string, but non-empty name: c("A" = "") -> c("A" = "A")

    }

    }

  } else {

  }

  } else {

  }

      )

    ),

  )

}

#' Show `teal_data` object

#'

#' Prints `teal_data` object.

#'

#' @param object (`teal_data`)

#' @return Input `teal_data` object.

#' @importFrom methods show

#' @examples

#' teal_data()

#' teal_data(x = iris, code = "x = iris")

#' verify(teal_data(x = iris, code = "x = iris"))

#' @export

setMethod("show", signature = "teal_data", function(object) {

  } else {

  }

})

# get_code_dependency ----

#' Get code dependency of an object

#'

#' Extract subset of code required to reproduce specific object(s), including code producing side-effects.

#'

#' Given a character vector with code, this function will extract the part of the code responsible for creating

#' the variables specified by `names`.

#' This includes the final call that creates the variable(s) in question as well as all _parent calls_,

#' _i.e._ calls that create variables used in the final call and their parents, etc.

#' Also included are calls that create side-effects like establishing connections.

#'

#' It is assumed that object dependency is established by using three assignment operators: `<-`, `=`, and `->` .

#' Other assignment methods (`assign`, `<<-`) or non-standard-evaluation methods are not supported.

#'

#' Side-effects are not detected automatically and must be marked in the code.

#' Add `# @linksto object` at the end of a line where a side-effect occurs to specify that this line is required

#' to reproduce a variable called `object`.

#'

#' @param code `character` with the code.

#' @param names `character` vector of object names.

#' @param check_names `logical(1)` flag specifying if a warning for non-existing names should be displayed.

#'

#' @return Character vector, a subset of `code`.

#' Note that subsetting is actually done on the calls `code`, not necessarily on the elements of the vector.

#'

#' @keywords internal

get_code_dependency <- function(code, names, check_names = TRUE) {

  }

    # Detect if names are actually in code.

    }

    }

  }

}

#' Locate function call token

#'

#' Determine which row of parsed data is specific `SYMBOL_FUNCTION_CALL` token.

#'

#' Useful for determining occurrence of `assign` or `data` functions in an input call.

#'

#' @param call_pd `data.frame` as returned by `extract_calls()`

#' @param text `character(1)` to look for in `text` column of `call_pd`

#'

#' @return

#' Single integer specifying row in `call_pd` where `token` is `SYMBOL_FUNCTION_CALL` and `text` is `text`.

#' 0 if not found.

#'

#' @keywords internal

#' @noRd

find_call <- function(call_pd, text) {

  } else {

  }

}

#' Split the result of `utils::getParseData()` into separate calls

#'

#' @param pd (`data.frame`) A result of `utils::getParseData()`.

#'

#' @return

#' A `list` of `data.frame`s.

#' Each element is a subset of `pd` corresponding to one call in the original code from which `pd` was obtained.

#' Only four columns (`"token"`, `"text"`, `"id"`, `"parent"`) are kept, the rest is discarded.

#'

#' @keywords internal

#' @noRd

extract_calls <- function(pd) {

      )

    }

  )

}

#' @keywords internal

#' @noRd

get_children <- function(pd, parent) {

  }

  }

}

#' Fixes edge case of comments being shifted to the next call.

#' @keywords internal

#' @noRd

fix_shifted_comments <- function(calls) {

  # If the first or the second token is a @linksto COMMENT,

  #  then it belongs to the previous call.

        )

      }

    }

  }

}

#' Fixes edge case of `<-` assignment operator being called as function,

#' which is \code{`<-`(y,x)} instead of traditional `y <- x`.

#' @keywords internal

#' @noRd

fix_arrows <- function(calls) {

    }

  )

}

# code_graph ----

#' Create object dependencies graph within parsed code

#'

#' Builds dependency graph that identifies dependencies between objects in parsed code.

#' Helps understand which objects depend on which.

#'

#' @param calls_pd `list` of `data.frame`s;

#'  result of `utils::getParseData()` split into subsets representing individual calls;

#'  created by `extract_calls()` function

#'

#' @return

#' A list (of length of input `calls_pd`) where each element represents one call.

#' Each element is a character vector listing names of objects that depend on this call

#' and names of objects that this call depends on.

#' Dependencies are listed after the `"<-"` string, e.g. `c("a", "<-", "b", "c")` means that in this call object `a`

#' depends on objects `b` and `c`.

#' If a call is tagged with `@linksto a`, then object `a` is understood to depend on that call.

#'

#' @keywords internal

#' @noRd

code_graph <- function(calls_pd) {

}

#' Extract object occurrence

#'

#' Extracts objects occurrence within calls passed by `calls_pd`.

#' Also detects which objects depend on which within a call.

#'

#' @param calls_pd `list` of `data.frame`s;

#'  result of `utils::getParseData()` split into subsets representing individual calls;

#'  created by `extract_calls()` function

#'

#' @return

#' A list (of length of input `calls_pd`) where each element represents one call.

#' Each element is a character vector listing names of objects that depend on this call

#' and names of objects that this call depends on.

#' Dependencies are listed after the `"<-"` string, e.g. `c("a", "<-", "b", "c")` means that in this call object `a`

#' depends on objects `b` and `c`.

#' If a call is tagged with `@linksto a`, then object `a` is understood to depend on that call.

#'

#' @keywords internal

#' @noRd

extract_occurrence <- function(calls_pd) {

    # If an object is a function parameter,

    # then in calls_pd there is a `SYMBOL_FORMALS` entry for that object.

    } else {

    }

  }

      # Handle data(object)/data("object")/data(object, envir = ) independently.

      }

      # Handle assign(x = ).

        # Check if parameters were named.

        # "','" is for unnamed parameters, where "SYMBOL_SUB" is for named.

        # "EQ_SUB" is for `=` appearing after the name of the named parameter.

          # Remove sequence of "=", ",".

              }

            }

          }

          }

          # pos is indicator of the place of 'x'

          # 1. All parameters are named, but none is 'x' - return(character(0L))

          # 2. Some parameters are named, 'x' is in named parameters: match("x", setdiff(params, ","))

          # - check "x" in params being just a vector of named parameters.

          # 3. Some parameters are named, 'x' is not in named parameters

          # - check first appearance of "," (unnamed parameter) in vector parameters.

        } else {

          # Object is the first entry after 'assign'.

        }

      }

      # What occurs in a function body is not tracked.

      }

      # Watch out for SYMBOLS after $ and @. For x$a x@a: x is object, a is not.

      # For x$a, a's ID is $'s ID-2 so we need to remove all IDs that have ID = $ID - 2.

      }

      }

      # If there was an assignment operation detect direction of it.

      }

      ### NOTE 2: What if there are 2 assignments: e.g. a <- b -> c.

      ### NOTE 1: For cases like 'eval(expression(b <- b + 2))' removes 'eval(expression('.

    }

  )

}

#' Extract side effects

#'

#' Extracts all object names from the code that are marked with `@linksto` tag.

#'

#' The code may contain functions calls that create side effects, e.g. modify the environment.

#' Static code analysis may be insufficient to determine which objects are created or modified by such a function call.

#' The `@linksto` comment tag is introduced to mark a call as having a (side) effect on one or more objects.

#' With this tag a complete object dependency structure can be established.

#' Read more about side effects and the usage of `@linksto` tag in [`get_code_dependencies()`] function.

#'

#' @param calls_pd `list` of `data.frame`s;

#'  result of `utils::getParseData()` split into subsets representing individual calls;

#'  created by `extract_calls()` function

#'

#' @return

#' A list of length equal to that of `calls_pd`, where each element is a character vector of names of objects

#' depending a call tagged with `@linksto` in a corresponding element of `calls_pd`.

#'

#' @keywords internal

#' @noRd

extract_side_effects <- function(calls_pd) {

    }

  )

}

# graph_parser ----

#' Return the indices of calls needed to reproduce an object

#'

#' @param x The name of the object to return code for.

#' @param graph A result of `code_graph()`.

#'

#' @return

#' Integer vector of indices that can be applied to `graph` to obtain all calls required to reproduce object `x`.

#'

#' @keywords internal

#' @noRd

graph_parser <- function(x, graph) {

    },

  )

  })

    })

  } else {

  }

}

# default_side_effects --------------------------------------------------------------------------------------------

#' Detect library calls

#'

#' Detects `library()` and `require()` function calls.

#'

#' @param calls_pd `list` of `data.frame`s;

#'  result of `utils::getParseData()` split into subsets representing individual calls;

#'  created by `extract_calls()` function

#'

#' @return

#' Integer vector of indices that can be applied to `graph` (result of `code_graph()`) to obtain all calls containing

#' `library()` or `require()` calls that are always returned for reproducibility.

#'

#' @keywords internal

#' @noRd

detect_libraries <- function(calls_pd) {

      },

    )

  )

}

#' Test if two objects are (nearly) equal

#'

#' `all.equal(target, current)` is a utility to compare `join_keys` objects target

#' and current testing `near equality`.

#'

#' If they are different, comparison is still made to some extent, and a report

#' of the differences is returned.

#' Do not use `all.equal` directly in if expressions—either use `isTRUE(all.equal(....))`

#' or identical if appropriate.

#'

#' The parents attribute comparison tolerates `NULL` and empty lists and will find

#' no difference.

#'

#' The list containing all the relationships is treated like a map and ignores

#' entries with `NULL` if they exist.

#'

#' @inheritParams base::all.equal

#' @param ... further arguments for different methods. Not used with `join_keys`.

#'

#' @seealso [base::all.equal()]

#' @keywords internal

#'

all.equal.join_keys <- function(target, current, ...) {

    # Keep only non-list attributes

    } else {

    }

    # Remove nulls

    # Sort named components, preserving positions of unnamed

    }

  }

}

#' List containing default joining keys for `CDISC` datasets

#'

#' This data object is created at loading time from `cdisc_datasets/cdisc_datasets.yaml`.

#'

#' @name default_cdisc_join_keys

#' @docType data

#' @export

NULL

#' Helper method to build `default_cdisc_join_keys`

#' @param default_cdisc_keys (`list`) default definition of primary and foreign

#' keys for `CDISC` datasets

#'

#' @keywords internal

build_cdisc_join_keys <- function(default_cdisc_keys) {

    # Set default primary keys

    }

      }

    }

  }

}

#' Variable labels

#'

#' Get or set variable labels in a `data.frame`.

#'

#' @details Variable labels can be stored as a `label` attribute set on individual variables.

#' These functions get or set this attribute, either on all (`col_labels`) or some variables (`col_relabel`).

#'

#' @param x (`data.frame` or `DataFrame`) data object

#' @param fill (`logical(1)`) specifying what to return if variable has no label

#' @param value (`character`) vector of variable labels of length equal to number of columns in `x`;

#'  if named, names must match variable names in `x` and will be used as key to set labels;

#'  use `NA` to remove label from variable

#' @param ... name-value pairs, where name corresponds to a variable name in `x`

#'  and value is the new variable label

#'

#' @return

#' For `col_labels`, named character vector of variable labels, the names being the corresponding variable names.

#' If the `label` attribute is missing, the vector elements will be

#' the variable names themselves if `fill = TRUE` and `NA` if `fill = FALSE`.

#'

#' For `col_labels<-` and `col_relabel`, copy of `x` with variable labels modified.

#'

#' @examples

#' x <- iris

#' col_labels(x)

#' col_labels(x) <- paste("label for", names(iris))

#' col_labels(x)

#' y <- col_relabel(x, Sepal.Length = "Sepal Length of iris flower")

#' col_labels(y)

#'

#' @source These functions were taken from

#' [formatters](https://cran.r-project.org/package=formatters) package, to reduce the complexity of

#' the dependency tree and rewritten.

#'

#' @rdname col_labels

#' @export

#'

col_labels <- function(x, fill = FALSE) {

  }

      } else {

      }

  }

  }

}

#' @rdname col_labels

#' @export

`col_labels<-` <- function(x, value) {

  )

  }

}

#' @rdname col_labels

#' @export

col_relabel <- function(x, ...) {

  }

}

#' Verify code reproducibility

#'

#' Checks whether code in `teal_data` object reproduces the stored objects.

#'

#' If objects created by code in the `@code` slot of `x` are `all_equal` to the contents of the `@env` slot,

#' the function updates the `@verified` slot to `TRUE` in the returned `teal_data` object.

#' Once verified, the slot will always be set to `TRUE`.

#' If the `@code` fails to recreate objects in `teal_data@env`, an error is raised.

#'

#' @return Input `teal_data` object or error.

#'

#' @param x `teal_data` object

#' @examples

#' tdata1 <- teal_data()

#' tdata1 <- within(tdata1, {

#'   a <- 1

#'   b <- a^5

#'   c <- list(x = 2)

#' })

#' verify(tdata1)

#'

#' tdata2 <- teal_data(x1 = iris, code = "x1 <- iris")

#' verify(tdata2)

#' verify(tdata2)@verified

#' tdata2@verified

#'

#' tdata3 <- teal_data()

#' tdata3 <- within(tdata3, {

#'   stop("error")

#' })

#' try(verify(tdata3)) # fails

#'

#'

#' a <- 1

#' b <- a + 2

#' c <- list(x = 2)

#' d <- 5

#' tdata4 <- teal_data(

#'   a = a, b = b, c = c, d = d,

#'   code = "a <- 1

#'           b <- a

#'           c <- list(x = 2)

#'           e <- 1"

#' )

#' tdata4

#' try(verify(tdata4)) # fails

#'

#' @name verify

#' @rdname verify

#' @aliases verify,teal_data-method

#' @aliases verify,qenv.error-method

#'

#' @export

setMethod("verify", signature = "teal_data", definition = function(x) {

  }

  }

  } else {

      },

    )

      )

    }

      )

    }

      )

    }

  }

})

setMethod("verify", signature = "qenv.error", definition = function(x) {

})

#' Topological graph sort

#'

#' Graph is a `list` which for each node contains a vector of child nodes

#' in the returned list, parents appear before their children.

#'

#' Implementation of `Kahn` algorithm with a modification to maintain the order of input elements.

#'

#' @param graph (`named list`) with node vector elements

#' @keywords internal

topological_sort <- function(graph) {

  # compute in-degrees

    }

  }

    }

  }

  # sort

  }

      }

    }

  }

    )

  } else {

  }

}

#' Checks whether a graph is a `Directed Acyclic Graph (DAG)`

#'

#' @inheritParams topological_sort

#' @return `logical(1)` `TRUE` if the graph is a `DAG`; `FALSE` otherwise

#' @keywords internal

is_dag <- function(graph) {

}

#' Get and set parents in `join_keys` object

#'

#' `parents()` facilitates the creation of dependencies between datasets by

#' assigning a parent-child relationship.

#'

#' Each element is defined by a `list` element, where `list("child" = "parent")`.

#'

#' @param x (`join_keys` or `teal_data`) object that contains "parents" information

#' to retrieve or manipulate.

#'

#' @return a `list` of `character` representing the parents.

#'

#' @export

#' @seealso [join_keys()]

parents <- function(x) {

}

#' @describeIn parents Retrieves parents of `join_keys` object.

#' @export

#' @examples

#' # Get parents of join_keys ---

#'

#' jk <- default_cdisc_join_keys["ADEX"]

#' parents(jk)

parents.join_keys <- function(x) {

}

#' @describeIn parents Retrieves parents of `join_keys` inside `teal_data` object.

#' @export

#' @examples

#'

#' # Get parents of join_keys inside teal_data object ---

#'

#' td <- teal_data(

#'   ADSL = rADSL,

#'   ADTTE = rADTTE,

#'   ADRS = rADRS,

#'   join_keys = default_cdisc_join_keys[c("ADSL", "ADTTE", "ADRS")]

#' )

#' parents(td)

parents.teal_data <- function(x) {

}

#' @describeIn parents Assignment of parents in `join_keys` object.

#'

#' @param value (`named list`) of `character` vectors.

#'

#' @export

`parents<-` <- function(x, value) {

}

#' @describeIn parents Assignment of parents of `join_keys` object.

#' @export

#' @examples

#'

#' # Assignment of parents ---

#'

#' jk <- join_keys(

#'   join_key("ds1", "ds2", "id"),

#'   join_key("ds5", "ds6", "id"),

#'   join_key("ds7", "ds6", "id")

#' )

#'

#' parents(jk) <- list(ds2 = "ds1")

#'

#' # Setting individual parent-child relationship

#'

#' parents(jk)["ds6"] <- "ds5"

#' parents(jk)["ds7"] <- "ds6"

`parents<-.join_keys` <- function(x, value) {

    # Custom .var.name so it is verbose and helpful for users

      ),

    )

    }

  }

  }

}

#' @describeIn parents Assignment of parents of `join_keys` inside `teal_data` object.

#' @export

#' @examples

#'

#' # Assignment of parents of join_keys inside teal_data object ---

#'

#' parents(td) <- list("ADTTE" = "ADSL") # replace existing

#' parents(td)["ADRS"] <- "ADSL" # add new parent

`parents<-.teal_data` <- function(x, value) {

}

#' @describeIn parents Getter for individual parent.

#'

#' @param dataset_name (`character(1)`) Name of dataset to query on their parent.

#'

#' @return For `parent(x, dataset_name)` returns `NULL` if parent does not exist.

#'

#' @export

#'

#' @examples

#'

#' # Get individual parent ---

#'

#' parent(jk, "ds2")

#' parent(td, "ADTTE")

parent <- function(x, dataset_name) {

  # assert x is performed by parents()

}

#' @rdname join_keys

#' @order 2

#'

#' @section Functions:

#' - `x[datanames]`: Returns a subset of the `join_keys` object for

#' given `datanames`, including parent `datanames` and symmetric mirror keys between

#' `datanames` in the result.

#' - `x[i, j]`: Returns join keys between datasets `i` and `j`,

#'   including implicit keys inferred from their relationship with a parent.

#'

#' @param i,j indices specifying elements to extract or replace. Index should be a

#' a character vector, but it can also take numeric, logical, `NULL` or missing.

#'

#' @export

#'

#' @examples

#'

#' # Getter for join_keys ---

#'

#' jk["ds1", "ds2"]

#'

#' # Subsetting join_keys ----

#'

#' jk["ds1"]

#' jk[1:2]

#' jk[c("ds1", "ds2")]

#'

`[.join_keys` <- function(x, i, j) {

    # because:

    # - list(a = 1)[] returns list(a = 1)

    # - data.frame(a = 1)[] returns data.frame(a = 1)

    # because list(a = 1)[NULL] returns NULL

    # data.frame(a = 1)[NULL, NULL] returns data.frame(

    if (

      ) ||

        )

    ) {

      )

    }

    # ie. select all keys which have j as dataset_2

    # since list is symmetrical it is equivalent to selecting by i

  }

  )

  # Convert integer/logical index to named index

  }

  # When retrieving a relationship pair, it will also return the symmetric key

  # Need to iterate on a mutating queue if subset of a dataset will also

  #  select its parent as that parent might have relationships with others

  #  already selected.

    }

    # Add primary key of parent

    }

  }

}

#' @rdname join_keys

#' @order 2

#'

#' @param directed (`logical(1)`) Flag that indicates whether it should create

#' a parent-child relationship between the datasets.

#'  - `TRUE` (default) `dataset_1` is the parent of `dataset_2`;

#'  - `FALSE` when the relationship is undirected.

#' @section Functions:

#' - `x[i, j] <- value`: Assignment of a key to pair `(i, j)`.

#' - `x[i] <- value`: This (without `j` parameter) **is not** a supported

#' operation for `join_keys`.

#' - `join_keys(x)[i, j] <- value`: Assignment to `join_keys` object stored in `x`,

#' such as a `teal_data` object or `join_keys` object itself.

#'

#' @export

#' @examples

#'

#' # Setting a new primary key ---

#'

#' jk["ds4", "ds4"] <- "pk4"

#' jk["ds5", "ds5"] <- "pk5"

#'

#' # Setting a single relationship pair ---

#'

#' jk["ds1", "ds4"] <- c("pk1" = "pk4")

#'

#' # Removing a key ---

#'

#' jk["ds5", "ds5"] <- NULL

`[<-.join_keys` <- function(x, i, j, directed = TRUE, value) {

  } else if (

    ) ||

      )

  ) {

    )

  }

  # Handle join key removal separately

  }

}

#' @rdname join_keys

#'

#' @order 1000

#' @usage ## Preferred method is x[i, j] <- value

#' x[[i]][[j]] <- value

#'

#' @section Functions:

#' - `x[[i]][[j]] <- value`: It is equivalent as  `x[i, j] <- value`.

#'

#' @export

#' @examples

#'

#' # Setting via x[[i]] <- value ---

#'

#' jk <- join_keys()

#' jk[["ds6"]][["ds6"]] <- "pk6"

#' jk[["ds7"]] <- list(ds7 = "pk7", ds6 = c(pk7 = "pk6"))

#' jk[["ds7"]][["ds7"]] <- NULL # removes key

#'

#' jk

#'

#' @noRd

`[[<-.join_keys` <- function(x, i, value) {

  )

  }

  # Normalize values

  })

  # Check if multiple modifications don't have a conflict

      )

    },

  )

  # Safe to do as duplicated are the same

  # Keep only elements with length > 0L

  # Remove classes to use list-based get/assign operations

  # In case a pair is removed, also remove the symmetric pair and update parents

  }

  # Iterate on all new values to create symmetrical pair

    # Invert key

    # Assign symmetrical

  }

  # Remove NULL or empty keys

  #

  # restore class

}

#' Comprehensive data integration function for `teal` applications

#'

#' @description

#' `r lifecycle::badge("stable")`

#'

#' Universal function to pass data to teal application.

#'

#' @param ... any number of objects (presumably data objects) provided as `name = value` pairs.

#'

#' @param join_keys (`join_keys`) object or a single (`join_key_set`) object.

#'

#'  (optional) object with dataset column relationships used for joining.

#'  If empty then no joins between pairs of objects.

#'

#' @param code (`character`, `language`) optional code to reproduce the datasets provided in `...`.

#'  Note this code is not executed and the `teal_data` may not be reproducible

#'

#' @param check (`logical`) reproducibility check - whether to perform a check that the pre-processing

#'  code included in the object definitions actually produces those objects.

#'  If `check` is true and preprocessing code is empty an error will be thrown.

#'

#' @return A `teal_data` object.

#'

#' @export

#'

#' @examples

#' teal_data(x1 = iris, x2 = mtcars)

#'

teal_data <- function(...,

                      join_keys = teal.data::join_keys(),

                      code = character(0),

                      check = FALSE) {

  }

  if (

    )

  ) {

      )"

    )

  } else {

    }

    )

  }

}

#' Get code from `teal_data` object

#'

#' Retrieve code from `teal_data` object.

#'

#' Retrieve code stored in `@code`, which (in principle) can be used to recreate all objects found in `@env`.

#' Use `datanames` to limit the code to one or more of the datasets enumerated in `@datanames`.

#' If the code has not passed verification (with [`verify()`]), a warning will be prepended.

#'

#' @section Extracting dataset-specific code:

#' When `datanames` is specified, the code returned will be limited  to the lines needed to _create_

#' the requested datasets. The code stored in the `@code` slot is analyzed statically to determine

#' which lines the datasets of interest depend upon. The analysis works well when objects are created

#' with standard infix assignment operators (see `?assignOps`) but it can fail in some situations.

#'

#' Consider the following examples:

#'

#' _Case 1: Usual assignments._

#' ```r

#' data <- teal_data() |>

#'   within({

#'     foo <- function(x) {

#'       x + 1

#'     }

#'     x <- 0

#'     y <- foo(x)

#'   })

#' get_code(data, datanames = "y")

#' ```

#' `x` has no dependencies, so `get_code(data, datanames = "x")` will return only the second call.\cr

#' `y` depends on `x` and `foo`, so `get_code(data, datanames = "y")` will contain all three calls.

#'

#' _Case 2: Some objects are created by a function's side effects._

#' ```r

#' data <- teal_data() |>

#'   within({

#'     foo <- function() {

#'       x <<- x + 1

#'     }

#'     x <- 0

#'     foo()

#'     y <- x

#'   })

#' get_code(data, datanames = "y")

#' ```

#' Here, `y` depends on `x` but `x` is modified by `foo` as a side effect (not by reassignment)

#' and so `get_code(data, datanames = "y")` will not return the `foo()` call.\cr

#' To overcome this limitation, code dependencies can be specified manually.

#' Lines where side effects occur can be flagged by adding "`# @linksto <object name>`" at the end.\cr

#' Note that `within` evaluates code passed to `expr` as is and comments are ignored.

#' In order to include comments in code one must use the `eval_code` function instead.

#'

#' ```r

#' data <- teal_data() |>

#'   eval_code("

#'     foo <- function() {

#'       x <<- x + 1

#'     }

#'     x <- 0

#'     foo() # @linksto x

#'     y <- x

#'   ")

#' get_code(data, datanames = "y")

#' ```

#' Now the `foo()` call will be properly included in the code required to recreate `y`.

#'

#' Note that two functions that create objects as side effects, `assign` and `data`, are handled automatically.

#'

#' Here are known cases where manual tagging is necessary:

#' - non-standard assignment operators, _e.g._ `%<>%`

#' - objects used as conditions in `if` statements: `if (<condition>)`

#' - objects used to iterate over in `for` loops: `for(i in <sequence>)`

#' - creating and evaluating language objects, _e.g._ `eval(<call>)`

#'

#'

#' @param object (`teal_data`)

#' @param datanames `r lifecycle::badge("experimental")` (`character`) vector of dataset names to return the code for.

#' For more details see the "Extracting dataset-specific code" section.

#' @param deparse (`logical`) flag specifying whether to return code as `character` (`deparse = TRUE`) or as

#' `expression` (`deparse = FALSE`).

#'

#' @return

#' Either a character string or an expression. If `datanames` is used to request a specific dataset,

#' only code that _creates_ that dataset (not code that uses it) is returned. Otherwise, all contents of `@code`.

#'

#' @examples

#' tdata1 <- teal_data()

#' tdata1 <- within(tdata1, {