# 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_code_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_code_names = TRUE) {

    }))

    }

  }

  }

}

#' 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 custom assignments operator being treated as assignment.

#'

#' @param exclude (`character`) custom assignment operators to be excluded

#' @keywords internal

#' @noRd

remove_custom_assign <- function(calls, exclude = NULL) {

    } else {

    }

  })

}

#' 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) {

  })

}

#' Execution of assignment operator substitutions for a call.

#' @keywords internal

#' @noRd

sub_arrows <- function(call) {

  )

}

# code_graph ----

#' Extract object occurrence

#'

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

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

#'

#' @param pd `data.frame`;

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

#'  created by `extract_calls()` function

#'

#' @return

#' 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(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.

  }

  }

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

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

  }

    # detect elements appeared in parenthesis and move them on RHS

    # but only their first appearance

    # as the same object can appear as regular object and the one used in parenthesis

      }

    }

  } else {

  }

}

#' Moves function names to the right side of dependency graph

#'

#' Changes status of the function call from dependent to dependency if occurs in the lhs.

#' Technically, it means to move function names after the dependency operator.

#' For example, for `attributes(a) <- b` the dependency graph should look like `c("a", "<-", "b", "attributes")`.

#'

#' @param ans `character` vector of object names in dependency graph.

#' @param functions `character` vector of function names.

#'

#' @return

#' A character vector.

#' @keywords internal

#' @noRd

move_functions_after_arrow <- function(ans, functions) {

  }

  }

  # it's setdiff but without the removal of duplicates

  # do not use setdiff(ans_pre, functions)

  # as it removes duplicates from ans_pre even if they do not appear in functions

  # check setdiff(c("A", "A"), "B") - gives "A", where we want to keep c("A", "A")

  }

  }

}

#' 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 pd `data.frame`;

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

#'  created by `extract_calls()` function

#'

#' @return

#' A character vector of names of objects

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

#'

#' @keywords internal

#' @noRd

extract_side_effects <- function(pd) {

}

#' @param parsed_code results of `parse(text = code, keep.source = TRUE` (parsed text)

#' @keywords internal

#' @noRd

extract_dependency <- function(parsed_code) {

  # Early return on empty code

  }

  }

  # Build queue of expressions to parse individually

  } else {

  }

    } else {

    }

  }

        # extract_calls is needed to reorder the pd so that assignment operator comes before symbol names

        # extract_calls is needed also to substitute assignment operators into specific format with fix_arrows

        # extract_calls is needed to omit empty calls that contain only one token `"';'"`

        # This cleaning is needed as extract_occurrence assumes arrows are fixed, and order is different

        # than in original pd

      }

    }

  )

  # Merge results together

      )

    },

  )

}

# 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) {

  # x occurrences (lhs)

    },

  )

  # x-dependent objects (rhs)

  })

    # track down dependencies and where they occur on the lhs in previous calls

  })

}

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

#' Detect library calls

#'

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

#'

#' @param `graph` the dependency graph, result of `lapply(code, attr, "dependency")`

#'

#' @return

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

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

#'

#' @keywords internal

#' @noRd

detect_libraries <- function(graph) {

        }

      )

    )

  )

}

# utils -----------------------------------------------------------------------------------------------------------

#' Normalize parsed data removing backticks from symbols

#'

#' @param pd `data.frame` resulting from `utils::getParseData()` call.

#'

#' @return `data.frame` with backticks removed from `text` column for `SYMBOL` tokens.

#'

#' @keywords internal

#' @noRd

normalize_pd <- function(pd) {

  # Remove backticks from SYMBOL tokens

}

# split_code ------------------------------------------------------------------------------------------------------

#' Get line/column in the source where the calls end

#'

#'

#' @param code `character(1)`

#'

#' @return `matrix` with `colnames = c("line", "col")`

#'

#' @keywords internal

#' @noRd

get_call_breaks <- function(code) {

    }

  ))

  }

}

#' Split code by calls

#'

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

#'

#' @return list of `character`s of the length equal to the number of calls in `code`.

#'

#' @keywords internal

#' @noRd

split_code <- function(code) {

  }

  )

  )

  # line split happens before call terminator (it could be `;` or `\n`) and the terminator goes to the next line

  # we need to move remove leading and add \n instead when combining calls

}

#' Get code from `qenv`

#'

#' @description

#' Retrieves the code stored in the `qenv`.

#'

#' @param object (`qenv`)

#' @param deparse (`logical(1)`) flag specifying whether to return code as `character` or `expression`.

#' @param ... internal usage, please ignore.

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

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

#'

#' @section Extracting dataset-specific code:

#'

#' `get_code(object, names)` limits the returned code to contain only those lines needed to _create_

#' the requested objects. The code stored in the `qenv` is analyzed statically to determine

#' which lines the objects 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

#' q1 <-

#'   within(qenv(), {

#'     foo <- function(x) {

#'       x + 1

#'     }

#'     x <- 0

#'     y <- foo(x)

#'   })

#' get_code(q1, names = "y")

#' ```

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

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

#'

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

#' ```r

#' q2 <-

#'   within(qenv(){

#'     foo <- function() {

#'       x <<- x + 1

#'     }

#'     x <- 0

#'     foo()

#'     y <- x

#'   })

#' get_code(q2, names = "y")

#' ```

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

#' and so `get_code(data, names = "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

#' q3 <-

#'   eval_code(qenv(), "

#'     foo <- function() {

#'       x <<- x + 1

#'     }

#'     x <- 0

#'     foo() # @linksto x

#'     y <- x

#'   ")

#' get_code(q3, names = "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>)`

#'

#' @return

#' The code used in the `qenv` in the form specified by `deparse`.

#'

#' @examples

#' # retrieve code

#' q <- within(qenv(), {

#'   a <- 1

#'   b <- 2

#' })

#' get_code(q)

#' get_code(q, deparse = FALSE)

#' get_code(q, names = "a")

#'

#' q <- qenv()

#' q <- eval_code(q, code = c("a <- 1", "b <- 2"))

#' get_code(q, names = "a")

#'

#' @aliases get_code,qenv-method

#' @aliases get_code,qenv.error-method

#'

#' @export

setGeneric("get_code", function(object, deparse = TRUE, names = NULL, ...) {

})

setMethod("get_code", signature = "qenv", function(object, deparse = TRUE, names = NULL, ...) {

  # Normalize in case special it is backticked

  }

  } else {

  }

  } else {

  }

})

setMethod("get_code", signature = "qenv.error", function(object, ...) {

      ),

    )

  )

})

#' Display `qenv` object

#'

#' Prints the `qenv` object.

#'

#' @param object (`qenv`)

#'

#' @return `object`, invisibly.

#'

#' @examples

#' q <- qenv()

#' q1 <- eval_code(q, expression(a <- 5, b <- data.frame(x = 1:10)))

#' q1

#'

#' @aliases show-qenv

#'

#' @importFrom methods show

#' @export

setMethod("show", "qenv", function(object) {

      )

    )

  })

        )

      )

    )

  })

})

#' Evaluate code in `qenv`

#'

#' @details

#'

#' `eval_code()` evaluates given code in the `qenv` environment and appends it to the `code` slot.

#' Thus, if the `qenv` had been instantiated empty, contents of the environment are always a result of the stored code.

#'

#' @param object (`qenv`)

#' @param code (`character`, `language` or `expression`) code to evaluate.

#' It is possible to preserve original formatting of the `code` by providing a `character` or an

#' `expression` being a result of `parse(keep.source = TRUE)`.

#' @param ... ([`dots`]) additional arguments passed to future methods.

#'

#' @return

#' `qenv` environment with `code/expr` evaluated or `qenv.error` if evaluation fails.

#'

#' @examples

#' # evaluate code in qenv

#' q <- qenv()

#' q <- eval_code(q, "a <- 1")

#' q <- eval_code(q, "b <- 2L # with comment")

#' q <- eval_code(q, quote(library(checkmate)))

#' q <- eval_code(q, expression(assert_number(a)))

#'

#' @aliases eval_code,qenv-method

#' @aliases eval_code,qenv.error-method

#' @seealso [within.qenv]

#' @export

setMethod("eval_code", signature = c(object = "qenv"), function(object, code, ...) {

  }

  # preprocess code to ensure it is a character vector

})

#' @keywords internal

.eval_code <- function(object, code, ...) {

  }

      }

    }

  )

  )

    } else {

            ),

          )

        )

      }

    }

  }

}

setMethod(".preprocess_code", signature = c("ANY"), function(code) {

  } else {

    )

  }

})

#' Get messages from `qenv` object

#'

#' Retrieve all messages raised during code evaluation in a `qenv`.

#'

#' @param object (`qenv`)

#'

#' @return `character` containing warning information or `NULL` if no messages.

#'

#' @examples

#' data_q <- qenv()

#' data_q <- eval_code(data_q, "iris_data <- iris")

#' warning_qenv <- eval_code(

#'   data_q,

#'   bquote(p <- hist(iris_data[, .("Sepal.Length")], ff = ""))

#' )

#' cat(get_messages(warning_qenv))

#'

#' @name get_messages

#' @rdname get_messages

#' @aliases get_messages,qenv-method

#' @aliases get_messages,qenv.error-method

#' @aliases get_messages,NULL-method

#'

#' @export

setGeneric("get_messages", function(object) {

})

setMethod("get_messages", signature = "qenv", function(object) {

})

setMethod("get_messages", signature = "qenv.error", function(object) {

})

setMethod("get_messages", "NULL", function(object) {

})

#' Join `qenv` objects

#'

#' @description

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

#' Instead of [join()] use [c()].

#'

#' @param ... function is deprecated.

#'

#' @name join

#' @rdname join

#'

#' @export

#' Concatenate two `qenv` objects

#'

#' Combine two `qenv` objects by simple concatenate their environments and the code.

#'

#' We recommend to use the `join` method to have a stricter control

#' in case `x` and `y` contain duplicated bindings and code.

#' RHS argument content has priority over the LHS one.

#'

#' @param x (`qenv`)

#' @param y (`qenv`)

#'

#' @return `qenv` object.

#'

#' @examples

#' q <- qenv()

#' q1 <- eval_code(q, expression(iris1 <- iris, mtcars1 <- mtcars))

#' q2 <- q1

#' q1 <- eval_code(q1, "iris2 <- iris")

#' q2 <- eval_code(q2, "mtcars2 <- mtcars")

#' qq <- concat(q1, q2)

#' get_code(qq)

#'

#' @include qenv-errors.R

#'

#' @name concat

#' @rdname concat

#' @aliases concat,qenv,qenv-method

#' @aliases concat,qenv.error,ANY-method

#' @aliases concat,qenv,qenv.error-method

#'

#' @export

setMethod("concat", signature = c("qenv", "qenv"), function(x, y) {

  # insert (and overwrite) objects from y to x

})

setMethod("concat", signature = c("qenv.error", "ANY"), function(x, y) {

})

setMethod("concat", signature = c("qenv", "qenv.error"), function(x, y) {

})

#' Reproducible class with environment and code

#'

#' Reproducible class with environment and code.

#' @name qenv-class

#' @rdname qenv-class

#' @slot .xData (`environment`) environment with content was generated by the evaluation

#' @slot code (`named list` of `character`) representing code necessary to reproduce the environment.

#' Read more in Code section.

#'  of the `code` slot.

#'

#' @section Code:

#'

#' Each code element is a character representing one call. Each element is named with the random

#' identifier to make sure uniqueness when joining. Each element has possible attributes:

#' - `warnings` (`character`) the warnings output when evaluating the code element.

#' - `messages` (`character`) the messages output when evaluating the code element.

#' - `dependency` (`character`) names of objects that appear in this call and gets affected by this call,

#' separated by `<-` (objects on LHS of `<-` are affected by this line, and objects on RHS are affecting this line).

#'

#' @keywords internal

#' @exportClass qenv

setClass(

  "qenv",

  slots = c(code = "list"),

  contains = "environment"

)

#' It initializes the `qenv` class

#' @noRd

setMethod(

  "initialize",

  "qenv",

  function(.Object, .xData, code = list(), ...) { # nolint: object_name.

    } else {

    }

    # .xData needs to be unnamed as the `.environment` constructor allows at

    # most 1 unnamed formal argument of class `environment`.

    # See methods::findMethods("initialize")$.environment

    )

  }

)

#' It takes a `qenv` class and returns `TRUE` if the input is valid

#' @name qenv-class

#' @keywords internal

setValidity("qenv", function(object) {

  if (any(duplicated(names(object@code)))) {

    "@code must have unique names."

  } else if (!environmentIsLocked(object@.xData)) {

    "@.xData must be locked."

  } else {

    TRUE

  }

})

# needed to handle try-error

setOldClass("qenv.error")

#' @export

as.list.qenv.error <- function(x, ...) {

  ))

}

#' If two `qenv` can be joined

#'

#' Checks if two `qenv` objects can be combined.

#' For more information, please see [`join`]

#' @param x (`qenv`)

#' @param y (`qenv`)

#' @return `TRUE` if able to join or `character` used to print error message.

#' @keywords internal

.check_joinable <- function(x, y) {

      )

    )

  }

  }

  # indices of shared ids should be 1:n in both slots

    )

  } else {

    )

  }

}

#' @rdname join

#' @param ... (`qenv` or `qenv.error`).

#' @examples

#' q <- qenv()

#' q1 <- within(q, {

#'   iris1 <- iris

#'   mtcars1 <- mtcars

#' })

#' q1 <- within(q1, iris2 <- iris)

#' q2 <- within(q1, mtcars2 <- mtcars)

#' qq <- c(q1, q2)

#' cat(get_code(qq))

#'

#' @export

c.qenv <- function(...) {

  }

  }

      # join expressions

      }

      # insert (and overwrite) objects from y to x

    }

  )

}

#' @rdname join

#' @export

c.qenv.error <- function(...) {

}

#' Access environment included in `qenv`

#'

#' The access of environment included in the `qenv` that contains all data objects.

#'

#' @param object (`qenv`).

#'

#' @return An `environment` stored in `qenv` with all data objects.

#'

#' @examples

#' q <- qenv()

#' q1 <- within(q, {

#'   a <- 5

#'   b <- data.frame(x = 1:10)

#' })

#' get_env(q1)

#'

#' @aliases get_env,qenv-method

#' @aliases get_env,qenv.error-method

#'

#' @export

setGeneric("get_env", function(object) {

})

#' Suppresses plot display in the IDE by opening a PDF graphics device

#'

#' This function opens a PDF graphics device using [`grDevices::pdf`] to suppress

#' the plot display in the IDE. The purpose of this function is to avoid opening graphic devices

#' directly in the IDE.

#'

#' @param x lazy binding which generates the plot(s)

#'

#' @details The function uses [`base::on.exit`] to ensure that the PDF graphics

#'          device is closed (using [`grDevices::dev.off`]) when the function exits,

#'          regardless of whether it exits normally or due to an error. This is necessary to

#'          clean up the graphics device properly and avoid any potential issues.

#'

#' @return No return value, called for side effects.

#'

#' @examples

#' dev_suppress(plot(1:10))

#' @export

dev_suppress <- function(x) {

}

#' Separate calls

#'

#' Converts language object or lists of language objects to list of simple calls.

#'

#' @param x `language` object or a list of thereof

#' @return

#' Given a `call`, an `expression`, a list of `call`s or a list of `expression`s, returns a list of `calls`.

#' Symbols and atomic vectors (which may get mixed up in a list) are returned wrapped in list.

#' @examples

#' # use non-exported function from teal.code

#' lang2calls <- getFromNamespace("lang2calls", "teal.code")

#' expr <- expression(

#'   i <- iris,

#'   m <- mtcars

#' )

#' lang2calls(expr)

#' @keywords internal

lang2calls <- function(x) {

  }

    } else {

    }

  } else {

  }

}

#' Obtain warnings or messages from code slot

#'

#' @param object (`qenv`)

#' @param what (`warning` or `message`)

#' @return `character(1)` containing combined message or `NULL` when no warnings/messages

#' @keywords internal

get_warn_message_util <- function(object, what) {

          }

        }

      ))

    }

  )

  }

    }

  )

  )

}

#' Subsets `qenv`

#'

#' @description

#' Subsets [`qenv`] environment and limits the code to the necessary needed to build limited objects.

#'

#' @param x (`qenv`)

#' @param names (`character`) names of objects included in [`qenv`] to subset. Names not present in [`qenv`]

#' are skipped.

#' @param ... internal usage, please ignore.

#'

#' @name subset-qenv

#'

#' @examples

#' q <- qenv()

#' q <- eval_code(q, "a <- 1;b<-2")

#' q["a"]

#' q[c("a", "b")]

#'

#' @export

`[.qenv` <- function(x, names, ...) {

        )

      )

    }

  } else {

      ),

    )

  }

}

#' Get object from `qenv`

#'

#' @description

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

#' Instead of [get_var()] use native \R operators/functions:

#' `x[[name]]`, `x$name` or [get()]:

#'

#' @param ... function is deprecated.

#' @param x (`qenv`)

#' @param i (`character(1)`) variable name.

#'

#' @export

#' @rdname get_var

#' @export

`[[.qenv.error` <- function(x, i) {

  ))

}

#' @export

#' @export

`$.qenv.error` <- function(x, name) {

  # Must allow access of elements in qenv.error object (message, call, trace, ...)

  # Otherwise, it will enter an infinite recursion with the `conditionMessage(x)` call.

  }

  ))

}

#' Evaluate code in `qenv`

#' @details

#' `within()` is a convenience method that wraps `eval_code` to provide a simplified way of passing expression.

#' `within` accepts only inline expressions (both simple and compound) and allows to substitute `expr`

#' with `...` named argument values.

#'

#' @section Using language objects with `within`:

#' Passing language objects to `expr` is generally not intended but can be achieved with `do.call`.

#' Only single `expression`s will work and substitution is not available. See examples.

#'

#' @param data (`qenv`)

#' @param expr (`expression`) to evaluate. Must be inline code, see `Using language objects...`

#' @param ... named argument value will substitute a symbol in the `expr` matched by the name.

#' For practical usage see Examples section below.

#'

#' @examples

#' # evaluate code using within

#' q <- qenv()

#' q <- within(q, {

#'   i <- iris

#' })

#' q <- within(q, {

#'   m <- mtcars

#'   f <- faithful

#' })

#' q

#' get_code(q)

#'

#' # inject values into code

#' q <- qenv()

#' q <- within(q, i <- iris)

#' within(q, print(dim(subset(i, Species == "virginica"))))

#' within(q, print(dim(subset(i, Species == species)))) # fails

#' within(q, print(dim(subset(i, Species == species))), species = "versicolor")

#' species_external <- "versicolor"

#' within(q, print(dim(subset(i, Species == species))), species = species_external)

#'

#' # pass language objects

#' expr <- expression(i <- iris, m <- mtcars)

#' within(q, expr) # fails

#' do.call(within, list(q, expr))

#'

#' exprlist <- list(expression(i <- iris), expression(m <- mtcars))

#' within(q, exprlist) # fails

#' do.call(within, list(q, do.call(c, exprlist)))

#'

#' @export

#'

within.qenv <- function(data, expr, ...) {

  # Inject extra values into expressions.

  )

}

#' @keywords internal

#'

#' @export

within.qenv.error <- function(data, expr, ...) {

}

#' @export

#' @export

#' Instantiates a `qenv` environment

#'

#' @description

#' `r badge("stable")`

#'

#' Instantiates a `qenv` environment.

#'

#' @details

#' `qenv` class has following characteristics:

#'

#' - It inherits from the environment and methods such as [`$`], [get()], [ls()], [as.list()],

#' [parent.env()] work out of the box.

#' - `qenv` is a locked environment, and data modification is only possible through the [eval_code()]

#'   and [within.qenv()] functions.

#' - It stores metadata about the code used to create the data (see [get_code()]).