From bfa8390d9248990f68b8f25e18f01ce8cdc51cf8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 28 Oct 2024 13:29:24 +0000 Subject: [PATCH 01/56] feat: initial support for names(teal_data) --- DESCRIPTION | 1 + NAMESPACE | 4 ++++ R/qenv-eval_code.R | 1 - R/qenv-names.R | 43 +++++++++++++++++++++++++++++++++++++++++++ man/names.qenv.Rd | 40 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 88 insertions(+), 1 deletion(-) create mode 100644 R/qenv-names.R create mode 100644 man/names.qenv.Rd diff --git a/DESCRIPTION b/DESCRIPTION index cfa144a2..1a29d658 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -63,6 +63,7 @@ Collate: 'qenv-get_var.R' 'qenv-get_warnings.R' 'qenv-join.R' + 'qenv-names.R' 'qenv-show.R' 'qenv-within.R' 'teal.code-package.R' diff --git a/NAMESPACE b/NAMESPACE index e2d189a6..38d6372d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,10 @@ # Generated by roxygen2: do not edit by hand S3method("[[",qenv.error) +S3method("names<-",qenv) +S3method("names<-",qenv.error) +S3method(names,qenv) +S3method(names,qenv.error) S3method(within,qenv) S3method(within,qenv.error) export(concat) diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R index 25af3571..a6cbe0dd 100644 --- a/R/qenv-eval_code.R +++ b/R/qenv-eval_code.R @@ -80,7 +80,6 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code } } - object@warnings <- c(object@warnings, current_warnings) object@messages <- c(object@messages, current_messages) diff --git a/R/qenv-names.R b/R/qenv-names.R new file mode 100644 index 00000000..1b4da7d7 --- /dev/null +++ b/R/qenv-names.R @@ -0,0 +1,43 @@ +#' The Names of a `qenv` or `qenv_error` Object +#' +#' Functions to get the names of a `qenv` or `qenv_error` object. +#' The names are extrapolated from the objects in the `qenv` environment and +#' are not stored statically, unlike the normal behavior of `names()` function. +#' +#' Objects named with a `.` (dot) prefix will be ignored and not returned, +#' unless `all.names` parameter is set to `TRUE`. +#' +#' @param x A (`qenv` or `qenv_error`) object. +#' @param all.names (`logical(1)`) that specifies whether to include hidden +#' objects. +#' @param value Does nothing as the names assignment is not supported. +#' +#' @return A character vector of names. +#' +#' @seealso [base::names()] +#' +#' @export +names.qenv <- function(x, all.names = FALSE) { + checkmate::assert_flag(all.names) + ls(get_env(x), all.names = all.names) +} + +#' @rdname names.qenv +#' @export +names.qenv.error <- function(x, all.names = FALSE) { + NULL +} + +#' @rdname names.qenv +#' @export +`names<-.qenv` <- function(x, value) { + warning("`names(x) <- value` assignment does nothing for qenv objects") + x +} + +#' @rdname names.qenv +#' @export +`names<-.qenv.error` <- function(x, value) { + warning("`names(x) <- value` assignment does nothing for qenv.error objects") + x +} diff --git a/man/names.qenv.Rd b/man/names.qenv.Rd new file mode 100644 index 00000000..3a83990b --- /dev/null +++ b/man/names.qenv.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/qenv-names.R +\name{names.qenv} +\alias{names.qenv} +\alias{names.qenv.error} +\alias{names<-.qenv} +\alias{names<-.qenv.error} +\title{The Names of a \code{qenv} or \code{qenv_error} Object} +\usage{ +\method{names}{qenv}(x, all.names = FALSE) + +\method{names}{qenv.error}(x, all.names = FALSE) + +\method{names}{qenv}(x) <- value + +\method{names}{qenv.error}(x) <- value +} +\arguments{ +\item{x}{A (\code{qenv} or \code{qenv_error}) object.} + +\item{all.names}{(\code{logical(1)}) that specifies whether to include hidden +objects.} + +\item{value}{Does nothing as the names assignment is not supported.} +} +\value{ +A character vector of names. +} +\description{ +Functions to get the names of a \code{qenv} or \code{qenv_error} object. +The names are extrapolated from the objects in the \code{qenv} environment and +are not stored statically, unlike the normal behavior of \code{names()} function. +} +\details{ +Objects named with a \code{.} (dot) prefix will be ignored and not returned, +unless \code{all.names} parameter is set to \code{TRUE}. +} +\seealso{ +\code{\link[base:names]{base::names()}} +} From 127bc7ce179f76f52c5c061e97ed364ac79deee1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 28 Oct 2024 17:09:11 +0000 Subject: [PATCH 02/56] docs: update NEWS --- NEWS.md | 1 + tests/testthat/test-qenv_get_code.R | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 1d49c5ba..6b213f81 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ * `get_code()` was extended with `names` parameter and allows the code extraction to be limited to objects stored in `qenv` but limited to `names`. +* Added `names()` support for `qenv` objects that determines dynamically the objects in the environment. # teal.code 0.5.0 diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R index 0f9aedf9..fe908570 100644 --- a/tests/testthat/test-qenv_get_code.R +++ b/tests/testthat/test-qenv_get_code.R @@ -120,7 +120,7 @@ testthat::test_that("extracts the code without downstream usage", { ) }) -testthat::test_that("works for datanames of length > 1", { +testthat::test_that("works for names of length > 1", { code <- c( "a <- 1", "b <- 2" From cb2cc570b0bd029a4ca0b40860b927e01a4d11da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 28 Oct 2024 17:13:08 +0000 Subject: [PATCH 03/56] docs: minor change --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 6b213f81..90f15d2b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,7 @@ * `get_code()` was extended with `names` parameter and allows the code extraction to be limited to objects stored in `qenv` but limited to `names`. -* Added `names()` support for `qenv` objects that determines dynamically the objects in the environment. +* Added `names()` function for `qenv` objects, which dynamically determines the visible objects in the environment. # teal.code 0.5.0 From 72f059511a97710398fef841cb793d5fa3fd7bd3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 28 Oct 2024 17:24:20 +0000 Subject: [PATCH 04/56] fix: warning in R CMD check --- R/qenv-names.R | 28 ++++++++++++++++++++++------ man/names.qenv.Rd | 21 +++++++++++++++++---- 2 files changed, 39 insertions(+), 10 deletions(-) diff --git a/R/qenv-names.R b/R/qenv-names.R index 1b4da7d7..17833b3a 100644 --- a/R/qenv-names.R +++ b/R/qenv-names.R @@ -8,23 +8,39 @@ #' unless `all.names` parameter is set to `TRUE`. #' #' @param x A (`qenv` or `qenv_error`) object. -#' @param all.names (`logical(1)`) that specifies whether to include hidden -#' objects. +#' @param ... Additional parameters to this function, allowed parameters: +#' +#' - `all.names`: (`logical(1)`)that specifies whether to include hidden objects. #' @param value Does nothing as the names assignment is not supported. #' #' @return A character vector of names. #' #' @seealso [base::names()] #' +#' @examples +#' q1 <- within(qenv(), iris <- iris) +#' names(q1) +#' +#' q2 <- within(q1, { +#' mtcars <- mtcars +#' CO2 <- CO2 +#' }) +#' names(q2) +#' #' @export -names.qenv <- function(x, all.names = FALSE) { - checkmate::assert_flag(all.names) - ls(get_env(x), all.names = all.names) +names.qenv <- function(x, ...) { + dots <- rlang::list2(...) + if (length(setdiff(names(dots), "all.names")) > 0) { + stop("Only `x` and 'all.names' parameter are allowed") + } + checkmate::assert_flag(dots[["all.names"]], .var.name = "all.names", null.ok = TRUE) + if (is.null(dots[["all.names"]])) dots[["all.names"]] <- FALSE + ls(get_env(x), all.names = dots[["all.names"]]) } #' @rdname names.qenv #' @export -names.qenv.error <- function(x, all.names = FALSE) { +names.qenv.error <- function(x) { NULL } diff --git a/man/names.qenv.Rd b/man/names.qenv.Rd index 3a83990b..c89e53a0 100644 --- a/man/names.qenv.Rd +++ b/man/names.qenv.Rd @@ -7,9 +7,9 @@ \alias{names<-.qenv.error} \title{The Names of a \code{qenv} or \code{qenv_error} Object} \usage{ -\method{names}{qenv}(x, all.names = FALSE) +\method{names}{qenv}(x, ...) -\method{names}{qenv.error}(x, all.names = FALSE) +\method{names}{qenv.error}(x) \method{names}{qenv}(x) <- value @@ -18,8 +18,10 @@ \arguments{ \item{x}{A (\code{qenv} or \code{qenv_error}) object.} -\item{all.names}{(\code{logical(1)}) that specifies whether to include hidden -objects.} +\item{...}{Additional parameters to this function, allowed parameters: +\itemize{ +\item \code{all.names}: (\code{logical(1)})that specifies whether to include hidden objects. +}} \item{value}{Does nothing as the names assignment is not supported.} } @@ -34,6 +36,17 @@ are not stored statically, unlike the normal behavior of \code{names()} function \details{ Objects named with a \code{.} (dot) prefix will be ignored and not returned, unless \code{all.names} parameter is set to \code{TRUE}. +} +\examples{ +q1 <- within(qenv(), iris <- iris) +names(q1) + +q2 <- within(q1, { + mtcars <- mtcars + CO2 <- CO2 +}) +names(q2) + } \seealso{ \code{\link[base:names]{base::names()}} From 9a6343a7234936157e04dc7989b016e3e437d901 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 28 Oct 2024 17:24:49 +0000 Subject: [PATCH 05/56] docs: typo --- R/qenv-names.R | 2 +- man/names.qenv.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/qenv-names.R b/R/qenv-names.R index 17833b3a..f3af2929 100644 --- a/R/qenv-names.R +++ b/R/qenv-names.R @@ -10,7 +10,7 @@ #' @param x A (`qenv` or `qenv_error`) object. #' @param ... Additional parameters to this function, allowed parameters: #' -#' - `all.names`: (`logical(1)`)that specifies whether to include hidden objects. +#' - `all.names`: (`logical(1)`) that specifies whether to include hidden objects. #' @param value Does nothing as the names assignment is not supported. #' #' @return A character vector of names. diff --git a/man/names.qenv.Rd b/man/names.qenv.Rd index c89e53a0..b04dc34b 100644 --- a/man/names.qenv.Rd +++ b/man/names.qenv.Rd @@ -20,7 +20,7 @@ \item{...}{Additional parameters to this function, allowed parameters: \itemize{ -\item \code{all.names}: (\code{logical(1)})that specifies whether to include hidden objects. +\item \code{all.names}: (\code{logical(1)}) that specifies whether to include hidden objects. }} \item{value}{Does nothing as the names assignment is not supported.} From e1a69b3c4fb29e64bd1bafd67a94920ba8d85915 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 28 Oct 2024 17:40:30 +0000 Subject: [PATCH 06/56] fix: remove implementation of names()<- as error message is self explanatory --- NAMESPACE | 2 -- R/qenv-names.R | 17 +---------------- _pkgdown.yml | 1 + inst/WORDLIST | 5 +++-- man/names.qenv.Rd | 10 +--------- 5 files changed, 6 insertions(+), 29 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 38d6372d..82374c71 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,6 @@ # Generated by roxygen2: do not edit by hand S3method("[[",qenv.error) -S3method("names<-",qenv) -S3method("names<-",qenv.error) S3method(names,qenv) S3method(names,qenv.error) S3method(within,qenv) diff --git a/R/qenv-names.R b/R/qenv-names.R index f3af2929..62477886 100644 --- a/R/qenv-names.R +++ b/R/qenv-names.R @@ -7,11 +7,10 @@ #' Objects named with a `.` (dot) prefix will be ignored and not returned, #' unless `all.names` parameter is set to `TRUE`. #' -#' @param x A (`qenv` or `qenv_error`) object. +#' @param x (`qenv` or `qenv_error`) object. #' @param ... Additional parameters to this function, allowed parameters: #' #' - `all.names`: (`logical(1)`) that specifies whether to include hidden objects. -#' @param value Does nothing as the names assignment is not supported. #' #' @return A character vector of names. #' @@ -43,17 +42,3 @@ names.qenv <- function(x, ...) { names.qenv.error <- function(x) { NULL } - -#' @rdname names.qenv -#' @export -`names<-.qenv` <- function(x, value) { - warning("`names(x) <- value` assignment does nothing for qenv objects") - x -} - -#' @rdname names.qenv -#' @export -`names<-.qenv.error` <- function(x, value) { - warning("`names(x) <- value` assignment does nothing for qenv.error objects") - x -} diff --git a/_pkgdown.yml b/_pkgdown.yml index 3b151760..f9d24965 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -34,6 +34,7 @@ reference: - get_var - get_warnings - join + - names.qenv - new_qenv - qenv - show,qenv-method diff --git a/inst/WORDLIST b/inst/WORDLIST index 44b9561f..32d9f8ae 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,7 +1,8 @@ Forkers -Hoffmann -Reproducibility funder +Hoffmann +Paremeter qenv repo +Reproducibility reproducibility diff --git a/man/names.qenv.Rd b/man/names.qenv.Rd index b04dc34b..42b55240 100644 --- a/man/names.qenv.Rd +++ b/man/names.qenv.Rd @@ -3,27 +3,19 @@ \name{names.qenv} \alias{names.qenv} \alias{names.qenv.error} -\alias{names<-.qenv} -\alias{names<-.qenv.error} \title{The Names of a \code{qenv} or \code{qenv_error} Object} \usage{ \method{names}{qenv}(x, ...) \method{names}{qenv.error}(x) - -\method{names}{qenv}(x) <- value - -\method{names}{qenv.error}(x) <- value } \arguments{ -\item{x}{A (\code{qenv} or \code{qenv_error}) object.} +\item{x}{(\code{qenv} or \code{qenv_error}) object.} \item{...}{Additional parameters to this function, allowed parameters: \itemize{ \item \code{all.names}: (\code{logical(1)}) that specifies whether to include hidden objects. }} - -\item{value}{Does nothing as the names assignment is not supported.} } \value{ A character vector of names. From c335f52fede26447f16f7631e2c0e1136a0eb3c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 28 Oct 2024 18:07:42 +0000 Subject: [PATCH 07/56] fix: remove extra arguments for names, not supported --- R/qenv-names.R | 17 +++-------------- man/names.qenv.Rd | 10 ++-------- 2 files changed, 5 insertions(+), 22 deletions(-) diff --git a/R/qenv-names.R b/R/qenv-names.R index 62477886..8849a0b0 100644 --- a/R/qenv-names.R +++ b/R/qenv-names.R @@ -4,14 +4,9 @@ #' The names are extrapolated from the objects in the `qenv` environment and #' are not stored statically, unlike the normal behavior of `names()` function. #' -#' Objects named with a `.` (dot) prefix will be ignored and not returned, -#' unless `all.names` parameter is set to `TRUE`. +#' Objects named with a `.` (dot) prefix will be ignored and not returned. #' #' @param x (`qenv` or `qenv_error`) object. -#' @param ... Additional parameters to this function, allowed parameters: -#' -#' - `all.names`: (`logical(1)`) that specifies whether to include hidden objects. -#' #' @return A character vector of names. #' #' @seealso [base::names()] @@ -27,14 +22,8 @@ #' names(q2) #' #' @export -names.qenv <- function(x, ...) { - dots <- rlang::list2(...) - if (length(setdiff(names(dots), "all.names")) > 0) { - stop("Only `x` and 'all.names' parameter are allowed") - } - checkmate::assert_flag(dots[["all.names"]], .var.name = "all.names", null.ok = TRUE) - if (is.null(dots[["all.names"]])) dots[["all.names"]] <- FALSE - ls(get_env(x), all.names = dots[["all.names"]]) +names.qenv <- function(x) { + ls(get_env(x)) } #' @rdname names.qenv diff --git a/man/names.qenv.Rd b/man/names.qenv.Rd index 42b55240..77b94345 100644 --- a/man/names.qenv.Rd +++ b/man/names.qenv.Rd @@ -5,17 +5,12 @@ \alias{names.qenv.error} \title{The Names of a \code{qenv} or \code{qenv_error} Object} \usage{ -\method{names}{qenv}(x, ...) +\method{names}{qenv}(x) \method{names}{qenv.error}(x) } \arguments{ \item{x}{(\code{qenv} or \code{qenv_error}) object.} - -\item{...}{Additional parameters to this function, allowed parameters: -\itemize{ -\item \code{all.names}: (\code{logical(1)}) that specifies whether to include hidden objects. -}} } \value{ A character vector of names. @@ -26,8 +21,7 @@ The names are extrapolated from the objects in the \code{qenv} environment and are not stored statically, unlike the normal behavior of \code{names()} function. } \details{ -Objects named with a \code{.} (dot) prefix will be ignored and not returned, -unless \code{all.names} parameter is set to \code{TRUE}. +Objects named with a \code{.} (dot) prefix will be ignored and not returned. } \examples{ q1 <- within(qenv(), iris <- iris) From 873a1b61acc821f2ac767ce8bedb1d47b5f3b3f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 28 Oct 2024 21:33:08 +0000 Subject: [PATCH 08/56] fix: remove extra word from wordlist --- inst/WORDLIST | 1 - 1 file changed, 1 deletion(-) diff --git a/inst/WORDLIST b/inst/WORDLIST index 32d9f8ae..4cce4b1d 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,7 +1,6 @@ Forkers funder Hoffmann -Paremeter qenv repo Reproducibility From a203f8117ac530d29af3cf4864bbbb9f8bf1346c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 29 Oct 2024 15:42:46 +0000 Subject: [PATCH 09/56] feat: `qenv` inherits from environment class --- NAMESPACE | 2 -- R/qenv-class.R | 15 ++++++++-- R/qenv-concat.R | 4 +-- R/qenv-constructor.R | 8 ++++-- R/qenv-eval_code.R | 10 +++---- R/qenv-get_env.R | 2 +- R/qenv-get_var.R | 2 +- R/qenv-join.R | 8 +++--- R/qenv-names.R | 33 ---------------------- R/qenv-show.R | 2 +- man/names.qenv.Rd | 39 -------------------------- tests/testthat/test-qenv_concat.R | 4 +-- tests/testthat/test-qenv_constructor.R | 33 +++++++++++++++++----- tests/testthat/test-qenv_eval_code.R | 21 ++++++++------ tests/testthat/test-qenv_join.R | 10 +++---- tests/testthat/test-qenv_within.R | 6 ++-- 16 files changed, 80 insertions(+), 119 deletions(-) delete mode 100644 R/qenv-names.R delete mode 100644 man/names.qenv.Rd diff --git a/NAMESPACE b/NAMESPACE index 82374c71..e2d189a6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,6 @@ # Generated by roxygen2: do not edit by hand S3method("[[",qenv.error) -S3method(names,qenv) -S3method(names,qenv.error) S3method(within,qenv) S3method(within,qenv.error) export(concat) diff --git a/R/qenv-class.R b/R/qenv-class.R index d2a679bc..a0b15b75 100644 --- a/R/qenv-class.R +++ b/R/qenv-class.R @@ -14,10 +14,19 @@ #' @exportClass qenv setClass( "qenv", - slots = c(env = "environment", code = "character", id = "integer", warnings = "character", messages = "character"), + slots = c( + code = "character", + id = "integer", + warnings = "character", + messages = "character" + ), + contains = "environment", prototype = list( - env = new.env(parent = parent.env(.GlobalEnv)), code = character(0), id = integer(0), - warnings = character(0), messages = character(0) + .xData = new.env(parent = parent.env(.GlobalEnv)), + code = character(0), + id = integer(0), + warnings = character(0), + messages = character(0) ) ) diff --git a/R/qenv-concat.R b/R/qenv-concat.R index cc9f5ed2..c5c1bd31 100644 --- a/R/qenv-concat.R +++ b/R/qenv-concat.R @@ -38,8 +38,8 @@ setMethod("concat", signature = c("qenv", "qenv"), function(x, y) { y@messages <- c(x@messages, y@messages) # insert (and overwrite) objects from y to x - y@env <- rlang::env_clone(y@env, parent = parent.env(.GlobalEnv)) - rlang::env_coalesce(env = y@env, from = x@env) + y@.xData <- rlang::env_clone(y@.xData, parent = parent.env(.GlobalEnv)) + rlang::env_coalesce(env = y@.xData, from = x@.xData) y }) diff --git a/R/qenv-constructor.R b/R/qenv-constructor.R index fa2fa333..7215d1e5 100644 --- a/R/qenv-constructor.R +++ b/R/qenv-constructor.R @@ -25,7 +25,7 @@ qenv <- function() { q_env <- new.env(parent = parent.env(.GlobalEnv)) lockEnvironment(q_env, bindings = TRUE) - methods::new("qenv", env = q_env) + methods::new("qenv", .xData = q_env) } @@ -73,7 +73,11 @@ setMethod( id <- sample.int(.Machine$integer.max, size = length(code)) methods::new( "qenv", - env = new_env, code = code, warnings = rep("", length(code)), messages = rep("", length(code)), id = id + .xData = new_env, + code = code, + warnings = rep("", length(code)), + messages = rep("", length(code)), + id = id ) } ) diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R index a6cbe0dd..5657c520 100644 --- a/R/qenv-eval_code.R +++ b/R/qenv-eval_code.R @@ -31,7 +31,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code id <- sample.int(.Machine$integer.max, size = 1) object@id <- c(object@id, id) - object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv)) + object@.xData <- rlang::env_clone(object@.xData, parent = parent.env(.GlobalEnv)) code <- paste(code, collapse = "\n") object@code <- c(object@code, code) @@ -45,11 +45,11 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code x <- withCallingHandlers( tryCatch( { - eval(single_call, envir = object@env) - if (!identical(parent.env(object@env), parent.env(.GlobalEnv))) { + eval(single_call, envir = object@.xData) + if (!identical(parent.env(object@.xData), parent.env(.GlobalEnv))) { # needed to make sure that @env is always a sibling of .GlobalEnv # could be changed when any new package is added to search path (through library or require call) - parent.env(object@env) <- parent.env(.GlobalEnv) + parent.env(object@.xData) <- parent.env(.GlobalEnv) } NULL }, @@ -83,7 +83,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code object@warnings <- c(object@warnings, current_warnings) object@messages <- c(object@messages, current_messages) - lockEnvironment(object@env, bindings = TRUE) + lockEnvironment(object@.xData, bindings = TRUE) object }) diff --git a/R/qenv-get_env.R b/R/qenv-get_env.R index 0d8074b9..bbb2e03f 100644 --- a/R/qenv-get_env.R +++ b/R/qenv-get_env.R @@ -24,7 +24,7 @@ setGeneric("get_env", function(object) { }) setMethod("get_env", "qenv", function(object) { - object@env + object@.xData }) setMethod("get_env", "qenv.error", function(object) { diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index 152b67a4..31e11dd3 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -28,7 +28,7 @@ setGeneric("get_var", function(object, var) { setMethod("get_var", signature = c("qenv", "character"), function(object, var) { tryCatch( - get(var, envir = object@env, inherits = FALSE), + get(var, envir = object@.xData, inherits = FALSE), error = function(e) { message(conditionMessage(e)) NULL diff --git a/R/qenv-join.R b/R/qenv-join.R index f644223a..e3545091 100644 --- a/R/qenv-join.R +++ b/R/qenv-join.R @@ -150,8 +150,8 @@ setMethod("join", signature = c("qenv", "qenv"), function(x, y) { x@messages <- c(x@messages, y@messages[id_unique]) # insert (and overwrite) objects from y to x - x@env <- rlang::env_clone(x@env, parent = parent.env(.GlobalEnv)) - rlang::env_coalesce(env = x@env, from = y@env) + x@.xData <- rlang::env_clone(x@.xData, parent = parent.env(.GlobalEnv)) + rlang::env_coalesce(env = x@.xData, from = y@.xData) x }) @@ -175,9 +175,9 @@ setMethod("join", signature = c("qenv.error", "ANY"), function(x, y) { checkmate::assert_class(x, "qenv") checkmate::assert_class(y, "qenv") - common_names <- intersect(rlang::env_names(x@env), rlang::env_names(y@env)) + common_names <- intersect(rlang::env_names(x@.xData), rlang::env_names(y@.xData)) is_overwritten <- vapply(common_names, function(el) { - !identical(get(el, x@env), get(el, y@env)) + !identical(get(el, x@.xData), get(el, y@.xData)) }, logical(1)) if (any(is_overwritten)) { return( diff --git a/R/qenv-names.R b/R/qenv-names.R deleted file mode 100644 index 8849a0b0..00000000 --- a/R/qenv-names.R +++ /dev/null @@ -1,33 +0,0 @@ -#' The Names of a `qenv` or `qenv_error` Object -#' -#' Functions to get the names of a `qenv` or `qenv_error` object. -#' The names are extrapolated from the objects in the `qenv` environment and -#' are not stored statically, unlike the normal behavior of `names()` function. -#' -#' Objects named with a `.` (dot) prefix will be ignored and not returned. -#' -#' @param x (`qenv` or `qenv_error`) object. -#' @return A character vector of names. -#' -#' @seealso [base::names()] -#' -#' @examples -#' q1 <- within(qenv(), iris <- iris) -#' names(q1) -#' -#' q2 <- within(q1, { -#' mtcars <- mtcars -#' CO2 <- CO2 -#' }) -#' names(q2) -#' -#' @export -names.qenv <- function(x) { - ls(get_env(x)) -} - -#' @rdname names.qenv -#' @export -names.qenv.error <- function(x) { - NULL -} diff --git a/R/qenv-show.R b/R/qenv-show.R index a2576f38..b2fa7447 100644 --- a/R/qenv-show.R +++ b/R/qenv-show.R @@ -16,5 +16,5 @@ #' @importFrom methods show #' @export setMethod("show", "qenv", function(object) { - rlang::env_print(object@env) + rlang::env_print(object@.xData) }) diff --git a/man/names.qenv.Rd b/man/names.qenv.Rd deleted file mode 100644 index 77b94345..00000000 --- a/man/names.qenv.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/qenv-names.R -\name{names.qenv} -\alias{names.qenv} -\alias{names.qenv.error} -\title{The Names of a \code{qenv} or \code{qenv_error} Object} -\usage{ -\method{names}{qenv}(x) - -\method{names}{qenv.error}(x) -} -\arguments{ -\item{x}{(\code{qenv} or \code{qenv_error}) object.} -} -\value{ -A character vector of names. -} -\description{ -Functions to get the names of a \code{qenv} or \code{qenv_error} object. -The names are extrapolated from the objects in the \code{qenv} environment and -are not stored statically, unlike the normal behavior of \code{names()} function. -} -\details{ -Objects named with a \code{.} (dot) prefix will be ignored and not returned. -} -\examples{ -q1 <- within(qenv(), iris <- iris) -names(q1) - -q2 <- within(q1, { - mtcars <- mtcars - CO2 <- CO2 -}) -names(q2) - -} -\seealso{ -\code{\link[base:names]{base::names()}} -} diff --git a/tests/testthat/test-qenv_concat.R b/tests/testthat/test-qenv_concat.R index c7b55739..c4d5bf6a 100644 --- a/tests/testthat/test-qenv_concat.R +++ b/tests/testthat/test-qenv_concat.R @@ -5,7 +5,7 @@ testthat::test_that("Concatenate two identical qenvs outputs", { q12 <- concat(q1, q2) - testthat::expect_equal(q12@env, q1@env) + testthat::expect_equal(q12@.xData, q1@.xData) testthat::expect_identical( q12@code, c("iris1 <- iris", "iris1 <- iris") @@ -21,7 +21,7 @@ testthat::test_that("Concatenate two independent qenvs results in object having q12 <- concat(q1, q2) - testthat::expect_equal(q12@env, list2env(list(iris1 = iris, mtcars1 = mtcars))) + testthat::expect_equal(q12@.xData, list2env(list(iris1 = iris, mtcars1 = mtcars))) testthat::expect_identical( q12@code, c("iris1 <- iris", "mtcars1 <- mtcars") diff --git a/tests/testthat/test-qenv_constructor.R b/tests/testthat/test-qenv_constructor.R index 20bec3dc..345baae3 100644 --- a/tests/testthat/test-qenv_constructor.R +++ b/tests/testthat/test-qenv_constructor.R @@ -1,19 +1,38 @@ +testthat::test_that("constructor returns qenv that inherits from environment", { + testthat::expect_true(is.environment(qenv())) +}) + testthat::test_that("constructor returns qenv", { q <- qenv() testthat::expect_s4_class(q, "qenv") - testthat::expect_identical(ls(q@env), character(0)) + testthat::expect_identical(ls(q, all.names = TRUE), character(0)) + testthat::expect_identical(ls(q@.xData, all.names = TRUE), character(0)) testthat::expect_identical(q@code, character(0)) testthat::expect_identical(q@id, integer(0)) testthat::expect_identical(q@warnings, character(0)) testthat::expect_identical(q@messages, character(0)) }) -testthat::test_that("parent of qenv environment is the parent of .GlobalEnv", { - q <- qenv() - testthat::expect_identical(parent.env(q@env), parent.env(.GlobalEnv)) +testthat::describe("parent of qenv environment is the parent of .GlobalEnv", { + testthat::it("via slot", { + q <- qenv() + testthat::expect_identical(parent.env(q@.xData), parent.env(.GlobalEnv)) + }) + + testthat::it("via qenv directly", { + q <- qenv() + testthat::expect_identical(parent.env(q), parent.env(.GlobalEnv)) + }) }) -testthat::test_that("parent of qenv environment is locked", { - q <- qenv() - testthat::expect_error(q@env$x <- 1, "cannot add bindings to a locked environment") +testthat::describe("qenv environment is locked", { + testthat::it("via slot", { + q <- qenv() + testthat::expect_error(q@.xData$x <- 1, "cannot add bindings to a locked environment") + }) + + testthat::it("via qenv directly", { + q <- qenv() + testthat::expect_error(q$x <- 1, "cannot add bindings to a locked environment") + }) }) diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R index 12a2a7a0..f7c018fc 100644 --- a/tests/testthat/test-qenv_eval_code.R +++ b/tests/testthat/test-qenv_eval_code.R @@ -15,14 +15,14 @@ testthat::test_that("eval_code doesn't have access to environment where it's cal ) }) -testthat::test_that("@env in qenv is always a sibling of .GlobalEnv", { +testthat::test_that("@.xData in qenv is always a sibling of .GlobalEnv", { q1 <- qenv() - testthat::expect_identical(parent.env(q1@env), parent.env(.GlobalEnv)) + testthat::expect_identical(parent.env(q1@.xData), parent.env(.GlobalEnv)) q2 <- eval_code(q1, quote(a <- 1L)) - testthat::expect_identical(parent.env(q2@env), parent.env(.GlobalEnv)) + testthat::expect_identical(parent.env(q2@.xData), parent.env(.GlobalEnv)) q3 <- eval_code(q2, quote(b <- 2L)) - testthat::expect_identical(parent.env(q3@env), parent.env(.GlobalEnv)) + testthat::expect_identical(parent.env(q3@.xData), parent.env(.GlobalEnv)) }) testthat::test_that("getting object from the package namespace works even if library in the same call", { @@ -42,21 +42,21 @@ testthat::test_that("eval_code works with character", { q1 <- eval_code(qenv(), "a <- 1") testthat::expect_identical(q1@code, "a <- 1") - testthat::expect_equal(q1@env, list2env(list(a = 1))) + testthat::expect_equal(q1@.xData, list2env(list(a = 1))) }) testthat::test_that("eval_code works with expression", { q1 <- eval_code(qenv(), as.expression(quote(a <- 1))) testthat::expect_identical(q1@code, "a <- 1") - testthat::expect_equal(q1@env, list2env(list(a = 1))) + testthat::expect_equal(q1@.xData, list2env(list(a = 1))) }) testthat::test_that("eval_code works with quoted", { q1 <- eval_code(qenv(), quote(a <- 1)) testthat::expect_identical(q1@code, "a <- 1") - testthat::expect_equal(q1@env, list2env(list(a = 1))) + testthat::expect_equal(q1@.xData, list2env(list(a = 1))) }) testthat::test_that("eval_code works with quoted code block", { @@ -72,11 +72,14 @@ testthat::test_that("eval_code works with quoted code block", { q1@code, "a <- 1\nb <- 2" ) - testthat::expect_equal(q1@env, list2env(list(a = 1, b = 2))) + testthat::expect_equal(q1@.xData, list2env(list(a = 1, b = 2))) }) testthat::test_that("eval_code fails with unquoted expression", { - testthat::expect_error(eval_code(qenv(), a <- b), "object 'b' not found") + withr::with_environment( + env = baseenv(), , + code = testthat::expect_error(eval_code(qenv(), a <- b), "object 'b' not found") + ) }) testthat::test_that("an error when calling eval_code returns a qenv.error object which has message and trace", { diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R index fdc218d8..890c0f3a 100644 --- a/tests/testthat/test-qenv_join.R +++ b/tests/testthat/test-qenv_join.R @@ -5,7 +5,7 @@ testthat::test_that("Joining two identical qenvs outputs the same object", { testthat::expect_true(.check_joinable(q1, q2)) q <- join(q1, q2) - testthat::expect_equal(q@env, q1@env) + testthat::expect_equal(q@.xData, q1@.xData) testthat::expect_identical(q@code, "iris1 <- iris") testthat::expect_identical(q@id, q1@id) }) @@ -17,7 +17,7 @@ testthat::test_that("Joining two independent qenvs results in object having comb testthat::expect_true(.check_joinable(q1, q2)) q <- join(q1, q2) - testthat::expect_equal(q@env, list2env(list(iris1 = iris, mtcars1 = mtcars))) + testthat::expect_equal(q@.xData, list2env(list(iris1 = iris, mtcars1 = mtcars))) testthat::expect_identical( q@code, c("iris1 <- iris", "mtcars1 <- mtcars") @@ -68,7 +68,7 @@ testthat::test_that("join does not duplicate code but adds only extra code", { ) testthat::expect_equal( - as.list(q@env), + as.list(q@.xData), list(iris1 = iris, iris2 = iris, mtcars1 = mtcars, mtcars2 = mtcars) ) @@ -95,7 +95,7 @@ testthat::test_that("qenv objects are mergeable if they don't share any code (id cq <- join(q1, q2) testthat::expect_s4_class(cq, "qenv") - testthat::expect_equal(cq@env, list2env(list(a1 = 1))) + testthat::expect_equal(cq@.xData, list2env(list(a1 = 1))) testthat::expect_identical(cq@code, c("a1 <- 1", "a1 <- 1")) testthat::expect_identical(cq@id, c(q1@id, q2@id)) }) @@ -108,7 +108,7 @@ testthat::test_that("qenv objects are mergeable if they share common initial qen cq <- join(q1, q2) testthat::expect_s4_class(cq, "qenv") - testthat::expect_equal(cq@env, list2env(list(a1 = 1, b1 = 2, a2 = 3))) + testthat::expect_equal(cq@.xData, list2env(list(a1 = 1, b1 = 2, a2 = 3))) testthat::expect_identical( cq@code, c("a1 <- 1", "a2 <- 3", "b1 <- 2") diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R index 6073d80b..49a9c8f0 100644 --- a/tests/testthat/test-qenv_within.R +++ b/tests/testthat/test-qenv_within.R @@ -54,12 +54,12 @@ testthat::test_that("styling of input code does not impact evaluation results", # return value ---- -testthat::test_that("within.qenv renturns a `qenv` where `@env` is a deep copy of that in `data`", { +testthat::test_that("within.qenv renturns a `qenv` where `@.xData` is a deep copy of that in `data`", { q <- qenv() q <- within(qenv(), i <- iris) qq <- within(q, {}) - testthat::expect_equal(q@env, qq@env) - testthat::expect_false(identical(q@env, qq@env)) + testthat::expect_equal(q@.xData, qq@.xData) + testthat::expect_false(identical(q@.xData, qq@.xData)) }) testthat::test_that("within.qenv renturns qenv.error even if evaluation raises error", { From 8b855f3857fe9c17d46c9ccfcb9d696f4d6ea99b Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Tue, 29 Oct 2024 15:45:36 +0000 Subject: [PATCH 10/56] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update --- DESCRIPTION | 1 - 1 file changed, 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 57291509..9b465772 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -63,7 +63,6 @@ Collate: 'qenv-get_var.R' 'qenv-get_warnings.R' 'qenv-join.R' - 'qenv-names.R' 'qenv-show.R' 'qenv-within.R' 'teal.code-package.R' From 4efca242d9615bfe05f679d3788d1cdc89415edc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 29 Oct 2024 16:56:19 +0000 Subject: [PATCH 11/56] fix: improves tests and adds $ getter to qenv.error with similar behavior to [[ --- NAMESPACE | 1 + R/qenv-get_var.R | 15 +++++++ tests/testthat/test-qenv_constructor.R | 55 ++++++++++++++++++++------ tests/testthat/test-qenv_eval_code.R | 6 +-- tests/testthat/test-qenv_get_var.R | 30 ++++++++++++-- 5 files changed, 86 insertions(+), 21 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e2d189a6..e9c9e34c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method("$",qenv.error) S3method("[[",qenv.error) S3method(within,qenv) S3method(within,qenv.error) diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index 31e11dd3..c295208a 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -55,3 +55,18 @@ setMethod("[[", signature = c("qenv", "ANY"), function(x, i) { class = c("validation", "try-error", "simpleError") )) } + +#' @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. + result <- NextMethod("$", x) + if (is.null(result)) { + class(x) <- setdiff(class(x), "qenv.error") + stop(errorCondition( + list(message = conditionMessage(x)), + class = c("validation", "try-error", "simpleError") + )) + } + result +} diff --git a/tests/testthat/test-qenv_constructor.R b/tests/testthat/test-qenv_constructor.R index 345baae3..9721b06b 100644 --- a/tests/testthat/test-qenv_constructor.R +++ b/tests/testthat/test-qenv_constructor.R @@ -1,11 +1,47 @@ -testthat::test_that("constructor returns qenv that inherits from environment", { - testthat::expect_true(is.environment(qenv())) +testthat::describe("qenv inherits from environment: ", { + testthat::it("is an environment", { + testthat::expect_true(is.environment(qenv())) + }) + + testthat::it("ls() shows nothing on empty environment", { + testthat::expect_identical(ls(qenv(), all.names = TRUE), character(0)) + }) + + testthat::it("ls() shows available objets", { + q <- within(qenv(), iris <- iris) + testthat::expect_setequal(ls(q), "iris") + }) + + testthat::it("ls() does not show hidden objects", { + q <- within(qenv(), { + iris <- iris + .hidden <- 2 + }) + testthat::expect_setequal(ls(q), "iris") + }) + + testthat::it("names() show all objects", { + q <- eval_code(qenv(), " + iris <- iris + .hidden <- 2 + ") + testthat::expect_setequal(names(q), c("iris", ".hidden")) + }) + + testthat::it("does not allow binding to be added", { + q <- qenv() + testthat::expect_error(q$x <- 1, "cannot add bindings to a locked environment") + }) + + testthat::it("does not allow binding to be modified", { + q <- within(qenv(), obj <- 1) + testthat::expect_error(q$obj <- 2, "cannot change value of locked binding for 'obj'") + }) }) testthat::test_that("constructor returns qenv", { q <- qenv() testthat::expect_s4_class(q, "qenv") - testthat::expect_identical(ls(q, all.names = TRUE), character(0)) testthat::expect_identical(ls(q@.xData, all.names = TRUE), character(0)) testthat::expect_identical(q@code, character(0)) testthat::expect_identical(q@id, integer(0)) @@ -25,14 +61,7 @@ testthat::describe("parent of qenv environment is the parent of .GlobalEnv", { }) }) -testthat::describe("qenv environment is locked", { - testthat::it("via slot", { - q <- qenv() - testthat::expect_error(q@.xData$x <- 1, "cannot add bindings to a locked environment") - }) - - testthat::it("via qenv directly", { - q <- qenv() - testthat::expect_error(q$x <- 1, "cannot add bindings to a locked environment") - }) +testthat::test_that("qenv environment is locked", { + q <- qenv() + testthat::expect_error(q@.xData$x <- 1, "cannot add bindings to a locked environment") }) diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R index f7c018fc..b0bf71e3 100644 --- a/tests/testthat/test-qenv_eval_code.R +++ b/tests/testthat/test-qenv_eval_code.R @@ -76,10 +76,8 @@ testthat::test_that("eval_code works with quoted code block", { }) testthat::test_that("eval_code fails with unquoted expression", { - withr::with_environment( - env = baseenv(), , - code = testthat::expect_error(eval_code(qenv(), a <- b), "object 'b' not found") - ) + b <- 3 + testthat::expect_error(eval_code(qenv(), a <- b), "unable to find an inherited method for function .eval_code. for signature") }) testthat::test_that("an error when calling eval_code returns a qenv.error object which has message and trace", { diff --git a/tests/testthat/test-qenv_get_var.R b/tests/testthat/test-qenv_get_var.R index 8fbf0484..8d618780 100644 --- a/tests/testthat/test-qenv_get_var.R +++ b/tests/testthat/test-qenv_get_var.R @@ -1,20 +1,22 @@ -testthat::test_that("get_var and `[[`return error if object is qenv.error", { +testthat::test_that("get_var, `$` and `[[`return error if object is qenv.error", { q <- eval_code(qenv(), quote(x <- 1)) q <- eval_code(q, quote(y <- w * x)) testthat::expect_error(get_var(q, "x"), "when evaluating qenv code") testthat::expect_error(q[["x"]], "when evaluating qenv code") + testthat::expect_error(q$x, "when evaluating qenv code") }) -testthat::test_that("get_var and `[[` return object from qenv environment", { +testthat::test_that("get_var, `$` and `[[` return object from qenv environment", { q <- eval_code(qenv(), quote(x <- 1)) q <- eval_code(q, quote(y <- 5 * x)) testthat::expect_equal(get_var(q, "y"), 5) testthat::expect_equal(q[["x"]], 1) + testthat::expect_equal(q$x, 1) }) -testthat::test_that("get_var and `[[` return NULL if object not in qenv environment", { +testthat::test_that("get_var, `$` and `[[` return NULL if object not in qenv environment", { q <- eval_code(qenv(), quote(x <- 1)) q <- eval_code(q, quote(y <- 5 * x)) @@ -23,11 +25,31 @@ testthat::test_that("get_var and `[[` return NULL if object not in qenv environm testthat::expect_null(q[["w"]]) testthat::expect_message(q[["w"]], "object 'w' not found") + testthat::expect_null(q$w) }) -testthat::test_that("get_var and `[[` only returns objects from qenv, not parent environment(s)", { +testthat::test_that("get_var, `$` and `[[` only returns objects from qenv, not parent environment(s)", { q <- qenv() + new_env <- new.env(parent = parent.env(q)) + new_env$an_object <- 2 + + testthat::expect_null(get_var(q, "an_object")) + testthat::expect_null(q[["an_object"]]) + testthat::expect_null(q$an_object) +}) + +testthat::test_that("get_var, `$` and `[[` only returns objects from qenv, not .GlobalEnv", { + if (is.null(.GlobalEnv)) { + withr::defer(rm("an_object", envir = .GlobalEnv)) + } else { + old_object <- .GlobalEnv$an_object + withr::defer(.GlobalEnv$an_object <- old_object) + } + .GlobalEnv$an_object <- iris + + q <- qenv() testthat::expect_null(get_var(q, "iris")) testthat::expect_null(q[["iris"]]) + testthat::expect_null(q$iris) }) From 0a027266057e37e5a4412a8bb3cd948ccaaf399d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 29 Oct 2024 16:59:44 +0000 Subject: [PATCH 12/56] feat: prevent assignment to qenv.error --- NAMESPACE | 2 ++ R/qenv-get_var.R | 11 +++++++++++ tests/testthat/test-qenv_get_var.R | 10 +++++++++- 3 files changed, 22 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index e9c9e34c..5b9ae05b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,9 @@ # Generated by roxygen2: do not edit by hand S3method("$",qenv.error) +S3method("$<-",qenv.error) S3method("[[",qenv.error) +S3method("[[<-",qenv.error) S3method(within,qenv) S3method(within,qenv.error) export(concat) diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index c295208a..0b4dd5f9 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -70,3 +70,14 @@ setMethod("[[", signature = c("qenv", "ANY"), function(x, i) { } result } + +#' @export +`[[<-.qenv.error` <- function(x, name, value) { + stop(errorCondition( + list(message = conditionMessage(x)), + class = c("validation", "try-error", "simpleError") + )) +} + +#' @export +`$<-.qenv.error` <- `[[<-.qenv.error` diff --git a/tests/testthat/test-qenv_get_var.R b/tests/testthat/test-qenv_get_var.R index 8d618780..0733bcb9 100644 --- a/tests/testthat/test-qenv_get_var.R +++ b/tests/testthat/test-qenv_get_var.R @@ -1,4 +1,4 @@ -testthat::test_that("get_var, `$` and `[[`return error if object is qenv.error", { +testthat::test_that("get_var, `$` and `[[` return error if object is qenv.error", { q <- eval_code(qenv(), quote(x <- 1)) q <- eval_code(q, quote(y <- w * x)) @@ -53,3 +53,11 @@ testthat::test_that("get_var, `$` and `[[` only returns objects from qenv, not . testthat::expect_null(q[["iris"]]) testthat::expect_null(q$iris) }) + +testthat::test_that("`$<-` and `[[<-` always return error", { + q <- eval_code(qenv(), quote(x <- 1)) + q <- eval_code(q, quote(y <- w * x)) + + testthat::expect_error(q[["x2"]] <- 3, "when evaluating qenv code") + testthat::expect_error(q$x2 <- 3, "when evaluating qenv code") +}) From 281c9948affe3d918bafc613acc3f607afbb64f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 29 Oct 2024 17:09:11 +0000 Subject: [PATCH 13/56] doc: update news --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 81634b14..fa14d915 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,7 @@ * `get_code()` was extended with `names` parameter and allows the code extraction to be limited to objects stored in `qenv` but limited to `names`. -* Added `names()` function for `qenv` objects, which dynamically determines the visible objects in the environment. +* `qenv` inherits from the `environment` class, allowing to use `ls()`, `names()`, `as.environment()` and other functions on `qenv` objects. # teal.code 0.5.0 From b1ffbe7fb8e5b0176652590a5095aa816fa81bb1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 29 Oct 2024 17:30:47 +0000 Subject: [PATCH 14/56] fix: problem when printing qenv.error --- R/qenv-get_var.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index 0b4dd5f9..9bb2ca3e 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -60,15 +60,15 @@ setMethod("[[", signature = c("qenv", "ANY"), function(x, i) { `$.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. - result <- NextMethod("$", x) - if (is.null(result)) { - class(x) <- setdiff(class(x), "qenv.error") - stop(errorCondition( - list(message = conditionMessage(x)), - class = c("validation", "try-error", "simpleError") - )) + if (name %in% names(x)) { + return(NextMethod("$", x)) } - result + + class(x) <- setdiff(class(x), "qenv.error") + stop(errorCondition( + list(message = conditionMessage(x)), + class = c("validation", "try-error", "simpleError") + )) } #' @export From e457a4c5183e4ef987c5bc410132518108796f99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 29 Oct 2024 17:31:59 +0000 Subject: [PATCH 15/56] docs: adds .xData slot documentation --- R/qenv-class.R | 2 +- man/qenv-class.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/qenv-class.R b/R/qenv-class.R index a0b15b75..e6377099 100644 --- a/R/qenv-class.R +++ b/R/qenv-class.R @@ -4,7 +4,7 @@ #' @name qenv-class #' @rdname qenv-class #' @slot code (`character`) representing code necessary to reproduce the environment -#' @slot env (`environment`) environment which content was generated by the evaluation +#' @slot .xData (`environment`) environment with content was generated by the evaluation #' of the `code` slot. #' @slot id (`integer`) random identifier of the code element to make sure uniqueness #' when joining. diff --git a/man/qenv-class.Rd b/man/qenv-class.Rd index acb66ffe..4470c2e8 100644 --- a/man/qenv-class.Rd +++ b/man/qenv-class.Rd @@ -12,7 +12,7 @@ Reproducible class with environment and code. \describe{ \item{\code{code}}{(\code{character}) representing code necessary to reproduce the environment} -\item{\code{env}}{(\code{environment}) environment which content was generated by the evaluation +\item{\code{.xData}}{(\code{environment}) environment with content was generated by the evaluation of the \code{code} slot.} \item{\code{id}}{(\code{integer}) random identifier of the code element to make sure uniqueness From 2c76a8affe9a9f78f7f105563706a128aa5ac652 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 29 Oct 2024 17:44:11 +0000 Subject: [PATCH 16/56] chore: cleanup of previous implementation of names.qenv --- _pkgdown.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index f9d24965..3b151760 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -34,7 +34,6 @@ reference: - get_var - get_warnings - join - - names.qenv - new_qenv - qenv - show,qenv-method From ab9e3422eb93c7c6731cc4c7e914fa4ea8ba48fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 29 Oct 2024 17:48:36 +0000 Subject: [PATCH 17/56] chore: lintr cleanup --- tests/testthat/test-qenv_eval_code.R | 5 ++++- tests/testthat/test-qenv_get_var.R | 4 ++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R index b0bf71e3..2a9d553f 100644 --- a/tests/testthat/test-qenv_eval_code.R +++ b/tests/testthat/test-qenv_eval_code.R @@ -77,7 +77,10 @@ testthat::test_that("eval_code works with quoted code block", { testthat::test_that("eval_code fails with unquoted expression", { b <- 3 - testthat::expect_error(eval_code(qenv(), a <- b), "unable to find an inherited method for function .eval_code. for signature") + testthat::expect_error( + eval_code(qenv(), a <- b), + "unable to find an inherited method for function .eval_code. for signature" + ) }) testthat::test_that("an error when calling eval_code returns a qenv.error object which has message and trace", { diff --git a/tests/testthat/test-qenv_get_var.R b/tests/testthat/test-qenv_get_var.R index 0733bcb9..9f771d91 100644 --- a/tests/testthat/test-qenv_get_var.R +++ b/tests/testthat/test-qenv_get_var.R @@ -44,9 +44,9 @@ testthat::test_that("get_var, `$` and `[[` only returns objects from qenv, not . withr::defer(rm("an_object", envir = .GlobalEnv)) } else { old_object <- .GlobalEnv$an_object - withr::defer(.GlobalEnv$an_object <- old_object) + withr::defer(.GlobalEnv$an_object <- old_object) # nolint: object_name. } - .GlobalEnv$an_object <- iris + .GlobalEnv$an_object <- iris # nolint: object_name. q <- qenv() testthat::expect_null(get_var(q, "iris")) From c56a5ca5ceadf3406e8e862c7f571eeb85bd3f0b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 30 Oct 2024 15:27:35 +0000 Subject: [PATCH 18/56] feat: expand on compatibility with an environment --- DESCRIPTION | 1 + NAMESPACE | 7 +++- R/qenv-class.R | 23 +++++++---- R/qenv-errors.R | 8 ++++ R/qenv-get_var.R | 11 ------ R/qenv-join.R | 63 ++++++++++++++++++++++-------- R/qenv-length.R | 5 +++ tests/testthat/test-qenv-class.R | 13 ++++++ tests/testthat/test-qenv_get_var.R | 8 ---- 9 files changed, 93 insertions(+), 46 deletions(-) create mode 100644 R/qenv-length.R create mode 100644 tests/testthat/test-qenv-class.R diff --git a/DESCRIPTION b/DESCRIPTION index 9b465772..f9eab6a6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -63,6 +63,7 @@ Collate: 'qenv-get_var.R' 'qenv-get_warnings.R' 'qenv-join.R' + 'qenv-length.R' 'qenv-show.R' 'qenv-within.R' 'teal.code-package.R' diff --git a/NAMESPACE b/NAMESPACE index 5b9ae05b..8b8a54eb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,9 +1,12 @@ # Generated by roxygen2: do not edit by hand S3method("$",qenv.error) -S3method("$<-",qenv.error) S3method("[[",qenv.error) -S3method("[[<-",qenv.error) +S3method(as.list,qenv.error) +S3method(c,qenv) +S3method(c,qenv.error) +S3method(length,qenv) +S3method(length,qenv.error) S3method(within,qenv) S3method(within,qenv.error) export(concat) diff --git a/R/qenv-class.R b/R/qenv-class.R index e6377099..9b08c738 100644 --- a/R/qenv-class.R +++ b/R/qenv-class.R @@ -20,14 +20,21 @@ setClass( warnings = "character", messages = "character" ), - contains = "environment", - prototype = list( - .xData = new.env(parent = parent.env(.GlobalEnv)), - code = character(0), - id = integer(0), - warnings = character(0), - messages = character(0) - ) + contains = "environment" +) + +setMethod( + "initialize", + "qenv", + function(.Object, .xData = new.env(parent = parent.env(.GlobalEnv)), ...) { # nolint: object_name. + .Object <- callNextMethod(.Object, ...) # nolint: object_name. + + checkmate::assert_environment(.xData) + lockEnvironment(.xData) + .Object@.xData <- .xData # nolint: object_name. + + .Object + } ) #' It takes a `qenv` class and returns `TRUE` if the input is valid diff --git a/R/qenv-errors.R b/R/qenv-errors.R index 4af63a56..12b0fdbd 100644 --- a/R/qenv-errors.R +++ b/R/qenv-errors.R @@ -1,2 +1,10 @@ # needed to handle try-error setOldClass("qenv.error") + +#' @export +as.list.qenv.error <- function(x, ...) { + stop(errorCondition( + list(message = conditionMessage(x)), + class = c("validation", "try-error", "simpleError") + )) +} diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index 9bb2ca3e..4ccde0d0 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -70,14 +70,3 @@ setMethod("[[", signature = c("qenv", "ANY"), function(x, i) { class = c("validation", "try-error", "simpleError") )) } - -#' @export -`[[<-.qenv.error` <- function(x, name, value) { - stop(errorCondition( - list(message = conditionMessage(x)), - class = c("validation", "try-error", "simpleError") - )) -} - -#' @export -`$<-.qenv.error` <- `[[<-.qenv.error` diff --git a/R/qenv-join.R b/R/qenv-join.R index e3545091..4371dc0d 100644 --- a/R/qenv-join.R +++ b/R/qenv-join.R @@ -136,30 +136,17 @@ setGeneric("join", function(x, y) standardGeneric("join")) setMethod("join", signature = c("qenv", "qenv"), function(x, y) { - join_validation <- .check_joinable(x, y) - - # join expressions - if (!isTRUE(join_validation)) { - stop(join_validation) - } - - id_unique <- !y@id %in% x@id - x@id <- c(x@id, y@id[id_unique]) - x@code <- c(x@code, y@code[id_unique]) - x@warnings <- c(x@warnings, y@warnings[id_unique]) - x@messages <- c(x@messages, y@messages[id_unique]) - - # insert (and overwrite) objects from y to x - x@.xData <- rlang::env_clone(x@.xData, parent = parent.env(.GlobalEnv)) - rlang::env_coalesce(env = x@.xData, from = y@.xData) - x + lifecycle::deprecate_soft("0.5.1", "join()", details = "Please use `c()` instead") + c(x, y) }) setMethod("join", signature = c("qenv", "qenv.error"), function(x, y) { + lifecycle::deprecate_soft("0.5.1", "join()", details = "Please use `c()` instead") y }) setMethod("join", signature = c("qenv.error", "ANY"), function(x, y) { + lifecycle::deprecate_soft("0.5.1", "join()", details = "Please use `c()` instead") x }) @@ -214,3 +201,45 @@ setMethod("join", signature = c("qenv.error", "ANY"), function(x, y) { ) } } + +#' @export +c.qenv.error <- function(...) { + rlang::list2(...)[[1]] +} + +#' @export +c.qenv <- function(...) { + dots <- rlang::list2(...) + if (!checkmate::test_list(dots[-1], types = c("qenv", "qenv.error"))) { + return(NextMethod(c, dots[[1]])) + } + + first_non_qenv_ix <- which.min(vapply(dots, inherits, what = "qenv", logical(1))) + if (first_non_qenv_ix > 1) { + return(dots[[first_non_qenv_ix]]) + } + + Reduce( + x = dots[-1], + init = dots[[1]], + f = function(x, y) { + join_validation <- .check_joinable(x, y) + + # join expressions + if (!isTRUE(join_validation)) { + stop(join_validation) + } + + id_unique <- !y@id %in% x@id + x@id <- c(x@id, y@id[id_unique]) + x@code <- c(x@code, y@code[id_unique]) + x@warnings <- c(x@warnings, y@warnings[id_unique]) + x@messages <- c(x@messages, y@messages[id_unique]) + + # insert (and overwrite) objects from y to x + x@.xData <- rlang::env_clone(x@.xData, parent = parent.env(.GlobalEnv)) + rlang::env_coalesce(env = x@.xData, from = y@.xData) + x + } + ) +} diff --git a/R/qenv-length.R b/R/qenv-length.R new file mode 100644 index 00000000..f94e9d88 --- /dev/null +++ b/R/qenv-length.R @@ -0,0 +1,5 @@ +#' @export +length.qenv <- function(x) length(x@.xData) + +#' @export +length.qenv.error <- function(x) 0 diff --git a/tests/testthat/test-qenv-class.R b/tests/testthat/test-qenv-class.R new file mode 100644 index 00000000..a953c505 --- /dev/null +++ b/tests/testthat/test-qenv-class.R @@ -0,0 +1,13 @@ +testthat::describe("methods::new(qenv)", { + testthat::it("creates a locked environment", { + expect_true(is.environment(methods::new("qenv"))) + }) + + testthat::it("throws error when id and code length doesn't match", { + expect_error(is.environment(methods::new("qenv", id = 1))) + }) + + testthat::it("throws error when .xData is not an environment", { + expect_true(is.environment(methods::new("qenv"))) + }) +}) diff --git a/tests/testthat/test-qenv_get_var.R b/tests/testthat/test-qenv_get_var.R index 9f771d91..8cf9ec94 100644 --- a/tests/testthat/test-qenv_get_var.R +++ b/tests/testthat/test-qenv_get_var.R @@ -53,11 +53,3 @@ testthat::test_that("get_var, `$` and `[[` only returns objects from qenv, not . testthat::expect_null(q[["iris"]]) testthat::expect_null(q$iris) }) - -testthat::test_that("`$<-` and `[[<-` always return error", { - q <- eval_code(qenv(), quote(x <- 1)) - q <- eval_code(q, quote(y <- w * x)) - - testthat::expect_error(q[["x2"]] <- 3, "when evaluating qenv code") - testthat::expect_error(q$x2 <- 3, "when evaluating qenv code") -}) From 9904570ea31d4f96c14e9ef431c0538be0a1b314 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 30 Oct 2024 15:38:40 +0000 Subject: [PATCH 19/56] fix: complete tests for qenv-class --- tests/testthat/test-qenv-class.R | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-qenv-class.R b/tests/testthat/test-qenv-class.R index a953c505..7c74586c 100644 --- a/tests/testthat/test-qenv-class.R +++ b/tests/testthat/test-qenv-class.R @@ -1,13 +1,20 @@ testthat::describe("methods::new(qenv)", { testthat::it("creates a locked environment", { - expect_true(is.environment(methods::new("qenv"))) + expect_true(environmentIsLocked(teal.code::get_env(methods::new("qenv")))) + }) + + testthat::it("creates a locked environment when .xData is manually defined", { + new_env <- new.env() + expect_false(environmentIsLocked(new_env)) + + expect_true(environmentIsLocked(teal.code::get_env(methods::new("qenv")))) }) testthat::it("throws error when id and code length doesn't match", { - expect_error(is.environment(methods::new("qenv", id = 1))) + expect_error(methods::new("qenv", id = 1L), "@code and @id slots must have the same length\\.") }) testthat::it("throws error when .xData is not an environment", { - expect_true(is.environment(methods::new("qenv"))) + expect_error(methods::new("qenv", .xData = 2), "Must be an environment, not 'double'\\.") }) }) From 5c0ef7deb94d9eaae97c1217d809c81992f0dc43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 30 Oct 2024 16:52:45 +0000 Subject: [PATCH 20/56] doc: adds section to qenv constructor --- R/qenv-constructor.R | 22 ++++++++++++++++++++++ man/qenv.Rd | 22 ++++++++++++++++++++++ 2 files changed, 44 insertions(+) diff --git a/R/qenv-constructor.R b/R/qenv-constructor.R index 7215d1e5..961a82fd 100644 --- a/R/qenv-constructor.R +++ b/R/qenv-constructor.R @@ -10,9 +10,31 @@ #' `qenv()` instantiates a `qenv` with an empty environment. #' Any changes must be made by evaluating code in it with `eval_code` or `within`, thereby ensuring reproducibility. #' +#' #' `new_qenv()` (`r badge("deprecated")` and not recommended) #' can instantiate a `qenv` object with data in the environment and code registered. #' +#' @section Environment: +#' +#' The `qenv` object behaves as an environment that is locked and can be used as +#' as a argument to with many functions that accept `environment`, among the +#' most relevant are: `names()`, `ls()`, `get()`, `exists()`, `parent.env()`, +#' `{l,s,v}apply` family, `local`, `as.environment()`, `is.environment()`, `as.list()`, ... +#' +#' `qenv` should not be used with `cbind()` and `env.profile()` functions as it +#' has unexpected behavior. +#' Instead, `get_env()` or `as.environment()` should be used before calling any +#' problematic function. +#' +#' Similarly, `rlang` functions related to environments cannot be used directly +#' with `qenv` and should be used with `teal.code::get_env()`/`as.environment()`. +#' +#' ```r +#' q <- qenv() +#' rlang::env_clone(as.environment(q)) +#' rlang::env_clone(get_env(q)) +#' ``` +#' #' @name qenv #' #' @return `qenv` and `new_qenv` return a `qenv` object. diff --git a/man/qenv.Rd b/man/qenv.Rd index 4d382246..79d63b2a 100644 --- a/man/qenv.Rd +++ b/man/qenv.Rd @@ -81,6 +81,28 @@ It is a method for the \code{base} generic that wraps \code{eval_code} to provid through the \code{...} argument: as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr} will be replaced with \code{value}. } +\section{Environment}{ + + +The \code{qenv} object behaves as an environment that is locked and can be used as +as a argument to with many functions that accept \code{environment}, among the +most relevant are: \code{names()}, \code{ls()}, \code{get()}, \code{exists()}, \code{parent.env()}, +\verb{\{l,s,v\}apply} family, \code{local}, \code{as.environment()}, \code{is.environment()}, \code{as.list()}, ... + +\code{qenv} should not be used with \code{cbind()} and \code{env.profile()} functions as it +has unexpected behavior. +Instead, \code{get_env()} or \code{as.environment()} should be used before calling any +problematic function. + +Similarly, \code{rlang} functions related to environments cannot be used directly +with \code{qenv} and should be used with \code{teal.code::get_env()}/\code{as.environment()}. + +\if{html}{\out{
}}\preformatted{q <- qenv() +rlang::env_clone(as.environment(q)) +rlang::env_clone(get_env(q)) +}\if{html}{\out{
}} +} + \section{Extracting dataset-specific code}{ When \code{names} is specified, the code returned will be limited to the lines needed to \emph{create} From 558bd72ff0e7d45e3523d30eaca6faaa209b4367 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 30 Oct 2024 16:54:27 +0000 Subject: [PATCH 21/56] fix: test and adds extra protection on qenv validation --- R/qenv-class.R | 2 ++ tests/testthat/test-qenv_join.R | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/R/qenv-class.R b/R/qenv-class.R index 9b08c738..fd31cc82 100644 --- a/R/qenv-class.R +++ b/R/qenv-class.R @@ -49,6 +49,8 @@ setValidity("qenv", function(object) { "@code and @messages slots must have the same length" } else if (any(duplicated(object@id))) { "@id contains duplicated values." + } else if (!environmentIsLocked(object@.xData)) { + "@.xData must be locked." } else { TRUE } diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R index 890c0f3a..7baad857 100644 --- a/tests/testthat/test-qenv_join.R +++ b/tests/testthat/test-qenv_join.R @@ -3,7 +3,7 @@ testthat::test_that("Joining two identical qenvs outputs the same object", { q2 <- q1 testthat::expect_true(.check_joinable(q1, q2)) - q <- join(q1, q2) + q <- c(q1, q2) testthat::expect_equal(q@.xData, q1@.xData) testthat::expect_identical(q@code, "iris1 <- iris") From 4ec3e9f4e4d69a8889f8553a4872c7a2b556cd20 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 30 Oct 2024 17:05:03 +0000 Subject: [PATCH 22/56] fix: move constructor logic to "initialize" method of qenv --- R/qenv-class.R | 2 +- R/qenv-constructor.R | 4 +--- R/qenv-join.R | 6 +++--- 3 files changed, 5 insertions(+), 7 deletions(-) diff --git a/R/qenv-class.R b/R/qenv-class.R index fd31cc82..19ef51ba 100644 --- a/R/qenv-class.R +++ b/R/qenv-class.R @@ -30,7 +30,7 @@ setMethod( .Object <- callNextMethod(.Object, ...) # nolint: object_name. checkmate::assert_environment(.xData) - lockEnvironment(.xData) + lockEnvironment(.xData, bindings = TRUE) .Object@.xData <- .xData # nolint: object_name. .Object diff --git a/R/qenv-constructor.R b/R/qenv-constructor.R index 961a82fd..7e1f07a7 100644 --- a/R/qenv-constructor.R +++ b/R/qenv-constructor.R @@ -45,9 +45,7 @@ #' #' @export qenv <- function() { - q_env <- new.env(parent = parent.env(.GlobalEnv)) - lockEnvironment(q_env, bindings = TRUE) - methods::new("qenv", .xData = q_env) + methods::new("qenv") } diff --git a/R/qenv-join.R b/R/qenv-join.R index 4371dc0d..33a36121 100644 --- a/R/qenv-join.R +++ b/R/qenv-join.R @@ -136,17 +136,17 @@ setGeneric("join", function(x, y) standardGeneric("join")) setMethod("join", signature = c("qenv", "qenv"), function(x, y) { - lifecycle::deprecate_soft("0.5.1", "join()", details = "Please use `c()` instead") + lifecycle::deprecate_soft("0.5.1", "join()", "c()") c(x, y) }) setMethod("join", signature = c("qenv", "qenv.error"), function(x, y) { - lifecycle::deprecate_soft("0.5.1", "join()", details = "Please use `c()` instead") + lifecycle::deprecate_soft("0.5.1", "join()", "c()") y }) setMethod("join", signature = c("qenv.error", "ANY"), function(x, y) { - lifecycle::deprecate_soft("0.5.1", "join()", details = "Please use `c()` instead") + lifecycle::deprecate_soft("0.5.1", "join()", "c()") x }) From e00fd9224578cb7fbca35e79b9a6083fe7079d98 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 30 Oct 2024 17:18:28 +0000 Subject: [PATCH 23/56] fix: problem with integer (1L) shorthand in within --- R/qenv-eval_code.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R index 5657c520..9a8816b9 100644 --- a/R/qenv-eval_code.R +++ b/R/qenv-eval_code.R @@ -88,11 +88,11 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code }) setMethod("eval_code", signature = c("qenv", "language"), function(object, code) { - eval_code(object, code = paste(lang2calls(code), collapse = "\n")) + eval_code(object, code = paste(vapply(lang2calls(code), deparse1, character(1)), collapse = "\n")) }) setMethod("eval_code", signature = c("qenv", "expression"), function(object, code) { - eval_code(object, code = paste(lang2calls(code), collapse = "\n")) + eval_code(object, code = paste(vapply(lang2calls(code), deparse1, character(1)), collapse = "\n")) }) setMethod("eval_code", signature = c("qenv.error", "ANY"), function(object, code) { From be480f1e014efc9d2e73a85dcc949c96cd95cc73 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 30 Oct 2024 18:27:09 +0000 Subject: [PATCH 24/56] test: problem with integer (1L) shorthand in within --- tests/testthat/test-qenv_within.R | 32 +++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R index 49a9c8f0..85497913 100644 --- a/tests/testthat/test-qenv_within.R +++ b/tests/testthat/test-qenv_within.R @@ -114,3 +114,35 @@ testthat::test_that("within run on qenv.error returns the qenv.error as is", { testthat::expect_identical(qe, qee) }) + +testthat::test_that("within preserves integer definition in code", { + q <- within(qenv(), a <- 1L) + testthat::expect_identical(get_code(q), "a <- 1L") +}) + +testthat::describe("within preserves R primitives shorthands with", { + testthat::test_that("integer", { + q <- within(qenv(), an_integer <- 1L) + testthat::expect_type(q[["an_integer"]], "integer") + }) + + testthat::test_that("complex", { + q <- within(qenv(), a_complex <- 1 + 3i) + testthat::expect_type(q[["a_complex"]], "complex") + }) + + testthat::test_that("double", { + q <- within(qenv(), a_double <- 1.0) + testthat::expect_type(q[["a_double"]], "double") + }) + + testthat::test_that("logical", { + q <- within(qenv(), a_logical <- TRUE) + testthat::expect_type(q[["a_logical"]], "logical") + }) + + testthat::test_that("logical shorthand", { + q <- within(qenv(), a_logical_shorthand <- T) + testthat::expect_type(q[["a_logical_shorthand"]], "logical") + }) +}) From b7d1885396da0648ed4bcb79e15aeffca009cd11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 30 Oct 2024 18:27:59 +0000 Subject: [PATCH 25/56] fix: order and formal of callNextMethod --- R/qenv-class.R | 8 ++++++-- man/qenv-class.Rd | 3 +++ 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/R/qenv-class.R b/R/qenv-class.R index 19ef51ba..87227265 100644 --- a/R/qenv-class.R +++ b/R/qenv-class.R @@ -23,16 +23,20 @@ setClass( contains = "environment" ) +#' It initializes the `qenv` class +#' @name qenv-class +#' @keywords internal setMethod( "initialize", "qenv", function(.Object, .xData = new.env(parent = parent.env(.GlobalEnv)), ...) { # nolint: object_name. - .Object <- callNextMethod(.Object, ...) # nolint: object_name. - checkmate::assert_environment(.xData) lockEnvironment(.xData, bindings = TRUE) .Object@.xData <- .xData # nolint: object_name. + # .xData needs to be unnamed as the `.environment` constructure requires 1 + # unnamed formal argument. See methods::findMethods("initialize")$.environment + .Object <- methods::callNextMethod(.Object, .xData, ...) # nolint: object_name. .Object } ) diff --git a/man/qenv-class.Rd b/man/qenv-class.Rd index 4470c2e8..7a480cda 100644 --- a/man/qenv-class.Rd +++ b/man/qenv-class.Rd @@ -4,6 +4,9 @@ \name{qenv-class} \alias{qenv-class} \title{Reproducible class with environment and code} +\usage{ +\S4method{initialize}{qenv}(.Object, .xData = new.env(parent = parent.env(.GlobalEnv)), ...) +} \description{ Reproducible class with environment and code. } From 2a320220aba704c0c859031937b7f7aeebc68962 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 30 Oct 2024 18:43:20 +0000 Subject: [PATCH 26/56] fix: minor bugs --- R/qenv-class.R | 10 +++++----- man/qenv-class.Rd | 3 --- tests/testthat/test-qenv-class.R | 2 +- tests/testthat/test-qenv_join.R | 2 +- 4 files changed, 7 insertions(+), 10 deletions(-) diff --git a/R/qenv-class.R b/R/qenv-class.R index 87227265..0d2d6220 100644 --- a/R/qenv-class.R +++ b/R/qenv-class.R @@ -24,19 +24,19 @@ setClass( ) #' It initializes the `qenv` class -#' @name qenv-class -#' @keywords internal +#' @noRd setMethod( "initialize", "qenv", function(.Object, .xData = new.env(parent = parent.env(.GlobalEnv)), ...) { # nolint: object_name. + # .xData needs to be unnamed as the `.environment` constructure requires 1 + # unnamed formal argument. See methods::findMethods("initialize")$.environment + .Object <- methods::callNextMethod(.Object, .xData, ...) # nolint: object_name. + checkmate::assert_environment(.xData) lockEnvironment(.xData, bindings = TRUE) .Object@.xData <- .xData # nolint: object_name. - # .xData needs to be unnamed as the `.environment` constructure requires 1 - # unnamed formal argument. See methods::findMethods("initialize")$.environment - .Object <- methods::callNextMethod(.Object, .xData, ...) # nolint: object_name. .Object } ) diff --git a/man/qenv-class.Rd b/man/qenv-class.Rd index 7a480cda..4470c2e8 100644 --- a/man/qenv-class.Rd +++ b/man/qenv-class.Rd @@ -4,9 +4,6 @@ \name{qenv-class} \alias{qenv-class} \title{Reproducible class with environment and code} -\usage{ -\S4method{initialize}{qenv}(.Object, .xData = new.env(parent = parent.env(.GlobalEnv)), ...) -} \description{ Reproducible class with environment and code. } diff --git a/tests/testthat/test-qenv-class.R b/tests/testthat/test-qenv-class.R index 7c74586c..e943a52f 100644 --- a/tests/testthat/test-qenv-class.R +++ b/tests/testthat/test-qenv-class.R @@ -7,7 +7,7 @@ testthat::describe("methods::new(qenv)", { new_env <- new.env() expect_false(environmentIsLocked(new_env)) - expect_true(environmentIsLocked(teal.code::get_env(methods::new("qenv")))) + expect_true(environmentIsLocked(teal.code::get_env(methods::new("qenv", .xData = new_env)))) }) testthat::it("throws error when id and code length doesn't match", { diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R index 7baad857..b4a0debf 100644 --- a/tests/testthat/test-qenv_join.R +++ b/tests/testthat/test-qenv_join.R @@ -15,7 +15,7 @@ testthat::test_that("Joining two independent qenvs results in object having comb q2 <- eval_code(qenv(), quote(mtcars1 <- mtcars)) testthat::expect_true(.check_joinable(q1, q2)) - q <- join(q1, q2) + q <- c(q1, q2) testthat::expect_equal(q@.xData, list2env(list(iris1 = iris, mtcars1 = mtcars))) testthat::expect_identical( From 90493792ddd07bc6347d6d502c1c15dfdf6d6b4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 30 Oct 2024 18:44:15 +0000 Subject: [PATCH 27/56] chore: fix lintr --- tests/testthat/test-qenv_within.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R index 85497913..15555980 100644 --- a/tests/testthat/test-qenv_within.R +++ b/tests/testthat/test-qenv_within.R @@ -142,7 +142,7 @@ testthat::describe("within preserves R primitives shorthands with", { }) testthat::test_that("logical shorthand", { - q <- within(qenv(), a_logical_shorthand <- T) + q <- within(qenv(), a_logical_shorthand <- T) # nolint: T_and_F_symbol. testthat::expect_type(q[["a_logical_shorthand"]], "logical") }) }) From bb5c5fb6921bb63347cbedb6adfa9ada5763f571 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 31 Oct 2024 17:56:21 +0100 Subject: [PATCH 28/56] Apply suggestions from code review MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Dawid Kałędkowski Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/qenv-constructor.R | 26 ++++++++------------------ 1 file changed, 8 insertions(+), 18 deletions(-) diff --git a/R/qenv-constructor.R b/R/qenv-constructor.R index 7e1f07a7..bcdc445b 100644 --- a/R/qenv-constructor.R +++ b/R/qenv-constructor.R @@ -16,24 +16,14 @@ #' #' @section Environment: #' -#' The `qenv` object behaves as an environment that is locked and can be used as -#' as a argument to with many functions that accept `environment`, among the -#' most relevant are: `names()`, `ls()`, `get()`, `exists()`, `parent.env()`, -#' `{l,s,v}apply` family, `local`, `as.environment()`, `is.environment()`, `as.list()`, ... -#' -#' `qenv` should not be used with `cbind()` and `env.profile()` functions as it -#' has unexpected behavior. -#' Instead, `get_env()` or `as.environment()` should be used before calling any -#' problematic function. -#' -#' Similarly, `rlang` functions related to environments cannot be used directly -#' with `qenv` and should be used with `teal.code::get_env()`/`as.environment()`. -#' -#' ```r -#' q <- qenv() -#' rlang::env_clone(as.environment(q)) -#' rlang::env_clone(get_env(q)) -#' ``` +#' The `qenv` object behaves like an environment that is locked and one can use +#' some of the `base` functions dedicated to the `environment`. List of supported +#' functions includes: +#' `names()`, `ls()`, `get()`, `exists()`, `parent.env()`, `lapply`, `sapply` +#' `vapply`, `local`, `as.environment()`, `is.environment()`, `as.list()`, ... +#' We don't recommend using any function outside of the `teal.code` exports and these +#' mentioned above. +#' #' #' @name qenv #' From 709265f02ec1a66b36ed860b602401b5f1c2f319 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 31 Oct 2024 16:56:35 +0000 Subject: [PATCH 29/56] docs: update --- man/qenv.Rd | 24 +++++++----------------- 1 file changed, 7 insertions(+), 17 deletions(-) diff --git a/man/qenv.Rd b/man/qenv.Rd index 79d63b2a..1af34a3e 100644 --- a/man/qenv.Rd +++ b/man/qenv.Rd @@ -84,23 +84,13 @@ as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr} \section{Environment}{ -The \code{qenv} object behaves as an environment that is locked and can be used as -as a argument to with many functions that accept \code{environment}, among the -most relevant are: \code{names()}, \code{ls()}, \code{get()}, \code{exists()}, \code{parent.env()}, -\verb{\{l,s,v\}apply} family, \code{local}, \code{as.environment()}, \code{is.environment()}, \code{as.list()}, ... - -\code{qenv} should not be used with \code{cbind()} and \code{env.profile()} functions as it -has unexpected behavior. -Instead, \code{get_env()} or \code{as.environment()} should be used before calling any -problematic function. - -Similarly, \code{rlang} functions related to environments cannot be used directly -with \code{qenv} and should be used with \code{teal.code::get_env()}/\code{as.environment()}. - -\if{html}{\out{
}}\preformatted{q <- qenv() -rlang::env_clone(as.environment(q)) -rlang::env_clone(get_env(q)) -}\if{html}{\out{
}} +The \code{qenv} object behaves like an environment that is locked and one can use +some of the \code{base} functions dedicated to the \code{environment}. List of supported +functions includes: +\code{names()}, \code{ls()}, \code{get()}, \code{exists()}, \code{parent.env()}, \code{lapply}, \code{sapply} +\code{vapply}, \code{local}, \code{as.environment()}, \code{is.environment()}, \code{as.list()}, ... +We don't recommend using any function outside of the \code{teal.code} exports and these +mentioned above. } \section{Extracting dataset-specific code}{ From 1fe8b182fc5b1c981c3b117aad679a6dc6501aee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 31 Oct 2024 16:57:28 +0000 Subject: [PATCH 30/56] docs: small improvements --- NAMESPACE | 1 + R/qenv-eval_code.R | 2 +- R/qenv-get_env.R | 17 +++++++---------- R/qenv-get_var.R | 5 ++++- R/qenv-join.R | 4 ++-- man/get_env.Rd | 9 +++++---- man/join.Rd | 4 ++-- 7 files changed, 22 insertions(+), 20 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8b8a54eb..30e05cf0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ S3method(c,qenv) S3method(c,qenv.error) S3method(length,qenv) S3method(length,qenv.error) +S3method(names,qenv.error) S3method(within,qenv) S3method(within,qenv.error) export(concat) diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R index 9a8816b9..4bec715b 100644 --- a/R/qenv-eval_code.R +++ b/R/qenv-eval_code.R @@ -47,7 +47,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code { eval(single_call, envir = object@.xData) if (!identical(parent.env(object@.xData), parent.env(.GlobalEnv))) { - # needed to make sure that @env is always a sibling of .GlobalEnv + # needed to make sure that @.xData is always a sibling of .GlobalEnv # could be changed when any new package is added to search path (through library or require call) parent.env(object@.xData) <- parent.env(.GlobalEnv) } diff --git a/R/qenv-get_env.R b/R/qenv-get_env.R index bbb2e03f..968c04ae 100644 --- a/R/qenv-get_env.R +++ b/R/qenv-get_env.R @@ -1,10 +1,10 @@ #' Access environment included in `qenv` #' -#' The access of environment included in `qenv@env` allows to e.g. list object names included in `qenv@env` slot. +#' The access of environment included in the `qenv` that contains all data objects. #' -#' @param object (`qenv`) +#' @param object (`qenv`). #' -#' @return An `environment` stored in `qenv@env` slot. +#' @return An `environment` stored in `qenv` slot with all data objects. #' #' @examples #' q <- qenv() @@ -13,7 +13,8 @@ #' b <- data.frame(x = 1:10) #' }) #' get_env(q1) -#' ls(get_env(q1)) +#' +#' ls(get_env(q1)) # list objects in the environment #' #' @aliases get_env,qenv-method #' @aliases get_env,qenv.error-method @@ -23,10 +24,6 @@ setGeneric("get_env", function(object) { standardGeneric("get_env") }) -setMethod("get_env", "qenv", function(object) { - object@.xData -}) +setMethod("get_env", "qenv", function(object) object@.xData) -setMethod("get_env", "qenv.error", function(object) { - object -}) +setMethod("get_env", "qenv.error", function(object) object) diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index 4ccde0d0..8a272db9 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -56,11 +56,14 @@ setMethod("[[", signature = c("qenv", "ANY"), function(x, i) { )) } +#' @export +names.qenv.error <- function(x) NULL + #' @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. - if (name %in% names(x)) { + if (exists(name, x)) { return(NextMethod("$", x)) } diff --git a/R/qenv-join.R b/R/qenv-join.R index 33a36121..744d0159 100644 --- a/R/qenv-join.R +++ b/R/qenv-join.R @@ -74,8 +74,8 @@ #' # Error message will occur #' #' # Check the value of temporary variable i in both objects -#' x@env$i # Output: 2 -#' y@env$i # Output: 3 +#' x@.xData$i # Output: 2 +#' y@.xData$i # Output: 3 #' ``` #' `join()` fails to provide a proper result because of the temporary variable `i` exists #' in both objects but has different value. diff --git a/man/get_env.Rd b/man/get_env.Rd index b6e86a34..e54eb29c 100644 --- a/man/get_env.Rd +++ b/man/get_env.Rd @@ -9,13 +9,13 @@ get_env(object) } \arguments{ -\item{object}{(\code{qenv})} +\item{object}{(\code{qenv}).} } \value{ -An \code{environment} stored in \code{qenv@env} slot. +An \code{environment} stored in \code{qenv} slot with all data objects. } \description{ -The access of environment included in \code{qenv@env} allows to e.g. list object names included in \code{qenv@env} slot. +The access of environment included in the \code{qenv} that contains all data objects. } \examples{ q <- qenv() @@ -24,6 +24,7 @@ q1 <- within(q, { b <- data.frame(x = 1:10) }) get_env(q1) -ls(get_env(q1)) + +ls(get_env(q1)) # list objects in the environment } diff --git a/man/join.Rd b/man/join.Rd index 40f60d0c..584e0150 100644 --- a/man/join.Rd +++ b/man/join.Rd @@ -93,8 +93,8 @@ q <- join(x,y) # Error message will occur # Check the value of temporary variable i in both objects -x@env$i # Output: 2 -y@env$i # Output: 3 +x@.xData$i # Output: 2 +y@.xData$i # Output: 3 }\if{html}{\out{}} \code{join()} fails to provide a proper result because of the temporary variable \code{i} exists From 3ae05417916b2cb7a37c3972a0e99d31b1054aca Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Thu, 31 Oct 2024 16:59:43 +0000 Subject: [PATCH 31/56] [skip style] [skip vbump] Restyle files --- R/qenv-constructor.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/qenv-constructor.R b/R/qenv-constructor.R index bcdc445b..fa6a82c8 100644 --- a/R/qenv-constructor.R +++ b/R/qenv-constructor.R @@ -17,11 +17,11 @@ #' @section Environment: #' #' The `qenv` object behaves like an environment that is locked and one can use -#' some of the `base` functions dedicated to the `environment`. List of supported -#' functions includes: +#' some of the `base` functions dedicated to the `environment`. List of supported +#' functions includes: #' `names()`, `ls()`, `get()`, `exists()`, `parent.env()`, `lapply`, `sapply` #' `vapply`, `local`, `as.environment()`, `is.environment()`, `as.list()`, ... -#' We don't recommend using any function outside of the `teal.code` exports and these +#' We don't recommend using any function outside of the `teal.code` exports and these #' mentioned above. #' #' From 0a644988135a09866546dc022cbab0a4f1266332 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 31 Oct 2024 18:00:32 +0100 Subject: [PATCH 32/56] Update tests/testthat/test-qenv_within.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Dawid Kałędkowski Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- tests/testthat/test-qenv_within.R | 30 ------------------------------ 1 file changed, 30 deletions(-) diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R index 15555980..dd149315 100644 --- a/tests/testthat/test-qenv_within.R +++ b/tests/testthat/test-qenv_within.R @@ -115,34 +115,4 @@ testthat::test_that("within run on qenv.error returns the qenv.error as is", { testthat::expect_identical(qe, qee) }) -testthat::test_that("within preserves integer definition in code", { - q <- within(qenv(), a <- 1L) - testthat::expect_identical(get_code(q), "a <- 1L") -}) - -testthat::describe("within preserves R primitives shorthands with", { - testthat::test_that("integer", { - q <- within(qenv(), an_integer <- 1L) - testthat::expect_type(q[["an_integer"]], "integer") - }) - - testthat::test_that("complex", { - q <- within(qenv(), a_complex <- 1 + 3i) - testthat::expect_type(q[["a_complex"]], "complex") - }) - - testthat::test_that("double", { - q <- within(qenv(), a_double <- 1.0) - testthat::expect_type(q[["a_double"]], "double") - }) - - testthat::test_that("logical", { - q <- within(qenv(), a_logical <- TRUE) - testthat::expect_type(q[["a_logical"]], "logical") - }) - - testthat::test_that("logical shorthand", { - q <- within(qenv(), a_logical_shorthand <- T) # nolint: T_and_F_symbol. - testthat::expect_type(q[["a_logical_shorthand"]], "logical") - }) }) From d4ee6d0d00f5e893047b46e73967c35a92e0c6f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 31 Oct 2024 17:44:45 +0000 Subject: [PATCH 33/56] docs: implements @gogonzo suggestions and cleans up docs --- DESCRIPTION | 1 + R/qenv-constructor.R | 14 +++++++++++- R/qenv-eval_code.R | 2 +- R/qenv-get_code.R | 2 +- R/qenv-get_var.R | 6 ++++-- R/qenv-within.R | 2 +- R/qenv-z-environment.R | 24 +++++++++++++++++++++ man/get_var.Rd | 7 +++--- man/qenv.Rd | 49 ++++++++++++++++++++++++++++++++++++++---- 9 files changed, 93 insertions(+), 14 deletions(-) create mode 100644 R/qenv-z-environment.R diff --git a/DESCRIPTION b/DESCRIPTION index f9eab6a6..7d7fe621 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -66,6 +66,7 @@ Collate: 'qenv-length.R' 'qenv-show.R' 'qenv-within.R' + 'qenv-z-environment.R' 'teal.code-package.R' 'utils-get_code_dependency.R' 'utils.R' diff --git a/R/qenv-constructor.R b/R/qenv-constructor.R index fa6a82c8..57c90a05 100644 --- a/R/qenv-constructor.R +++ b/R/qenv-constructor.R @@ -14,6 +14,19 @@ #' `new_qenv()` (`r badge("deprecated")` and not recommended) #' can instantiate a `qenv` object with data in the environment and code registered. #' +#' @section Extracting objects from `qenv`: +#' +#' Extracting an object from the `qenv` by name can be done using the following methods: +#' +#' - `x[[name]]` +#' - `x$name` +#' - `get(name, envir = x)` +#' +#' note: `get_var(name)` was superseded by the native \R methods above. +#' +#' To list all objects in the environment, use `ls(x)` (which doesn't show +#' objects that have a dot prefix with default arguments) or `names(x)` (shows all objects). +#' #' @section Environment: #' #' The `qenv` object behaves like an environment that is locked and one can use @@ -38,7 +51,6 @@ qenv <- function() { methods::new("qenv") } - #' @param code `r badge("deprecated")` #' (`character(1)` or `language`) code to evaluate. Accepts and stores comments also. #' @param env `r badge("deprecated")` (`environment`) diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R index 4bec715b..15733a95 100644 --- a/R/qenv-eval_code.R +++ b/R/qenv-eval_code.R @@ -1,7 +1,7 @@ #' Evaluate code in `qenv` #' #' @details -#' `eval_code` evaluates given code in the `qenv` environment and appends it to the `code` slot. +#' `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`) diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R index cc88d633..de9bb0fa 100644 --- a/R/qenv-get_code.R +++ b/R/qenv-get_code.R @@ -1,7 +1,7 @@ #' Get code from `qenv` #' #' @details -#' `get_code` retrieves the code stored in the `qenv`. `...` passes arguments to methods. +#' `get_code()` retrieves the code stored in the `qenv`. `...` passes arguments to methods. #' #' @param object (`qenv`) #' @param deparse (`logical(1)`) flag specifying whether to return code as `character` or `expression`. diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index 8a272db9..3d04c035 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -1,5 +1,9 @@ #' Get object from `qenv` #' +#' @description +#' `r lifecycle::badge("superseded")` by native \R operators/functions: +#' `x[[name]]`, `x$name` or `get(name, envir = qenv)`. +#' #' Retrieve variables from the `qenv` environment. #' #' @param object,x (`qenv`) @@ -12,7 +16,6 @@ #' q1 <- eval_code(q, code = quote(a <- 1)) #' q2 <- eval_code(q1, code = "b <- a") #' get_var(q2, "b") -#' q2[["b"]] #' #' @name get_var #' @rdname get_var @@ -43,7 +46,6 @@ setMethod("get_var", signature = c("qenv.error", "ANY"), function(object, var) { )) }) -#' @rdname get_var setMethod("[[", signature = c("qenv", "ANY"), function(x, i) { get_var(x, i) }) diff --git a/R/qenv-within.R b/R/qenv-within.R index b38a641e..7d5fd32d 100644 --- a/R/qenv-within.R +++ b/R/qenv-within.R @@ -1,7 +1,7 @@ #' Evaluate Expression in `qenv` #' #' @details -#' `within` is a convenience function for evaluating inline code inside the environment of a `qenv`. +#' `within()` is a convenience function for evaluating inline code inside the environment of a `qenv`. #' It is a method for the `base` generic that wraps `eval_code` to provide a simplified way of passing code. #' `within` accepts only inline expressions (both simple and compound) and allows for injecting values into `expr` #' through the `...` argument: diff --git a/R/qenv-z-environment.R b/R/qenv-z-environment.R new file mode 100644 index 00000000..4956299a --- /dev/null +++ b/R/qenv-z-environment.R @@ -0,0 +1,24 @@ +#' @name qenv-inheritted +#' @rdname qenv +#' +#' @param x (`qenv`) object. +#' @param name (`character`) name of object. +#' @param pos,envir,all.names,pattern,sorted see [ls()] function for details. +#' +#' @usage x[[name]] +#' x$name +#' names(x) +#' ls(name, pos = -1L, envir = as.environment(pos), +#' all.names = FALSE, pattern, sorted = TRUE) +#' +#' @details +#' `x[[name]]`, `x$name` and `get(name, x)` are generic \R operators to access the objects in the environment. +#' See [`[[`] for more details. +#' `names(x)` and `ls(x)` calls on the `qenv` object and will list all objects in the environment. +#' +#' @return `[[`, `$` and `get` return the value of the object named `name` in the `qenv` object. +#' @return `names` return a character vector of all the names of the objects in the `qenv` object. +#' @return `ls` return a character vector of the names of the objects in the `qenv` object. +#' It will only show the objects that are not named with a dot prefix, unless +#' the `all.names = TRUE`, which will show all objects. +NULL diff --git a/man/get_var.Rd b/man/get_var.Rd index 06aee7d8..2fb879b8 100644 --- a/man/get_var.Rd +++ b/man/get_var.Rd @@ -4,12 +4,9 @@ \alias{get_var} \alias{get_var,qenv,character-method} \alias{get_var,qenv.error,ANY-method} -\alias{[[,qenv-method} \title{Get object from \code{qenv}} \usage{ get_var(object, var) - -\S4method{[[}{qenv}(x, i) } \arguments{ \item{object, x}{(\code{qenv})} @@ -20,6 +17,9 @@ get_var(object, var) The value of required variable (\code{var}) within \code{qenv} object. } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} by native \R operators/functions: +\code{x[[name]]}, \code{x$name} or \code{get(name, envir = qenv)}. + Retrieve variables from the \code{qenv} environment. } \examples{ @@ -27,6 +27,5 @@ q <- qenv() q1 <- eval_code(q, code = quote(a <- 1)) q2 <- eval_code(q1, code = "b <- a") get_var(q2, "b") -q2[["b"]] } diff --git a/man/qenv.Rd b/man/qenv.Rd index 1af34a3e..024ad0fc 100644 --- a/man/qenv.Rd +++ b/man/qenv.Rd @@ -1,6 +1,6 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/qenv-constructor.R, R/qenv-eval_code.R, -% R/qenv-get_code.R, R/qenv-within.R +% R/qenv-get_code.R, R/qenv-within.R, R/qenv-z-environment.R \name{qenv} \alias{qenv} \alias{new_qenv} @@ -18,6 +18,7 @@ \alias{get_code,qenv-method} \alias{get_code,qenv.error-method} \alias{within.qenv} +\alias{qenv-inheritted} \title{Code tracking with \code{qenv} object} \usage{ qenv() @@ -29,6 +30,12 @@ eval_code(object, code) get_code(object, deparse = TRUE, names = NULL, ...) \method{within}{qenv}(data, expr, ...) + +x[[name]] +x$name +names(x) +ls(name, pos = -1L, envir = as.environment(pos), + all.names = FALSE, pattern, sorted = TRUE) } \arguments{ \item{env}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} (\code{environment}) @@ -48,6 +55,12 @@ For more details see the "Extracting dataset-specific code" section.} \item{data}{(\code{qenv})} \item{expr}{(\code{expression}) to evaluate. Must be inline code, see \verb{Using language objects...}} + +\item{x}{(\code{qenv}) object.} + +\item{name}{(\code{character}) name of object.} + +\item{pos, envir, all.names, pattern, sorted}{see \code{\link[=ls]{ls()}} function for details.} } \value{ \code{qenv} and \code{new_qenv} return a \code{qenv} object. @@ -57,6 +70,14 @@ For more details see the "Extracting dataset-specific code" section.} \code{get_code} returns the traced code (from \verb{@code} slot) in the form specified by \code{deparse}. \code{within} returns a \code{qenv} object with \code{expr} evaluated or \code{qenv.error} if evaluation fails. + +\code{[[}, \code{$} and \code{get} return the value of the object named \code{name} in the \code{qenv} object. + +\code{names} return a character vector of all the names of the objects in the \code{qenv} object. + +\code{ls} return a character vector of the names of the objects in the \code{qenv} object. +It will only show the objects that are not named with a dot prefix, unless +the \code{all.names = TRUE}, which will show all objects. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} @@ -70,17 +91,37 @@ Any changes must be made by evaluating code in it with \code{eval_code} or \code \code{new_qenv()} (\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} and not recommended) can instantiate a \code{qenv} object with data in the environment and code registered. -\code{eval_code} evaluates given code in the \code{qenv} environment and appends it to the \code{code} slot. +\code{eval_code()} evaluates given code in the \code{qenv} environment and appends it to the \code{code} slot. Thus, if the \code{qenv} had been instantiated empty, contents of the environment are always a result of the stored code. -\code{get_code} retrieves the code stored in the \code{qenv}. \code{...} passes arguments to methods. +\code{get_code()} retrieves the code stored in the \code{qenv}. \code{...} passes arguments to methods. -\code{within} is a convenience function for evaluating inline code inside the environment of a \code{qenv}. +\code{within()} is a convenience function for evaluating inline code inside the environment of a \code{qenv}. It is a method for the \code{base} generic that wraps \code{eval_code} to provide a simplified way of passing code. \code{within} accepts only inline expressions (both simple and compound) and allows for injecting values into \code{expr} through the \code{...} argument: as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr} will be replaced with \code{value}. + +\code{x[[name]]}, \code{x$name} and \code{get(name, x)} are generic \R operators to access the objects in the environment. +See [\code{[[}] for more details. +\code{names(x)} and \code{ls(x)} calls on the \code{qenv} object and will list all objects in the environment. } +\section{Extracting objects from \code{qenv}}{ + + +Extracting an object from the \code{qenv} by name can be done using the following methods: +\itemize{ +\item \code{x[[name]]} +\item \code{x$name} +\item \code{get(name, envir = x)} +} + +note: \code{get_var(name)} was superseded by the native \R methods above. + +To list all objects in the environment, use \code{ls(x)} (which doesn't show +objects that have a dot prefix with default arguments) or \code{names(x)} (shows all objects). +} + \section{Environment}{ From af7054b837b45be9271b667e2c8b9db0a769f285 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 31 Oct 2024 17:50:37 +0000 Subject: [PATCH 34/56] docs: move section around --- DESCRIPTION | 1 - R/qenv-get_code.R | 34 ++++++++++++++++++++++++++++++++++ R/qenv-z-environment.R | 24 ------------------------ man/qenv.Rd | 34 ++++++++++++++++++++-------------- 4 files changed, 54 insertions(+), 39 deletions(-) delete mode 100644 R/qenv-z-environment.R diff --git a/DESCRIPTION b/DESCRIPTION index 7d7fe621..f9eab6a6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -66,7 +66,6 @@ Collate: 'qenv-length.R' 'qenv-show.R' 'qenv-within.R' - 'qenv-z-environment.R' 'teal.code-package.R' 'utils-get_code_dependency.R' 'utils.R' diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R index de9bb0fa..6d651be5 100644 --- a/R/qenv-get_code.R +++ b/R/qenv-get_code.R @@ -1,3 +1,37 @@ +#' @name qenv-inheritted +#' @rdname qenv +#' +#' @param x (`qenv`) object. +#' @param name (`character`) name of object. +#' @param pos,envir,all.names,pattern,sorted see [ls()] function for details. +#' +#' @usage x[[name]] +#' x$name +#' names(x) +#' ls(name, pos = -1L, envir = as.environment(pos), +#' all.names = FALSE, pattern, sorted = TRUE) +#' +#' @details +#' `x[[name]]`, `x$name` and `get(name, x)` are generic \R operators to access the objects in the environment. +#' See [`[[`] for more details. +#' `names(x)` and `ls(x)` calls on the `qenv` object and will list all objects in the environment. +#' +#' @return `[[`, `$` and `get` return the value of the object named `name` in the `qenv` object. +#' @return `names` return a character vector of all the names of the objects in the `qenv` object. +#' @return `ls` return a character vector of the names of the objects in the `qenv` object. +#' It will only show the objects that are not named with a dot prefix, unless +#' the `all.names = TRUE`, which will show all objects. +#' +#' @examples +#' # Extract objects from qenv +#' q[["a"]] +#' q$a +#' +#' # list objects in qenv +#' names(q) +NULL + + #' Get code from `qenv` #' #' @details diff --git a/R/qenv-z-environment.R b/R/qenv-z-environment.R deleted file mode 100644 index 4956299a..00000000 --- a/R/qenv-z-environment.R +++ /dev/null @@ -1,24 +0,0 @@ -#' @name qenv-inheritted -#' @rdname qenv -#' -#' @param x (`qenv`) object. -#' @param name (`character`) name of object. -#' @param pos,envir,all.names,pattern,sorted see [ls()] function for details. -#' -#' @usage x[[name]] -#' x$name -#' names(x) -#' ls(name, pos = -1L, envir = as.environment(pos), -#' all.names = FALSE, pattern, sorted = TRUE) -#' -#' @details -#' `x[[name]]`, `x$name` and `get(name, x)` are generic \R operators to access the objects in the environment. -#' See [`[[`] for more details. -#' `names(x)` and `ls(x)` calls on the `qenv` object and will list all objects in the environment. -#' -#' @return `[[`, `$` and `get` return the value of the object named `name` in the `qenv` object. -#' @return `names` return a character vector of all the names of the objects in the `qenv` object. -#' @return `ls` return a character vector of the names of the objects in the `qenv` object. -#' It will only show the objects that are not named with a dot prefix, unless -#' the `all.names = TRUE`, which will show all objects. -NULL diff --git a/man/qenv.Rd b/man/qenv.Rd index 024ad0fc..77a8b4a3 100644 --- a/man/qenv.Rd +++ b/man/qenv.Rd @@ -1,6 +1,6 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/qenv-constructor.R, R/qenv-eval_code.R, -% R/qenv-get_code.R, R/qenv-within.R, R/qenv-z-environment.R +% R/qenv-get_code.R, R/qenv-within.R \name{qenv} \alias{qenv} \alias{new_qenv} @@ -14,11 +14,11 @@ \alias{eval_code,qenv,language-method} \alias{eval_code,qenv,expression-method} \alias{eval_code,qenv.error,ANY-method} +\alias{qenv-inheritted} \alias{get_code} \alias{get_code,qenv-method} \alias{get_code,qenv.error-method} \alias{within.qenv} -\alias{qenv-inheritted} \title{Code tracking with \code{qenv} object} \usage{ qenv() @@ -27,15 +27,15 @@ new_qenv(env = new.env(parent = parent.env(.GlobalEnv)), code = character()) eval_code(object, code) -get_code(object, deparse = TRUE, names = NULL, ...) - -\method{within}{qenv}(data, expr, ...) - x[[name]] x$name names(x) ls(name, pos = -1L, envir = as.environment(pos), all.names = FALSE, pattern, sorted = TRUE) + +get_code(object, deparse = TRUE, names = NULL, ...) + +\method{within}{qenv}(data, expr, ...) } \arguments{ \item{env}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} (\code{environment}) @@ -67,10 +67,6 @@ For more details see the "Extracting dataset-specific code" section.} \code{eval_code} returns a \code{qenv} object with \code{expr} evaluated or \code{qenv.error} if evaluation fails. -\code{get_code} returns the traced code (from \verb{@code} slot) in the form specified by \code{deparse}. - -\code{within} returns a \code{qenv} object with \code{expr} evaluated or \code{qenv.error} if evaluation fails. - \code{[[}, \code{$} and \code{get} return the value of the object named \code{name} in the \code{qenv} object. \code{names} return a character vector of all the names of the objects in the \code{qenv} object. @@ -78,6 +74,10 @@ For more details see the "Extracting dataset-specific code" section.} \code{ls} return a character vector of the names of the objects in the \code{qenv} object. It will only show the objects that are not named with a dot prefix, unless the \code{all.names = TRUE}, which will show all objects. + +\code{get_code} returns the traced code (from \verb{@code} slot) in the form specified by \code{deparse}. + +\code{within} returns a \code{qenv} object with \code{expr} evaluated or \code{qenv.error} if evaluation fails. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} @@ -94,6 +94,10 @@ can instantiate a \code{qenv} object with data in the environment and code regis \code{eval_code()} evaluates given code in the \code{qenv} environment and appends it to the \code{code} slot. Thus, if the \code{qenv} had been instantiated empty, contents of the environment are always a result of the stored code. +\code{x[[name]]}, \code{x$name} and \code{get(name, x)} are generic \R operators to access the objects in the environment. +See [\code{[[}] for more details. +\code{names(x)} and \code{ls(x)} calls on the \code{qenv} object and will list all objects in the environment. + \code{get_code()} retrieves the code stored in the \code{qenv}. \code{...} passes arguments to methods. \code{within()} is a convenience function for evaluating inline code inside the environment of a \code{qenv}. @@ -101,10 +105,6 @@ It is a method for the \code{base} generic that wraps \code{eval_code} to provid \code{within} accepts only inline expressions (both simple and compound) and allows for injecting values into \code{expr} through the \code{...} argument: as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr} will be replaced with \code{value}. - -\code{x[[name]]}, \code{x$name} and \code{get(name, x)} are generic \R operators to access the objects in the environment. -See [\code{[[}] for more details. -\code{names(x)} and \code{ls(x)} calls on the \code{qenv} object and will list all objects in the environment. } \section{Extracting objects from \code{qenv}}{ @@ -226,6 +226,12 @@ q <- eval_code(q, "a <- 1") q <- eval_code(q, quote(library(checkmate))) q <- eval_code(q, expression(assert_number(a))) +# Extract objects from qenv +q[["a"]] +q$a + +# list objects in qenv +names(q) # retrieve code q <- within(qenv(), { a <- 1 From c668d98cad726cc772b64c611fb581872f3fa9ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 31 Oct 2024 17:55:05 +0000 Subject: [PATCH 35/56] docs: superseded --- R/qenv-get_var.R | 2 +- R/qenv-join.R | 4 ++++ man/get_var.Rd | 2 +- man/join.Rd | 2 ++ 4 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index 3d04c035..491f42cc 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -2,7 +2,7 @@ #' #' @description #' `r lifecycle::badge("superseded")` by native \R operators/functions: -#' `x[[name]]`, `x$name` or `get(name, envir = qenv)`. +#' `x[[name]]`, `x$name` or [get()]. #' #' Retrieve variables from the `qenv` environment. #' diff --git a/R/qenv-join.R b/R/qenv-join.R index 744d0159..f4dfdc03 100644 --- a/R/qenv-join.R +++ b/R/qenv-join.R @@ -1,7 +1,11 @@ #' Join `qenv` objects #' +#' @description +#' `r lifecycle::badge("superseded")` by [c()]. +#' #' Checks and merges two `qenv` objects into one `qenv` object. #' +#' @details #' Any common code at the start of the `qenvs` is only placed once at the start of the joined `qenv`. #' This allows consistent behavior when joining `qenvs` which share a common ancestor. #' See below for an example. diff --git a/man/get_var.Rd b/man/get_var.Rd index 2fb879b8..ffc8bb4f 100644 --- a/man/get_var.Rd +++ b/man/get_var.Rd @@ -18,7 +18,7 @@ The value of required variable (\code{var}) within \code{qenv} object. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} by native \R operators/functions: -\code{x[[name]]}, \code{x$name} or \code{get(name, envir = qenv)}. +\code{x[[name]]}, \code{x$name} or \code{\link[=get]{get()}}. Retrieve variables from the \code{qenv} environment. } diff --git a/man/join.Rd b/man/join.Rd index 584e0150..e14ee8e7 100644 --- a/man/join.Rd +++ b/man/join.Rd @@ -18,6 +18,8 @@ join(x, y) \code{qenv} object. } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} by \code{\link[=c]{c()}}. + Checks and merges two \code{qenv} objects into one \code{qenv} object. } \details{ From faa843b4154fd0d6220efd9c1eb2d3beba368c38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 1 Nov 2024 14:34:17 +0000 Subject: [PATCH 36/56] fix: use newlines in code parseing on multiline expression with within --- R/qenv-eval_code.R | 4 ++-- tests/testthat/test-qenv_join.R | 2 +- tests/testthat/test-qenv_within.R | 12 ++++++++++-- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R index 15733a95..35697e54 100644 --- a/R/qenv-eval_code.R +++ b/R/qenv-eval_code.R @@ -88,11 +88,11 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code }) setMethod("eval_code", signature = c("qenv", "language"), function(object, code) { - eval_code(object, code = paste(vapply(lang2calls(code), deparse1, character(1)), collapse = "\n")) + eval_code(object, code = paste(vapply(lang2calls(code), deparse1, collapse = "\n", character(1L)), collapse = "\n")) }) setMethod("eval_code", signature = c("qenv", "expression"), function(object, code) { - eval_code(object, code = paste(vapply(lang2calls(code), deparse1, character(1)), collapse = "\n")) + eval_code(object, code = paste(vapply(lang2calls(code), deparse1, collapse = "\n", character(1L)), collapse = "\n")) }) setMethod("eval_code", signature = c("qenv.error", "ANY"), function(object, code) { diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R index b4a0debf..1c286aa2 100644 --- a/tests/testthat/test-qenv_join.R +++ b/tests/testthat/test-qenv_join.R @@ -36,7 +36,7 @@ testthat::test_that("Joined qenv does not duplicate common code", { q2 <- eval_code(q2, quote(mtcars2 <- mtcars)) testthat::expect_true(.check_joinable(q1, q2)) - q <- join(q1, q2) + q <- c(q1, q2) testthat::expect_identical( q@code, diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R index dd149315..b72e5265 100644 --- a/tests/testthat/test-qenv_within.R +++ b/tests/testthat/test-qenv_within.R @@ -14,6 +14,16 @@ testthat::test_that("simple and compound expressions are evaluated", { ) }) +testthat::test_that("multiline expressions are evaluated", { + q <- qenv() + testthat::expect_no_error( + within(q, a <- function(x) { + y <- x + 1 + y + 3 + }) + ) +}) + # code identity ---- testthat::test_that("styling of input code does not impact evaluation results", { q <- qenv() @@ -114,5 +124,3 @@ testthat::test_that("within run on qenv.error returns the qenv.error as is", { testthat::expect_identical(qe, qee) }) - -}) From 015f11c2b4f5215085c210ac225304688eff93a5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 4 Nov 2024 18:04:33 +0000 Subject: [PATCH 37/56] fix: problems with check --- DESCRIPTION | 1 + R/qenv-c.R | 93 +++++++++++++++++++++++++++++ R/qenv-constructor.R | 2 +- R/qenv-get_code.R | 14 +---- R/qenv-get_var.R | 5 +- R/qenv-join.R | 94 ------------------------------ man/dot-check_joinable.Rd | 2 +- man/get_var.Rd | 3 + man/qenv.Rd | 46 +-------------- tests/testthat/test-qenv_get_var.R | 2 +- tests/testthat/test-qenv_join.R | 4 +- 11 files changed, 108 insertions(+), 158 deletions(-) create mode 100644 R/qenv-c.R diff --git a/DESCRIPTION b/DESCRIPTION index f9eab6a6..a60cfad7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -53,6 +53,7 @@ Language: en-US Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 Collate: + 'qenv-c.R' 'qenv-class.R' 'qenv-errors.R' 'qenv-concat.R' diff --git a/R/qenv-c.R b/R/qenv-c.R new file mode 100644 index 00000000..b07f288f --- /dev/null +++ b/R/qenv-c.R @@ -0,0 +1,93 @@ +#' 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) { + checkmate::assert_class(x, "qenv") + checkmate::assert_class(y, "qenv") + + common_names <- intersect(rlang::env_names(x@.xData), rlang::env_names(y@.xData)) + is_overwritten <- vapply(common_names, function(el) { + !identical(get(el, x@.xData), get(el, y@.xData)) + }, logical(1)) + if (any(is_overwritten)) { + return( + paste( + "Not possible to join qenv objects if anything in their environment has been modified.\n", + "Following object(s) have been modified:\n - ", + paste(common_names[is_overwritten], collapse = "\n - ") + ) + ) + } + + shared_ids <- intersect(x@id, y@id) + if (length(shared_ids) == 0) { + return(TRUE) + } + + shared_in_x <- match(shared_ids, x@id) + shared_in_y <- match(shared_ids, y@id) + + # indices of shared ids should be 1:n in both slots + if (identical(shared_in_x, shared_in_y) && identical(shared_in_x, seq_along(shared_ids))) { + TRUE + } else if (!identical(shared_in_x, shared_in_y)) { + paste( + "The common shared code of the qenvs does not occur in the same position in both qenv objects", + "so they cannot be joined together as it's impossible to determine the evaluation's order.", + collapse = "" + ) + } else { + paste( + "There is code in the qenv objects before their common shared code", + "which means these objects cannot be joined.", + collapse = "" + ) + } +} + +#' @export +c.qenv.error <- function(...) { + rlang::list2(...)[[1]] +} + +#' @export +c.qenv <- function(...) { + dots <- rlang::list2(...) + if (!checkmate::test_list(dots[-1], types = c("qenv", "qenv.error"))) { + return(NextMethod(c, dots[[1]])) + } + + first_non_qenv_ix <- which.min(vapply(dots, inherits, what = "qenv", logical(1))) + if (first_non_qenv_ix > 1) { + return(dots[[first_non_qenv_ix]]) + } + + Reduce( + x = dots[-1], + init = dots[[1]], + f = function(x, y) { + join_validation <- .check_joinable(x, y) + + # join expressions + if (!isTRUE(join_validation)) { + stop(join_validation) + } + + id_unique <- !y@id %in% x@id + x@id <- c(x@id, y@id[id_unique]) + x@code <- c(x@code, y@code[id_unique]) + x@warnings <- c(x@warnings, y@warnings[id_unique]) + x@messages <- c(x@messages, y@messages[id_unique]) + + # insert (and overwrite) objects from y to x + x@.xData <- rlang::env_clone(x@.xData, parent = parent.env(.GlobalEnv)) + rlang::env_coalesce(env = x@.xData, from = y@.xData) + x + } + ) +} diff --git a/R/qenv-constructor.R b/R/qenv-constructor.R index 4f1a0087..2a10a0e8 100644 --- a/R/qenv-constructor.R +++ b/R/qenv-constructor.R @@ -12,7 +12,7 @@ #' #' @name qenv #' -#' @return Returns a `qenv` object. +#' @return `qenv` returns a `qenv` object. #' #' @seealso [`base::within()`], [`get_var()`], [`get_env()`], [`get_warnings()`], [`join()`], [`concat()`] #' @examples diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R index 6d651be5..92e64e01 100644 --- a/R/qenv-get_code.R +++ b/R/qenv-get_code.R @@ -1,20 +1,11 @@ #' @name qenv-inheritted #' @rdname qenv #' -#' @param x (`qenv`) object. -#' @param name (`character`) name of object. -#' @param pos,envir,all.names,pattern,sorted see [ls()] function for details. -#' -#' @usage x[[name]] -#' x$name -#' names(x) -#' ls(name, pos = -1L, envir = as.environment(pos), -#' all.names = FALSE, pattern, sorted = TRUE) -#' #' @details +#' #' `x[[name]]`, `x$name` and `get(name, x)` are generic \R operators to access the objects in the environment. #' See [`[[`] for more details. -#' `names(x)` and `ls(x)` calls on the `qenv` object and will list all objects in the environment. +#' `names(x)` calls on the `qenv` object and will list all objects in the environment. #' #' @return `[[`, `$` and `get` return the value of the object named `name` in the `qenv` object. #' @return `names` return a character vector of all the names of the objects in the `qenv` object. @@ -31,7 +22,6 @@ #' names(q) NULL - #' Get code from `qenv` #' #' @details diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index 491f42cc..bdef9896 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -46,10 +46,7 @@ setMethod("get_var", signature = c("qenv.error", "ANY"), function(object, var) { )) }) -setMethod("[[", signature = c("qenv", "ANY"), function(x, i) { - get_var(x, i) -}) - +#' @rdname get_var #' @export `[[.qenv.error` <- function(x, i) { stop(errorCondition( diff --git a/R/qenv-join.R b/R/qenv-join.R index f4dfdc03..291d2d56 100644 --- a/R/qenv-join.R +++ b/R/qenv-join.R @@ -153,97 +153,3 @@ setMethod("join", signature = c("qenv.error", "ANY"), function(x, y) { lifecycle::deprecate_soft("0.5.1", "join()", "c()") 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) { - checkmate::assert_class(x, "qenv") - checkmate::assert_class(y, "qenv") - - common_names <- intersect(rlang::env_names(x@.xData), rlang::env_names(y@.xData)) - is_overwritten <- vapply(common_names, function(el) { - !identical(get(el, x@.xData), get(el, y@.xData)) - }, logical(1)) - if (any(is_overwritten)) { - return( - paste( - "Not possible to join qenv objects if anything in their environment has been modified.\n", - "Following object(s) have been modified:\n - ", - paste(common_names[is_overwritten], collapse = "\n - ") - ) - ) - } - - shared_ids <- intersect(x@id, y@id) - if (length(shared_ids) == 0) { - return(TRUE) - } - - shared_in_x <- match(shared_ids, x@id) - shared_in_y <- match(shared_ids, y@id) - - # indices of shared ids should be 1:n in both slots - if (identical(shared_in_x, shared_in_y) && identical(shared_in_x, seq_along(shared_ids))) { - TRUE - } else if (!identical(shared_in_x, shared_in_y)) { - paste( - "The common shared code of the qenvs does not occur in the same position in both qenv objects", - "so they cannot be joined together as it's impossible to determine the evaluation's order.", - collapse = "" - ) - } else { - paste( - "There is code in the qenv objects before their common shared code", - "which means these objects cannot be joined.", - collapse = "" - ) - } -} - -#' @export -c.qenv.error <- function(...) { - rlang::list2(...)[[1]] -} - -#' @export -c.qenv <- function(...) { - dots <- rlang::list2(...) - if (!checkmate::test_list(dots[-1], types = c("qenv", "qenv.error"))) { - return(NextMethod(c, dots[[1]])) - } - - first_non_qenv_ix <- which.min(vapply(dots, inherits, what = "qenv", logical(1))) - if (first_non_qenv_ix > 1) { - return(dots[[first_non_qenv_ix]]) - } - - Reduce( - x = dots[-1], - init = dots[[1]], - f = function(x, y) { - join_validation <- .check_joinable(x, y) - - # join expressions - if (!isTRUE(join_validation)) { - stop(join_validation) - } - - id_unique <- !y@id %in% x@id - x@id <- c(x@id, y@id[id_unique]) - x@code <- c(x@code, y@code[id_unique]) - x@warnings <- c(x@warnings, y@warnings[id_unique]) - x@messages <- c(x@messages, y@messages[id_unique]) - - # insert (and overwrite) objects from y to x - x@.xData <- rlang::env_clone(x@.xData, parent = parent.env(.GlobalEnv)) - rlang::env_coalesce(env = x@.xData, from = y@.xData) - x - } - ) -} diff --git a/man/dot-check_joinable.Rd b/man/dot-check_joinable.Rd index f0ef8684..e7f55478 100644 --- a/man/dot-check_joinable.Rd +++ b/man/dot-check_joinable.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/qenv-join.R +% Please edit documentation in R/qenv-c.R \name{.check_joinable} \alias{.check_joinable} \title{If two \code{qenv} can be joined} diff --git a/man/get_var.Rd b/man/get_var.Rd index ffc8bb4f..625d9801 100644 --- a/man/get_var.Rd +++ b/man/get_var.Rd @@ -4,9 +4,12 @@ \alias{get_var} \alias{get_var,qenv,character-method} \alias{get_var,qenv.error,ANY-method} +\alias{[[.qenv.error} \title{Get object from \code{qenv}} \usage{ get_var(object, var) + +\method{[[}{qenv.error}(x, i) } \arguments{ \item{object, x}{(\code{qenv})} diff --git a/man/qenv.Rd b/man/qenv.Rd index 5c171ade..6204d617 100644 --- a/man/qenv.Rd +++ b/man/qenv.Rd @@ -19,12 +19,6 @@ qenv() eval_code(object, code) -x[[name]] -x$name -names(x) -ls(name, pos = -1L, envir = as.environment(pos), - all.names = FALSE, pattern, sorted = TRUE) - get_code(object, deparse = TRUE, names = NULL, ...) \method{within}{qenv}(data, expr, ...) @@ -44,15 +38,9 @@ For more details see the "Extracting dataset-specific code" section.} \item{data}{(\code{qenv})} \item{expr}{(\code{expression}) to evaluate. Must be inline code, see \verb{Using language objects...}} - -\item{x}{(\code{qenv}) object.} - -\item{name}{(\code{character}) name of object.} - -\item{pos, envir, all.names, pattern, sorted}{see \code{\link[=ls]{ls()}} function for details.} } \value{ -Returns a \code{qenv} object. +\code{qenv} returns a \code{qenv} object. \code{eval_code} returns a \code{qenv} object with \code{expr} evaluated or \code{qenv.error} if evaluation fails. @@ -77,12 +65,12 @@ Create a \code{qenv} object and evaluate code in it to track code history. \code{qenv()} instantiates a \code{qenv} with an empty environment. Any changes must be made by evaluating code in it with \code{eval_code} or \code{within}, thereby ensuring reproducibility. -\code{eval_code} evaluates given code in the \code{qenv} environment and appends it to the \code{code} slot. +\code{eval_code()} evaluates given code in the \code{qenv} environment and appends it to the \code{code} slot. Thus, if the \code{qenv} had been instantiated empty, contents of the environment are always a result of the stored code. \code{x[[name]]}, \code{x$name} and \code{get(name, x)} are generic \R operators to access the objects in the environment. See [\code{[[}] for more details. -\code{names(x)} and \code{ls(x)} calls on the \code{qenv} object and will list all objects in the environment. +\code{names(x)} calls on the \code{qenv} object and will list all objects in the environment. \code{get_code()} retrieves the code stored in the \code{qenv}. \code{...} passes arguments to methods. @@ -92,34 +80,6 @@ It is a method for the \code{base} generic that wraps \code{eval_code} to provid through the \code{...} argument: as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr} will be replaced with \code{value}. } -\section{Extracting objects from \code{qenv}}{ - - -Extracting an object from the \code{qenv} by name can be done using the following methods: -\itemize{ -\item \code{x[[name]]} -\item \code{x$name} -\item \code{get(name, envir = x)} -} - -note: \code{get_var(name)} was superseded by the native \R methods above. - -To list all objects in the environment, use \code{ls(x)} (which doesn't show -objects that have a dot prefix with default arguments) or \code{names(x)} (shows all objects). -} - -\section{Environment}{ - - -The \code{qenv} object behaves like an environment that is locked and one can use -some of the \code{base} functions dedicated to the \code{environment}. List of supported -functions includes: -\code{names()}, \code{ls()}, \code{get()}, \code{exists()}, \code{parent.env()}, \code{lapply}, \code{sapply} -\code{vapply}, \code{local}, \code{as.environment()}, \code{is.environment()}, \code{as.list()}, ... -We don't recommend using any function outside of the \code{teal.code} exports and these -mentioned above. -} - \section{Extracting dataset-specific code}{ When \code{names} is specified, the code returned will be limited to the lines needed to \emph{create} diff --git a/tests/testthat/test-qenv_get_var.R b/tests/testthat/test-qenv_get_var.R index 8cf9ec94..c922e699 100644 --- a/tests/testthat/test-qenv_get_var.R +++ b/tests/testthat/test-qenv_get_var.R @@ -16,6 +16,7 @@ testthat::test_that("get_var, `$` and `[[` return object from qenv environment", testthat::expect_equal(q$x, 1) }) + testthat::test_that("get_var, `$` and `[[` return NULL if object not in qenv environment", { q <- eval_code(qenv(), quote(x <- 1)) q <- eval_code(q, quote(y <- 5 * x)) @@ -24,7 +25,6 @@ testthat::test_that("get_var, `$` and `[[` return NULL if object not in qenv env testthat::expect_message(get_var(q, "z"), "object 'z' not found") testthat::expect_null(q[["w"]]) - testthat::expect_message(q[["w"]], "object 'w' not found") testthat::expect_null(q$w) }) diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R index 1c286aa2..5a4b5f93 100644 --- a/tests/testthat/test-qenv_join.R +++ b/tests/testthat/test-qenv_join.R @@ -50,7 +50,7 @@ testthat::test_that("Not able to join two qenvs if any of the shared objects cha q2 <- eval_code(qenv(), quote(iris1 <- head(iris))) testthat::expect_match(.check_joinable(q1, q2), "Not possible to join qenv objects") - testthat::expect_error(join(q1, q2), "Not possible to join qenv objects") + testthat::expect_error(c(q1, q2), "Not possible to join qenv objects") }) testthat::test_that("join does not duplicate code but adds only extra code", { @@ -60,7 +60,7 @@ testthat::test_that("join does not duplicate code but adds only extra code", { q2 <- eval_code(q2, quote(mtcars2 <- mtcars)) testthat::expect_true(.check_joinable(q1, q2)) - q <- join(q1, q2) + q <- c(q1, q2) testthat::expect_identical( q@code, From 7cd89495d4ffb4a3871c05a95f0a8c744907baba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 5 Nov 2024 12:43:02 +0000 Subject: [PATCH 38/56] chore: rename instances of ls to names --- NEWS.md | 2 +- R/qenv-get_env.R | 2 +- README.md | 8 ++++---- man/get_env.Rd | 2 +- tests/testthat/test-qenv-class.R | 4 ++-- tests/testthat/test-qenv_constructor.R | 18 +++++++++--------- vignettes/qenv.Rmd | 8 ++++---- 7 files changed, 22 insertions(+), 22 deletions(-) diff --git a/NEWS.md b/NEWS.md index 20479253..b2de9723 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,7 @@ * `get_code()` was extended with `names` parameter and allows the code extraction to be limited to objects stored in `qenv` but limited to `names`. -* `qenv` inherits from the `environment` class, allowing to use `ls()`, `names()`, `as.environment()` and other functions on `qenv` objects. +* `qenv` inherits from the `environment` class, allowing to use `names()`, `as.environment()`, R operators (`[[` and `$`) and other functions on `qenv` objects. # teal.code 0.5.0 diff --git a/R/qenv-get_env.R b/R/qenv-get_env.R index 968c04ae..53615f95 100644 --- a/R/qenv-get_env.R +++ b/R/qenv-get_env.R @@ -14,7 +14,7 @@ #' }) #' get_env(q1) #' -#' ls(get_env(q1)) # list objects in the environment +#' names(get_env(q1)) # list objects in the environment #' #' @aliases get_env,qenv-method #' @aliases get_env,qenv.error-method diff --git a/README.md b/README.md index 27c7921f..599d4a5f 100644 --- a/README.md +++ b/README.md @@ -62,9 +62,9 @@ my_qenv #> Parent: #> Bindings: #> • x: [L] -get_env(my_qenv) +as.environment(my_qenv) #> -ls(get_env(my_qenv)) +names(my_qenv)) #> [1] "x" ``` @@ -77,9 +77,9 @@ qenv_2 #> • x: [L] #> • y: [L] #> • z: [L] -get_env(qenv_2) +environment(qenv_2) #> -ls(get_env(qenv_2)) +names(qenv_2) #> [1] "x" "y" "z" ``` diff --git a/man/get_env.Rd b/man/get_env.Rd index e54eb29c..3ec07c28 100644 --- a/man/get_env.Rd +++ b/man/get_env.Rd @@ -25,6 +25,6 @@ q1 <- within(q, { }) get_env(q1) -ls(get_env(q1)) # list objects in the environment +names(get_env(q1)) # list objects in the environment } diff --git a/tests/testthat/test-qenv-class.R b/tests/testthat/test-qenv-class.R index e943a52f..9bea4cf9 100644 --- a/tests/testthat/test-qenv-class.R +++ b/tests/testthat/test-qenv-class.R @@ -1,13 +1,13 @@ testthat::describe("methods::new(qenv)", { testthat::it("creates a locked environment", { - expect_true(environmentIsLocked(teal.code::get_env(methods::new("qenv")))) + expect_true(environmentIsLocked(as.environment(methods::new("qenv")))) }) testthat::it("creates a locked environment when .xData is manually defined", { new_env <- new.env() expect_false(environmentIsLocked(new_env)) - expect_true(environmentIsLocked(teal.code::get_env(methods::new("qenv", .xData = new_env)))) + expect_true(environmentIsLocked(as.environment(methods::new("qenv", .xData = new_env)))) }) testthat::it("throws error when id and code length doesn't match", { diff --git a/tests/testthat/test-qenv_constructor.R b/tests/testthat/test-qenv_constructor.R index 9721b06b..52406280 100644 --- a/tests/testthat/test-qenv_constructor.R +++ b/tests/testthat/test-qenv_constructor.R @@ -3,29 +3,29 @@ testthat::describe("qenv inherits from environment: ", { testthat::expect_true(is.environment(qenv())) }) - testthat::it("ls() shows nothing on empty environment", { - testthat::expect_identical(ls(qenv(), all.names = TRUE), character(0)) + testthat::it("names() shows nothing on empty environment", { + testthat::expect_identical(names(qenv(), all.names = TRUE), character(0)) }) - testthat::it("ls() shows available objets", { + testthat::it("names() shows available objets", { q <- within(qenv(), iris <- iris) - testthat::expect_setequal(ls(q), "iris") + testthat::expect_setequal(names(q), "iris") }) - testthat::it("ls() does not show hidden objects", { + testthat::it("names() does not show hidden objects", { q <- within(qenv(), { iris <- iris .hidden <- 2 }) - testthat::expect_setequal(ls(q), "iris") + testthat::expect_setequal(names(q), "iris") }) - testthat::it("names() show all objects", { + testthat::it("ls(all.names = TRUE) show all objects", { q <- eval_code(qenv(), " iris <- iris .hidden <- 2 ") - testthat::expect_setequal(names(q), c("iris", ".hidden")) + testthat::expect_setequal(ls(q, all.names = TRUE), c("iris", ".hidden")) }) testthat::it("does not allow binding to be added", { @@ -42,7 +42,7 @@ testthat::describe("qenv inherits from environment: ", { testthat::test_that("constructor returns qenv", { q <- qenv() testthat::expect_s4_class(q, "qenv") - testthat::expect_identical(ls(q@.xData, all.names = TRUE), character(0)) + testthat::expect_identical(names(q), character(0)) testthat::expect_identical(q@code, character(0)) testthat::expect_identical(q@id, integer(0)) testthat::expect_identical(q@warnings, character(0)) diff --git a/vignettes/qenv.Rmd b/vignettes/qenv.Rmd index 00fbf4ba..00c1038b 100644 --- a/vignettes/qenv.Rmd +++ b/vignettes/qenv.Rmd @@ -32,7 +32,7 @@ The `eval_code()` function executes code within a `qenv` environment, yielding a # evaluate code in qenv my_qenv <- eval_code(empty_qenv, "x <- 2") print(my_qenv) -get_env(my_qenv) +as.environment(my_qenv) q1 <- eval_code(my_qenv, "y <- x * 2") @@ -40,11 +40,11 @@ q1 <- eval_code(q1, "z <- y * 2") # my_qenv still contains only x print(my_qenv) -ls(get_env(my_qenv)) +names(my_qenv) # q1 contains x, y and z print(q1) -ls(get_env(q1)) +names(q1) ``` The same result can be achieved with the `within` method for the `qenv` class. @@ -115,7 +115,7 @@ y_q <- eval_code(common_q, quote(z <- 5)) join_q <- join(x_q, y_q) print(join_q) -ls(get_env(join_q)) +names(join_q) ``` The feasibility of joining `qenv` objects hinges on the contents of the environments and the code's order. Refer to the function documentation for further details. From 50be4b0b3c5f48f1a7f112469bc6b28368177323 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 5 Nov 2024 12:44:23 +0000 Subject: [PATCH 39/56] chore: rename instances of join to c --- vignettes/qenv.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/qenv.Rmd b/vignettes/qenv.Rmd index 00c1038b..33b73a01 100644 --- a/vignettes/qenv.Rmd +++ b/vignettes/qenv.Rmd @@ -112,7 +112,7 @@ common_q <- eval_code(qenv(), quote(x <- 1)) x_q <- eval_code(common_q, quote(y <- 5)) y_q <- eval_code(common_q, quote(z <- 5)) -join_q <- join(x_q, y_q) +join_q <- c(x_q, y_q) print(join_q) names(join_q) From 9d2ec00d1b9f7fae0e2c1fef496234bb6792d753 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 5 Nov 2024 12:54:41 +0000 Subject: [PATCH 40/56] docs: improvement on join() documentation --- R/qenv-c.R | 24 +++++++++++++++++++----- R/qenv-join.R | 22 +++++++++++----------- man/join.Rd | 44 +++++++++++++++++++++++++++++++------------- 3 files changed, 61 insertions(+), 29 deletions(-) diff --git a/R/qenv-c.R b/R/qenv-c.R index b07f288f..1b9d5690 100644 --- a/R/qenv-c.R +++ b/R/qenv-c.R @@ -50,11 +50,19 @@ } } -#' @export -c.qenv.error <- function(...) { - rlang::list2(...)[[1]] -} - +#' @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(...) { dots <- rlang::list2(...) @@ -91,3 +99,9 @@ c.qenv <- function(...) { } ) } + +#' @rdname join +#' @export +c.qenv.error <- function(...) { + rlang::list2(...)[[1]] +} diff --git a/R/qenv-join.R b/R/qenv-join.R index 291d2d56..940541d7 100644 --- a/R/qenv-join.R +++ b/R/qenv-join.R @@ -1,10 +1,10 @@ #' Join `qenv` objects #' #' @description -#' `r lifecycle::badge("superseded")` by [c()]. -#' #' Checks and merges two `qenv` objects into one `qenv` object. #' +#' The `join()` function is superseded by the `c()` function. +#' #' @details #' Any common code at the start of the `qenvs` is only placed once at the start of the joined `qenv`. #' This allows consistent behavior when joining `qenvs` which share a common ancestor. @@ -19,7 +19,7 @@ #' x <- eval_code(qenv(), expression(mtcars1 <- mtcars)) #' y <- eval_code(qenv(), expression(mtcars1 <- mtcars['wt'])) #' -#' z <- join(x, y) +#' z <- c(x, y) #' # Error message will occur #' ``` #' In this example, `mtcars1` object exists in both `x` and `y` objects but the content are not identical. @@ -44,8 +44,8 @@ #' y, #' "z <- v" #' ) -#' q <- join(x, y) -#' join_q <- join(q, z) +#' q <- c(x, y) +#' join_q <- c(q, z) #' # Error message will occur #' #' # Check the order of evaluation based on the id slot @@ -78,10 +78,10 @@ #' # Error message will occur #' #' # Check the value of temporary variable i in both objects -#' x@.xData$i # Output: 2 -#' y@.xData$i # Output: 3 +#' x$i # Output: 2 +#' y$i # Output: 3 #' ``` -#' `join()` fails to provide a proper result because of the temporary variable `i` exists +#' `c()` and `join()` fails to provide a proper result because of the temporary variable `i` exists #' in both objects but has different value. #' To fix this, we can set `i <- NULL` in the code expression for both objects. #' ```r @@ -104,7 +104,7 @@ #' # dummy i variable to fix it #' i <- NULL" #' ) -#' q <- join(x,y) +#' q <- c(x,y) #' ``` #' #' @param x (`qenv`) @@ -119,14 +119,14 @@ #' q1 <- eval_code(q1, "iris2 <- iris") #' q2 <- eval_code(q2, "mtcars2 <- mtcars") #' qq <- join(q1, q2) -#' get_code(qq) +#' cat(get_code(qq)) #' #' common_q <- eval_code(q, quote(x <- 1)) #' y_q <- eval_code(common_q, quote(y <- x * 2)) #' z_q <- eval_code(common_q, quote(z <- x * 3)) #' join_q <- join(y_q, z_q) #' # get_code only has "x <- 1" occurring once -#' get_code(join_q) +#' cat(get_code(join_q)) #' #' @include qenv-errors.R #' diff --git a/man/join.Rd b/man/join.Rd index e14ee8e7..61de2eb1 100644 --- a/man/join.Rd +++ b/man/join.Rd @@ -1,15 +1,23 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/qenv-join.R -\name{join} +% Please edit documentation in R/qenv-c.R, R/qenv-join.R +\name{c.qenv} +\alias{c.qenv} +\alias{c.qenv.error} \alias{join} \alias{join,qenv,qenv-method} \alias{join,qenv,qenv.error-method} \alias{join,qenv.error,ANY-method} \title{Join \code{qenv} objects} \usage{ +\method{c}{qenv}(...) + +\method{c}{qenv.error}(...) + join(x, y) } \arguments{ +\item{...}{(\code{qenv} or \code{qenv.error}).} + \item{x}{(\code{qenv})} \item{y}{(\code{qenv})} @@ -18,9 +26,9 @@ join(x, y) \code{qenv} object. } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} by \code{\link[=c]{c()}}. - Checks and merges two \code{qenv} objects into one \code{qenv} object. + +The \code{join()} function is superseded by the \code{c()} function. } \details{ Any common code at the start of the \code{qenvs} is only placed once at the start of the joined \code{qenv}. @@ -36,7 +44,7 @@ Example: \if{html}{\out{
}}\preformatted{x <- eval_code(qenv(), expression(mtcars1 <- mtcars)) y <- eval_code(qenv(), expression(mtcars1 <- mtcars['wt'])) -z <- join(x, y) +z <- c(x, y) # Error message will occur }\if{html}{\out{
}} @@ -61,8 +69,8 @@ z <- eval_code( y, "z <- v" ) -q <- join(x, y) -join_q <- join(q, z) +q <- c(x, y) +join_q <- c(q, z) # Error message will occur # Check the order of evaluation based on the id slot @@ -95,11 +103,11 @@ q <- join(x,y) # Error message will occur # Check the value of temporary variable i in both objects -x@.xData$i # Output: 2 -y@.xData$i # Output: 3 +x$i # Output: 2 +y$i # Output: 3 }\if{html}{\out{}} -\code{join()} fails to provide a proper result because of the temporary variable \code{i} exists +\code{c()} and \code{join()} fails to provide a proper result because of the temporary variable \code{i} exists in both objects but has different value. To fix this, we can set \code{i <- NULL} in the code expression for both objects. @@ -122,24 +130,34 @@ y <- eval_code( # dummy i variable to fix it i <- NULL" ) -q <- join(x,y) +q <- c(x,y) }\if{html}{\out{}} } } \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)) + 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 <- join(q1, q2) -get_code(qq) +cat(get_code(qq)) common_q <- eval_code(q, quote(x <- 1)) y_q <- eval_code(common_q, quote(y <- x * 2)) z_q <- eval_code(common_q, quote(z <- x * 3)) join_q <- join(y_q, z_q) # get_code only has "x <- 1" occurring once -get_code(join_q) +cat(get_code(join_q)) } From c76e148df1120a1493c7e08c49684af56a263ddf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 5 Nov 2024 13:59:20 +0100 Subject: [PATCH 41/56] Apply suggestions from code review MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Dawid Kałędkowski Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/qenv-get_var.R | 3 ++- tests/testthat/test-qenv_join.R | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index bdef9896..98fc7eed 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -1,7 +1,7 @@ #' Get object from `qenv` #' #' @description -#' `r lifecycle::badge("superseded")` by native \R operators/functions: +#' `r lifecycle::badge("deprecated")` by native \R operators/functions: #' `x[[name]]`, `x$name` or [get()]. #' #' Retrieve variables from the `qenv` environment. @@ -31,6 +31,7 @@ setGeneric("get_var", function(object, var) { setMethod("get_var", signature = c("qenv", "character"), function(object, var) { tryCatch( + lifecycle::deprecate_soft("0.5.1", "get_var()", "get()") get(var, envir = object@.xData, inherits = FALSE), error = function(e) { message(conditionMessage(e)) diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R index 5a4b5f93..36da892a 100644 --- a/tests/testthat/test-qenv_join.R +++ b/tests/testthat/test-qenv_join.R @@ -68,8 +68,8 @@ testthat::test_that("join does not duplicate code but adds only extra code", { ) testthat::expect_equal( - as.list(q@.xData), - list(iris1 = iris, iris2 = iris, mtcars1 = mtcars, mtcars2 = mtcars) + q@.xData, + list2env(list(iris1 = iris, iris2 = iris, mtcars1 = mtcars, mtcars2 = mtcars)) ) testthat::expect_identical(q@id, c(q1@id, q2@id[2])) From 620849bd38d68a9be8bc705b354ac1cd7acc8b91 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 5 Nov 2024 14:52:55 +0000 Subject: [PATCH 42/56] pr: apply suggestions --- NEWS.md | 4 +++- tests/testthat/test-qenv_constructor.R | 5 ----- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/NEWS.md b/NEWS.md index b2de9723..6f70465a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,9 @@ * `get_code()` was extended with `names` parameter and allows the code extraction to be limited to objects stored in `qenv` but limited to `names`. -* `qenv` inherits from the `environment` class, allowing to use `names()`, `as.environment()`, R operators (`[[` and `$`) and other functions on `qenv` objects. +* `qenv` inherits from the `environment` class, allowing to use `ls()`, `names()`, `as.environment()` and other functions on `qenv` objects. +* `join()` method is deprecated, please use `c()` instead +* `get_var()` method is deprecated, please use `get`, `[[` or `$` instead. # teal.code 0.5.0 diff --git a/tests/testthat/test-qenv_constructor.R b/tests/testthat/test-qenv_constructor.R index 52406280..7b76b218 100644 --- a/tests/testthat/test-qenv_constructor.R +++ b/tests/testthat/test-qenv_constructor.R @@ -60,8 +60,3 @@ testthat::describe("parent of qenv environment is the parent of .GlobalEnv", { testthat::expect_identical(parent.env(q), parent.env(.GlobalEnv)) }) }) - -testthat::test_that("qenv environment is locked", { - q <- qenv() - testthat::expect_error(q@.xData$x <- 1, "cannot add bindings to a locked environment") -}) From 1e25681044330865a05be0269cea1b2688fbddeb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 5 Nov 2024 14:54:59 +0000 Subject: [PATCH 43/56] pr: apply suggestions (remove duplicate test) --- tests/testthat/test-qenv_eval_code.R | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R index 2a9d553f..73403931 100644 --- a/tests/testthat/test-qenv_eval_code.R +++ b/tests/testthat/test-qenv_eval_code.R @@ -15,16 +15,6 @@ testthat::test_that("eval_code doesn't have access to environment where it's cal ) }) -testthat::test_that("@.xData in qenv is always a sibling of .GlobalEnv", { - q1 <- qenv() - testthat::expect_identical(parent.env(q1@.xData), parent.env(.GlobalEnv)) - - q2 <- eval_code(q1, quote(a <- 1L)) - testthat::expect_identical(parent.env(q2@.xData), parent.env(.GlobalEnv)) - q3 <- eval_code(q2, quote(b <- 2L)) - testthat::expect_identical(parent.env(q3@.xData), parent.env(.GlobalEnv)) -}) - testthat::test_that("getting object from the package namespace works even if library in the same call", { testthat::expect_s4_class( eval_code( From 7b7ae6aebb0e243ea6a31fc805081e975797a81d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 5 Nov 2024 16:28:35 +0100 Subject: [PATCH 44/56] Update R/qenv-join.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Dawid Kałędkowski Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/qenv-join.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/qenv-join.R b/R/qenv-join.R index 940541d7..cccab5da 100644 --- a/R/qenv-join.R +++ b/R/qenv-join.R @@ -81,7 +81,7 @@ #' x$i # Output: 2 #' y$i # Output: 3 #' ``` -#' `c()` and `join()` fails to provide a proper result because of the temporary variable `i` exists +#' `c()` fails to provide a proper result because of the temporary variable `i` exists #' in both objects but has different value. #' To fix this, we can set `i <- NULL` in the code expression for both objects. #' ```r From 7ea19e3fca84e0201f55aaa95f2a1ac935741bb8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 5 Nov 2024 17:45:30 +0000 Subject: [PATCH 45/56] fix: error with suggestion --- R/qenv-get_var.R | 2 +- man/get_var.Rd | 2 +- man/join.Rd | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R index 98fc7eed..b3959304 100644 --- a/R/qenv-get_var.R +++ b/R/qenv-get_var.R @@ -30,8 +30,8 @@ setGeneric("get_var", function(object, var) { }) setMethod("get_var", signature = c("qenv", "character"), function(object, var) { + lifecycle::deprecate_soft("0.5.1", "get_var()", "base::get()") tryCatch( - lifecycle::deprecate_soft("0.5.1", "get_var()", "get()") get(var, envir = object@.xData, inherits = FALSE), error = function(e) { message(conditionMessage(e)) diff --git a/man/get_var.Rd b/man/get_var.Rd index 625d9801..7b40bbaa 100644 --- a/man/get_var.Rd +++ b/man/get_var.Rd @@ -20,7 +20,7 @@ get_var(object, var) The value of required variable (\code{var}) within \code{qenv} object. } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} by native \R operators/functions: +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} by native \R operators/functions: \code{x[[name]]}, \code{x$name} or \code{\link[=get]{get()}}. Retrieve variables from the \code{qenv} environment. diff --git a/man/join.Rd b/man/join.Rd index 61de2eb1..30d344fd 100644 --- a/man/join.Rd +++ b/man/join.Rd @@ -107,7 +107,7 @@ x$i # Output: 2 y$i # Output: 3 }\if{html}{\out{}} -\code{c()} and \code{join()} fails to provide a proper result because of the temporary variable \code{i} exists +\code{c()} fails to provide a proper result because of the temporary variable \code{i} exists in both objects but has different value. To fix this, we can set \code{i <- NULL} in the code expression for both objects. From bf5ed47862197552375177a50b6da0c916ec3b70 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 5 Nov 2024 18:45:38 +0000 Subject: [PATCH 46/56] fix: tests --- tests/testthat/test-qenv_constructor.R | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-qenv_constructor.R b/tests/testthat/test-qenv_constructor.R index 7b76b218..b0d3db92 100644 --- a/tests/testthat/test-qenv_constructor.R +++ b/tests/testthat/test-qenv_constructor.R @@ -4,7 +4,7 @@ testthat::describe("qenv inherits from environment: ", { }) testthat::it("names() shows nothing on empty environment", { - testthat::expect_identical(names(qenv(), all.names = TRUE), character(0)) + testthat::expect_identical(names(qenv()), character(0)) }) testthat::it("names() shows available objets", { @@ -12,12 +12,20 @@ testthat::describe("qenv inherits from environment: ", { testthat::expect_setequal(names(q), "iris") }) - testthat::it("names() does not show hidden objects", { + testthat::it("names() shows hidden objects", { q <- within(qenv(), { iris <- iris .hidden <- 2 }) - testthat::expect_setequal(names(q), "iris") + testthat::expect_setequal(names(q), c("iris", ".hidden")) + }) + + testthat::it("ls() does not show hidden objects", { + q <- within(qenv(), { + iris <- iris + .hidden <- 2 + }) + testthat::expect_setequal(ls(q), c("iris")) }) testthat::it("ls(all.names = TRUE) show all objects", { From 903a43cf8f25923003c86f8cc1c3cb4fd5e400bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 6 Nov 2024 18:40:15 +0000 Subject: [PATCH 47/56] feat: qenv constructor improvement --- R/qenv-class.R | 43 +++++++++++++++++++++++----- tests/testthat/test-qenv-class.R | 4 +++ tests/testthat/test-qenv_eval_code.R | 2 +- tests/testthat/test-qenv_join.R | 4 +-- 4 files changed, 43 insertions(+), 10 deletions(-) diff --git a/R/qenv-class.R b/R/qenv-class.R index 0d2d6220..ba42b443 100644 --- a/R/qenv-class.R +++ b/R/qenv-class.R @@ -28,14 +28,43 @@ setClass( setMethod( "initialize", "qenv", - function(.Object, .xData = new.env(parent = parent.env(.GlobalEnv)), ...) { # nolint: object_name. - # .xData needs to be unnamed as the `.environment` constructure requires 1 - # unnamed formal argument. See methods::findMethods("initialize")$.environment - .Object <- methods::callNextMethod(.Object, .xData, ...) # nolint: object_name. + function(.Object, # nolint: object_name. + .xData, # nolint: object_name. + code = character(0L), + warnings = rep("", length(code)), + messages = rep("", length(code)), + id = integer(0L), + ...) { + # # Pre-process parameters to ensure they are ready to be used by parent constructors + stopifnot("`code` must be a character or language object." = any(is.language(code), is.character(code))) - checkmate::assert_environment(.xData) - lockEnvironment(.xData, bindings = TRUE) - .Object@.xData <- .xData # nolint: object_name. + if (is.language(code)) { + code <- paste(lang2calls(code), collapse = "\n") + } + if (length(code)) { + code <- paste(code, collapse = "\n") + } + + if (length(id) == 0L) { + id <- sample.int(.Machine$integer.max, size = length(code)) + } + + new_xdata <- if (rlang::is_missing(.xData)) { + new.env(parent = parent.env(.GlobalEnv)) + } else { + checkmate::assert_environment(.xData) + rlang::env_clone(.xData, parent = parent.env(.GlobalEnv)) + } + lockEnvironment(new_xdata, bindings = TRUE) + + # .xData needs to be unnamed as the `.environment` constructor allows at + # most 1 unnamed formal argument of class `environment`. + # See methods::findMethods("initialize")$.environment + .Object <- methods::callNextMethod( # nolint: object_name. + # Mandatory use of `xData` to build a correct .Object@.xData + .Object, new_xdata, + code = code, messages = messages, warnings = warnings, id = id, ... + ) .Object } diff --git a/tests/testthat/test-qenv-class.R b/tests/testthat/test-qenv-class.R index 9bea4cf9..3be57987 100644 --- a/tests/testthat/test-qenv-class.R +++ b/tests/testthat/test-qenv-class.R @@ -17,4 +17,8 @@ testthat::describe("methods::new(qenv)", { testthat::it("throws error when .xData is not an environment", { expect_error(methods::new("qenv", .xData = 2), "Must be an environment, not 'double'\\.") }) + + testthat::it("throws error when code is not language or character object", { + expect_error(methods::new("qenv", code = 2), "`code` must be a character or language object\\.") + }) }) diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R index 73403931..6621615e 100644 --- a/tests/testthat/test-qenv_eval_code.R +++ b/tests/testthat/test-qenv_eval_code.R @@ -2,7 +2,7 @@ testthat::test_that("eval_code evaluates the code in the qenvs environment", { q <- qenv() q1 <- eval_code(q, quote(iris1 <- iris)) q2 <- eval_code(q1, quote(b <- nrow(iris1))) - testthat::expect_identical(get_var(q2, "b"), 150L) + testthat::expect_identical(q2$b, 150L) }) testthat::test_that("eval_code doesn't have access to environment where it's called", { diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R index 36da892a..df40bc71 100644 --- a/tests/testthat/test-qenv_join.R +++ b/tests/testthat/test-qenv_join.R @@ -85,7 +85,7 @@ testthat::test_that("Not possible to join qenvs which share some code when one o q1 <- eval_code(q1, quote(iris2 <- iris)) q2 <- eval_code(q2, quote(mtcars1 <- head(mtcars))) - testthat::expect_error(join(q1, q2)) + testthat::expect_error(c(q1, q2)) }) testthat::test_that("qenv objects are mergeable if they don't share any code (identified by id)", { @@ -93,7 +93,7 @@ testthat::test_that("qenv objects are mergeable if they don't share any code (id q2 <- eval_code(qenv(), code = quote(a1 <- 1)) testthat::expect_true(.check_joinable(q1, q2)) - cq <- join(q1, q2) + cq <- c(q1, q2) testthat::expect_s4_class(cq, "qenv") testthat::expect_equal(cq@.xData, list2env(list(a1 = 1))) testthat::expect_identical(cq@code, c("a1 <- 1", "a1 <- 1")) From f9fef18623c944f686e6b6d518b708fc26eb3e55 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 7 Nov 2024 11:02:24 +0100 Subject: [PATCH 48/56] Update tests/testthat/test-qenv-class.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Dawid Kałędkowski Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- tests/testthat/test-qenv-class.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/testthat/test-qenv-class.R b/tests/testthat/test-qenv-class.R index 3be57987..333e78a1 100644 --- a/tests/testthat/test-qenv-class.R +++ b/tests/testthat/test-qenv-class.R @@ -21,4 +21,7 @@ testthat::describe("methods::new(qenv)", { testthat::it("throws error when code is not language or character object", { expect_error(methods::new("qenv", code = 2), "`code` must be a character or language object\\.") }) + testthat::it("initialized qenv(s) have different environments", { + testthat::expect_false(identical(qenv()@.xData, qenv()@.xData)) + }) }) From 3bd3ff533e3dff36b517f824968652235d54e820 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Thu, 7 Nov 2024 10:04:31 +0000 Subject: [PATCH 49/56] [skip style] [skip vbump] Restyle files --- tests/testthat/test-qenv-class.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-qenv-class.R b/tests/testthat/test-qenv-class.R index 333e78a1..083d37e0 100644 --- a/tests/testthat/test-qenv-class.R +++ b/tests/testthat/test-qenv-class.R @@ -22,6 +22,6 @@ testthat::describe("methods::new(qenv)", { expect_error(methods::new("qenv", code = 2), "`code` must be a character or language object\\.") }) testthat::it("initialized qenv(s) have different environments", { - testthat::expect_false(identical(qenv()@.xData, qenv()@.xData)) + testthat::expect_false(identical(qenv()@.xData, qenv()@.xData)) }) }) From d8d1a8e47e4e11575fd8f56fad177d66326f4e0d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 7 Nov 2024 10:11:40 +0000 Subject: [PATCH 50/56] chore: trigger CI From 236ce593a4291de66c0e008306383b31a7a6b245 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 7 Nov 2024 15:36:35 +0100 Subject: [PATCH 51/56] Update README.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Dawid Kałędkowski Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 599d4a5f..ea58b7aa 100644 --- a/README.md +++ b/README.md @@ -64,7 +64,7 @@ my_qenv #> • x: [L] as.environment(my_qenv) #> -names(my_qenv)) +names(my_qenv) #> [1] "x" ``` From 4564f34046ca604f39808323cff580aaff226bba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 7 Nov 2024 15:49:54 +0100 Subject: [PATCH 52/56] Update R/qenv-get_env.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Dawid Kałędkowski Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/qenv-get_env.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/qenv-get_env.R b/R/qenv-get_env.R index 53615f95..e8af7aeb 100644 --- a/R/qenv-get_env.R +++ b/R/qenv-get_env.R @@ -14,7 +14,7 @@ #' }) #' get_env(q1) #' -#' names(get_env(q1)) # list objects in the environment +#' names(q1) # list objects #' #' @aliases get_env,qenv-method #' @aliases get_env,qenv.error-method From 9f76e480c87c8add20d7626b9bc66e51bb1aefcf Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Thu, 7 Nov 2024 14:51:56 +0000 Subject: [PATCH 53/56] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update --- man/get_env.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/get_env.Rd b/man/get_env.Rd index 3ec07c28..55dcd698 100644 --- a/man/get_env.Rd +++ b/man/get_env.Rd @@ -25,6 +25,6 @@ q1 <- within(q, { }) get_env(q1) -names(get_env(q1)) # list objects in the environment +names(q1) # list objects } From 49e49c9472d103db9707c58f42b7c592fc0e6de7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 7 Nov 2024 15:53:23 +0100 Subject: [PATCH 54/56] fix: remove unnecessary listing MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/qenv-get_env.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/qenv-get_env.R b/R/qenv-get_env.R index e8af7aeb..bb37aedf 100644 --- a/R/qenv-get_env.R +++ b/R/qenv-get_env.R @@ -14,8 +14,6 @@ #' }) #' get_env(q1) #' -#' names(q1) # list objects -#' #' @aliases get_env,qenv-method #' @aliases get_env,qenv.error-method #' From 1f4b7557dbabc5a82fb4b8cd49b3a57d08415483 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Thu, 7 Nov 2024 14:55:28 +0000 Subject: [PATCH 55/56] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update --- man/get_env.Rd | 2 -- 1 file changed, 2 deletions(-) diff --git a/man/get_env.Rd b/man/get_env.Rd index 55dcd698..d2333f8d 100644 --- a/man/get_env.Rd +++ b/man/get_env.Rd @@ -25,6 +25,4 @@ q1 <- within(q, { }) get_env(q1) -names(q1) # list objects - } From a5fcb9ac26c22d8eee15e16b0a357a0a6dbb5ade Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 7 Nov 2024 14:56:36 +0000 Subject: [PATCH 56/56] chore: trigger CI