From 03d5b7eae69f76897896ca526fda7811441ee290 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, 23 Nov 2023 11:23:53 +0100 Subject: [PATCH 01/28] quick prototype for eval_code and teal --- NAMESPACE | 5 ++- R/teal_data_module.R | 54 ++++++++++++++++++++++++++ man/eval_code.Rd | 32 ++++++++++++++++ man/init.Rd | 4 +- man/srv_teal_with_splash.Rd | 4 +- man/tdata.Rd | 2 +- man/ui_teal_with_splash.Rd | 4 +- man/within.teal_data_module.Rd | 70 ++++++++++++++++++++++++++++++++++ 8 files changed, 167 insertions(+), 8 deletions(-) create mode 100644 man/eval_code.Rd create mode 100644 man/within.teal_data_module.Rd diff --git a/NAMESPACE b/NAMESPACE index 9bc9a00682..e5eefb852d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,6 @@ # Generated by roxygen2: do not edit by hand S3method(c,teal_slices) -S3method(get_code,tdata) S3method(get_metadata,default) S3method(get_metadata,tdata) S3method(join_keys,tdata) @@ -15,10 +14,12 @@ S3method(toString,teal_modules) S3method(ui_nested_tabs,default) S3method(ui_nested_tabs,teal_module) S3method(ui_nested_tabs,teal_modules) +S3method(within,teal_data_module) export("%>%") export(TealReportCard) export(as.teal_slices) export(example_module) +export(get_code.tdata) export(get_code_tdata) export(get_metadata) export(init) @@ -42,6 +43,7 @@ export(validate_inputs) export(validate_n_levels) export(validate_no_intersection) export(validate_one_row_per_id) +exportMethods(eval_code) import(shiny) import(teal.data) import(teal.slice) @@ -49,3 +51,4 @@ import(teal.transform) importFrom(lifecycle,deprecate_soft) importFrom(magrittr,"%>%") importFrom(stats,setNames) +importMethodsFrom(teal.code,eval_code) diff --git a/R/teal_data_module.R b/R/teal_data_module.R index 5f63395fca..cf1f66b704 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -50,3 +50,57 @@ teal_data_module <- function(ui, server) { class = "teal_data_module" ) } + +setOldClass("teal_data_module") + +#' @name eval_code +#' @inherit teal.code::eval_code +#' @importMethodsFrom teal.code eval_code +#' @export +setMethod("eval_code", signature = c("teal_data_module", "character"), function(object, code) { + teal_data_module( + ui = function(id) { + ns <- NS(id) + object$ui(ns("mutate_inner")) + }, + server = function(id) { + moduleServer(id, function(input, output, session) { + data <- object$server("mutate_inner") + eventReactive(data(), { + eval_code(data(), code) + }) + }) + } + ) +}) + +#' @rdname eval_code +#' @export +setMethod("eval_code", signature = c("teal_data_module", "language"), function(object, code) { + eval_code(object, code = teal.code:::format_expression(code)) +}) + +#' @rdname eval_code +#' @export +setMethod("eval_code", signature = c("teal_data_module", "expression"), function(object, code) { + eval_code(object, code = teal.code:::format_expression(code)) +}) + +#' @inherit teal.code::within.qenv +#' @export +within.teal_data_module <- function(data, expr, ...) { + expr <- substitute(expr) + extras <- list(...) + + # Add braces for consistency. + if (!identical(as.list(expr)[[1L]], as.symbol("{"))) { + expr <- call("{", expr) + } + + calls <- as.list(expr)[-1] + + # Inject extra values into expressions. + calls <- lapply(calls, function(x) do.call(substitute, list(x, env = extras))) + + eval_code(object = data, code = as.expression(calls)) +} diff --git a/man/eval_code.Rd b/man/eval_code.Rd new file mode 100644 index 0000000000..7c59a0fb2b --- /dev/null +++ b/man/eval_code.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/teal_data_module.R +\name{eval_code} +\alias{eval_code} +\alias{eval_code,teal_data_module,language-method} +\alias{eval_code,teal_data_module,expression-method} +\title{Evaluate the code in the \code{qenv} environment} +\usage{ +\S4method{eval_code}{teal_data_module,character}(object, code) + +\S4method{eval_code}{teal_data_module,language}(object, code) + +\S4method{eval_code}{teal_data_module,expression}(object, code) +} +\arguments{ +\item{object}{(\code{qenv})} + +\item{code}{(\code{character} or \code{language}) code to evaluate. Also accepts and stores comments} +} +\value{ +\code{qenv} object. +} +\description{ +Given code is evaluated in the \code{qenv} environment and appended to the \code{code} slot. This means +that state of the environment is always a result of the stored code (if \code{qenv} was initialized) +with reproducible code. +} +\examples{ +q1 <- new_qenv(env = list2env(list(a = 1)), code = quote(a <- 1)) +q2 <- eval_code(q1, quote(library(checkmate))) +q3 <- eval_code(q2, quote(assert_number(a))) +} diff --git a/man/init.Rd b/man/init.Rd index 0e7ef57199..e86008eeed 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -18,8 +18,8 @@ init( \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} or \code{MultiAssayExperiment}, \code{teal_data}, \code{teal_data_module})\cr \code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, -\code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or -\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or +\code{\link[teal.data:TealData]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset_connector()}} or +\code{\link[teal.data:TealData]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} or a list of the previous objects or function returning a named list. NOTE: teal does not guarantee reproducibility of the code when names of the list elements diff --git a/man/srv_teal_with_splash.Rd b/man/srv_teal_with_splash.Rd index 9b1d4312d1..9f2a11ec85 100644 --- a/man/srv_teal_with_splash.Rd +++ b/man/srv_teal_with_splash.Rd @@ -17,8 +17,8 @@ is then preferred to this function.} \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} or \code{MultiAssayExperiment}, \code{teal_data}, \code{teal_data_module})\cr \code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, -\code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or -\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or +\code{\link[teal.data:TealData]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset_connector()}} or +\code{\link[teal.data:TealData]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} or a list of the previous objects or function returning a named list. NOTE: teal does not guarantee reproducibility of the code when names of the list elements diff --git a/man/tdata.Rd b/man/tdata.Rd index d686b0f621..7c4c7a2ef1 100644 --- a/man/tdata.Rd +++ b/man/tdata.Rd @@ -8,7 +8,7 @@ \usage{ new_tdata(data, code = "", join_keys = NULL, metadata = NULL) -\method{get_code}{tdata}(x, ...) +get_code.tdata(x, ...) } \arguments{ \item{data}{A \verb{named list} of \code{data.frames} (or \code{MultiAssayExperiment}) diff --git a/man/ui_teal_with_splash.Rd b/man/ui_teal_with_splash.Rd index 29396ed74c..0fe8a246a7 100644 --- a/man/ui_teal_with_splash.Rd +++ b/man/ui_teal_with_splash.Rd @@ -19,8 +19,8 @@ module id} \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} or \code{MultiAssayExperiment}, \code{teal_data}, \code{teal_data_module})\cr \code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, -\code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or -\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or +\code{\link[teal.data:TealData]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset_connector()}} or +\code{\link[teal.data:TealData]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} or a list of the previous objects or function returning a named list. NOTE: teal does not guarantee reproducibility of the code when names of the list elements diff --git a/man/within.teal_data_module.Rd b/man/within.teal_data_module.Rd new file mode 100644 index 0000000000..217d057ad1 --- /dev/null +++ b/man/within.teal_data_module.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/teal_data_module.R +\name{within.teal_data_module} +\alias{within.teal_data_module} +\title{Evaluate expression in \code{qenv} object.} +\usage{ +\method{within}{teal_data_module}(data, expr, ...) +} +\arguments{ +\item{data}{\code{qenv} object} + +\item{expr}{\code{expression} to evaluate} + +\item{...}{\code{name:value} pairs to inject values into \code{expr}} +} +\value{ +Returns a \code{qenv} object with \code{expr} evaluated. If evaluation raises an error, a \code{qenv.error} is returned. +} +\description{ +Convenience function for evaluating inline code inside the environment of a \code{qenv}. +} +\details{ +This is a wrapper for \code{eval_code} that provides a simplified way of passing code for evaluation. +It 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}. +} +\section{Using language objects}{ + + +Passing language objects to \code{expr} is generally not intended but can be achieved with \code{do.call}. +Only single \code{expression}s will work and substitution is not available. See examples. + +} + +\examples{ +q <- new_qenv() + +# execute code +q <- within(q, { + i <- iris +}) +q <- within(q, { + m <- mtcars + f <- faithful +}) +q +get_code(q) + +# inject values into code +q <- new_qenv() +q <- within(q, i <- iris) +within(q, print(dim(subset(i, Species == "virginica")))) +within(q, print(dim(subset(i, Species == species)))) # fails +within(q, print(dim(subset(i, Species == species))), species = "versicolor") +species_external <- "versicolor" +within(q, print(dim(subset(i, Species == species))), species = species_external) + +# pass language objects +expr <- expression(i <- iris, m <- mtcars) +within(q, expr) # fails +do.call(within, list(q, expr)) + +exprlist <- list(expression(i <- iris), expression(m <- mtcars)) +within(q, exprlist) # fails +do.call(within, list(q, do.call(c, exprlist))) +} +\seealso{ +\code{\link[teal.code]{eval_code}}, \code{\link[base:with]{base::within}} +} From dc6739f75e4bf4a3d7cd3c1eba2e0b072fab64c7 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, 28 Nov 2023 12:09:08 +0100 Subject: [PATCH 02/28] feat: adds documentation and tests --- DESCRIPTION | 3 +- NAMESPACE | 2 +- R/teal_data_module-eval_code.R | 90 +++++++++++++ R/teal_data_module.R | 54 -------- R/zzz.R | 4 + man/eval_code.Rd | 20 +-- man/init.Rd | 4 +- man/srv_teal_with_splash.Rd | 4 +- man/tdata.Rd | 2 +- man/ui_teal_with_splash.Rd | 4 +- man/within.teal_data_module.Rd | 59 +++------ .../test-teal_data_module-eval_code.R | 120 ++++++++++++++++++ 12 files changed, 252 insertions(+), 114 deletions(-) create mode 100644 R/teal_data_module-eval_code.R create mode 100644 tests/testthat/test-teal_data_module-eval_code.R diff --git a/DESCRIPTION b/DESCRIPTION index c326ba43b8..591875c482 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -43,6 +43,7 @@ Imports: rlang (>= 1.0.0), shinyjs, stats, + teal.code (>= 0.3.0.9009), teal.logger (>= 0.1.1), teal.reporter (>= 0.2.0), teal.widgets (>= 0.4.0), @@ -56,7 +57,6 @@ Suggests: R6, rmarkdown (>= 2.19), shinyvalidate, - teal.code (>= 0.3.0.9009), testthat (>= 3.1.5), withr (>= 2.1.0), yaml (>= 1.1.0) @@ -98,6 +98,7 @@ Collate: 'show_rcode_modal.R' 'tdata.R' 'teal.R' + 'teal_data_module-eval_code.R' 'teal_data_module.R' 'teal_reporter.R' 'teal_slices-store.R' diff --git a/NAMESPACE b/NAMESPACE index e5eefb852d..45c968501c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand S3method(c,teal_slices) +S3method(get_code,tdata) S3method(get_metadata,default) S3method(get_metadata,tdata) S3method(join_keys,tdata) @@ -19,7 +20,6 @@ export("%>%") export(TealReportCard) export(as.teal_slices) export(example_module) -export(get_code.tdata) export(get_code_tdata) export(get_metadata) export(init) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R new file mode 100644 index 0000000000..49490eb056 --- /dev/null +++ b/R/teal_data_module-eval_code.R @@ -0,0 +1,90 @@ +setOldClass("teal_data_module") + +#' @name eval_code +#' @description +#' Given code is evaluated in the `qenv` environment of `teal_data` reactive defined in `teal_data_module`. +#' +#' @param object (`teal_data_module`) +#' @inherit teal.code::eval_code +#' @importMethodsFrom teal.code eval_code +#' @export +#' @examples +#' tdm <- teal_data_module( +#' ui = function(id) div(id = shiny::NS(id)("div_id")), +#' server = function(id) { +#' shiny::moduleServer(id, function(input, output, session) { +#' shiny::reactive(teal_data(IRIS = iris)) +#' }) +#' } +#' ) +#' \dontrun{ +#' eval_code(tdm, "IRIS <- subset(IRIS, Species == 'virginica')") +#' } +setMethod("eval_code", signature = c("teal_data_module", "character"), function(object, code) { + tdm <- teal_data_module( + ui = function(id) { + ns <- NS(id) + object$ui(ns("mutate_inner")) + }, + server = function(id) { + moduleServer(id, function(input, output, session) { + data <- object$server("mutate_inner") + reactive(eval_code(data(), code)) + }) + } + ) + + attr(tdm, "code") <- paste(c(attr(object, "code"), code), collapse = "\n") + tdm +}) + +#' @rdname eval_code +#' @export +setMethod("eval_code", signature = c("teal_data_module", "language"), function(object, code) { + eval_code(object, code = format_expression(code)) +}) + +#' @rdname eval_code +#' @export +setMethod("eval_code", signature = c("teal_data_module", "expression"), function(object, code) { + eval_code(object, code = format_expression(code)) +}) + +#' @inherit teal.code::within.qenv params title details +#' @description +#' Convenience function for evaluating inline code inside the environment of a +#' `teal_data_module` +#' +#' @param data (`teal_data_module`) object +#' @return Returns a `teal_data_module` object with a delayed evaluation of `expr` +#' when module. +#' @export +#' @seealso [base::within()], [teal_data_module()] +#' @examples +#' tdm <- teal_data_module( +#' ui = function(id) div(id = shiny::NS(id)("div_id")), +#' server = function(id) { +#' shiny::moduleServer(id, function(input, output, session) { +#' shiny::reactive(teal_data(IRIS = iris)) +#' }) +#' } +#' ) +#' \dontrun{ +#' within(tdm, IRIS <- subset(IRIS, Species == "virginica")) +#' } +within.teal_data_module <- function(data, expr, ...) { + expr <- substitute(expr) + extras <- list(...) + + # Add braces for consistency. + if (!identical(as.list(expr)[[1L]], as.symbol("{"))) { + expr <- call("{", expr) + } + + calls <- as.list(expr)[-1] + + # Inject extra values into expressions. + calls <- lapply(calls, function(x) do.call(substitute, list(x, env = extras))) + + eval_code(object = data, code = as.expression(calls)) +} diff --git a/R/teal_data_module.R b/R/teal_data_module.R index cf1f66b704..5f63395fca 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -50,57 +50,3 @@ teal_data_module <- function(ui, server) { class = "teal_data_module" ) } - -setOldClass("teal_data_module") - -#' @name eval_code -#' @inherit teal.code::eval_code -#' @importMethodsFrom teal.code eval_code -#' @export -setMethod("eval_code", signature = c("teal_data_module", "character"), function(object, code) { - teal_data_module( - ui = function(id) { - ns <- NS(id) - object$ui(ns("mutate_inner")) - }, - server = function(id) { - moduleServer(id, function(input, output, session) { - data <- object$server("mutate_inner") - eventReactive(data(), { - eval_code(data(), code) - }) - }) - } - ) -}) - -#' @rdname eval_code -#' @export -setMethod("eval_code", signature = c("teal_data_module", "language"), function(object, code) { - eval_code(object, code = teal.code:::format_expression(code)) -}) - -#' @rdname eval_code -#' @export -setMethod("eval_code", signature = c("teal_data_module", "expression"), function(object, code) { - eval_code(object, code = teal.code:::format_expression(code)) -}) - -#' @inherit teal.code::within.qenv -#' @export -within.teal_data_module <- function(data, expr, ...) { - expr <- substitute(expr) - extras <- list(...) - - # Add braces for consistency. - if (!identical(as.list(expr)[[1L]], as.symbol("{"))) { - expr <- call("{", expr) - } - - calls <- as.list(expr)[-1] - - # Inject extra values into expressions. - calls <- lapply(calls, function(x) do.call(substitute, list(x, env = extras))) - - eval_code(object = data, code = as.expression(calls)) -} diff --git a/R/zzz.R b/R/zzz.R index fbc9c756d9..b8dacf2ec0 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -32,3 +32,7 @@ setdiff_teal_slices <- getFromNamespace("setdiff_teal_slices", "teal.slice") coalesce_r <- getFromNamespace("coalesce_r", "teal.slice") # all *Block objects are private in teal.reporter RcodeBlock <- getFromNamespace("RcodeBlock", "teal.reporter") # nolint + +# Use non-exported function(s) from teal.code +# This one is here because format_expression should not be exported from teal.code +format_expression <- getFromNamespace("format_expression", "teal.code") diff --git a/man/eval_code.Rd b/man/eval_code.Rd index 7c59a0fb2b..c1bc59f75d 100644 --- a/man/eval_code.Rd +++ b/man/eval_code.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/teal_data_module.R +% Please edit documentation in R/teal_data_module-eval_code.R \name{eval_code} \alias{eval_code} \alias{eval_code,teal_data_module,language-method} @@ -13,7 +13,7 @@ \S4method{eval_code}{teal_data_module,expression}(object, code) } \arguments{ -\item{object}{(\code{qenv})} +\item{object}{(\code{teal_data_module})} \item{code}{(\code{character} or \code{language}) code to evaluate. Also accepts and stores comments} } @@ -21,12 +21,16 @@ \code{qenv} object. } \description{ -Given code is evaluated in the \code{qenv} environment and appended to the \code{code} slot. This means -that state of the environment is always a result of the stored code (if \code{qenv} was initialized) -with reproducible code. +Given code is evaluated in the \code{qenv} environment of \code{teal_data} reactive defined in \code{teal_data_module}. } \examples{ -q1 <- new_qenv(env = list2env(list(a = 1)), code = quote(a <- 1)) -q2 <- eval_code(q1, quote(library(checkmate))) -q3 <- eval_code(q2, quote(assert_number(a))) +tdm <- teal_data_module( + ui = function(id) div(id = shiny::NS(id)("div_id")), + server = function(id) shiny::moduleServer(id, function(input, output, session) { + shiny::reactive(teal_data(IRIS = iris)) + }) +) +\dontrun{ +eval_code(tdm, "IRIS <- subset(IRIS, Species == 'virginica')") +} } diff --git a/man/init.Rd b/man/init.Rd index e86008eeed..0e7ef57199 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -18,8 +18,8 @@ init( \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} or \code{MultiAssayExperiment}, \code{teal_data}, \code{teal_data_module})\cr \code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, -\code{\link[teal.data:TealData]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset_connector()}} or -\code{\link[teal.data:TealData]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or +\code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or +\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} or a list of the previous objects or function returning a named list. NOTE: teal does not guarantee reproducibility of the code when names of the list elements diff --git a/man/srv_teal_with_splash.Rd b/man/srv_teal_with_splash.Rd index 9f2a11ec85..9b1d4312d1 100644 --- a/man/srv_teal_with_splash.Rd +++ b/man/srv_teal_with_splash.Rd @@ -17,8 +17,8 @@ is then preferred to this function.} \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} or \code{MultiAssayExperiment}, \code{teal_data}, \code{teal_data_module})\cr \code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, -\code{\link[teal.data:TealData]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset_connector()}} or -\code{\link[teal.data:TealData]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or +\code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or +\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} or a list of the previous objects or function returning a named list. NOTE: teal does not guarantee reproducibility of the code when names of the list elements diff --git a/man/tdata.Rd b/man/tdata.Rd index 7c4c7a2ef1..d686b0f621 100644 --- a/man/tdata.Rd +++ b/man/tdata.Rd @@ -8,7 +8,7 @@ \usage{ new_tdata(data, code = "", join_keys = NULL, metadata = NULL) -get_code.tdata(x, ...) +\method{get_code}{tdata}(x, ...) } \arguments{ \item{data}{A \verb{named list} of \code{data.frames} (or \code{MultiAssayExperiment}) diff --git a/man/ui_teal_with_splash.Rd b/man/ui_teal_with_splash.Rd index 0fe8a246a7..29396ed74c 100644 --- a/man/ui_teal_with_splash.Rd +++ b/man/ui_teal_with_splash.Rd @@ -19,8 +19,8 @@ module id} \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} or \code{MultiAssayExperiment}, \code{teal_data}, \code{teal_data_module})\cr \code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, -\code{\link[teal.data:TealData]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset()}}, \code{\link[teal.data:TealData]{teal.data::dataset_connector()}} or -\code{\link[teal.data:TealData]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or +\code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or +\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or \code{\link[=teal_data_module]{teal_data_module()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} or a list of the previous objects or function returning a named list. NOTE: teal does not guarantee reproducibility of the code when names of the list elements diff --git a/man/within.teal_data_module.Rd b/man/within.teal_data_module.Rd index 217d057ad1..8082ed826a 100644 --- a/man/within.teal_data_module.Rd +++ b/man/within.teal_data_module.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/teal_data_module.R +% Please edit documentation in R/teal_data_module-eval_code.R \name{within.teal_data_module} \alias{within.teal_data_module} \title{Evaluate expression in \code{qenv} object.} @@ -7,17 +7,19 @@ \method{within}{teal_data_module}(data, expr, ...) } \arguments{ -\item{data}{\code{qenv} object} +\item{data}{(\code{teal_data_module}) object} \item{expr}{\code{expression} to evaluate} \item{...}{\code{name:value} pairs to inject values into \code{expr}} } \value{ -Returns a \code{qenv} object with \code{expr} evaluated. If evaluation raises an error, a \code{qenv.error} is returned. +Returns a \code{teal_data_module} object with a delayed evaluation of \code{expr} +when module. } \description{ -Convenience function for evaluating inline code inside the environment of a \code{qenv}. +Convenience function for evaluating inline code inside the environment of a +\code{teal_data_module} } \details{ This is a wrapper for \code{eval_code} that provides a simplified way of passing code for evaluation. @@ -25,46 +27,17 @@ It accepts only inline expressions (both simple and compound) and allows for inj 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{Using language objects}{ - - -Passing language objects to \code{expr} is generally not intended but can be achieved with \code{do.call}. -Only single \code{expression}s will work and substitution is not available. See examples. - -} - \examples{ -q <- new_qenv() - -# execute code -q <- within(q, { - i <- iris -}) -q <- within(q, { - m <- mtcars - f <- faithful -}) -q -get_code(q) - -# inject values into code -q <- new_qenv() -q <- within(q, i <- iris) -within(q, print(dim(subset(i, Species == "virginica")))) -within(q, print(dim(subset(i, Species == species)))) # fails -within(q, print(dim(subset(i, Species == species))), species = "versicolor") -species_external <- "versicolor" -within(q, print(dim(subset(i, Species == species))), species = species_external) - -# pass language objects -expr <- expression(i <- iris, m <- mtcars) -within(q, expr) # fails -do.call(within, list(q, expr)) - -exprlist <- list(expression(i <- iris), expression(m <- mtcars)) -within(q, exprlist) # fails -do.call(within, list(q, do.call(c, exprlist))) +tdm <- teal_data_module( + ui = function(id) div(id = shiny::NS(id)("div_id")), + server = function(id) shiny::moduleServer(id, function(input, output, session) { + shiny::reactive(teal_data(IRIS = iris)) + }) +) +\dontrun{ +within(tdm, IRIS <- subset(IRIS, Species == "virginica")) +} } \seealso{ -\code{\link[teal.code]{eval_code}}, \code{\link[base:with]{base::within}} +\code{\link[base:with]{base::within()}}, \code{\link[=teal_data_module]{teal_data_module()}} } diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R new file mode 100644 index 0000000000..a5ca33f641 --- /dev/null +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -0,0 +1,120 @@ +testthat::test_that("within.teal_data_module returns an object with teal_data_module class", { + tdm <- teal_data_module( + ui = function(id) div(), + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::reactive(teal.data::teal_data(IRIS = iris)) + }) + } + ) + + tdm2 <- within(tdm, IRIS$id <- seq(NROW(IRIS))) + + testthat::expect_s3_class(tdm2, "teal_data_module") +}) + +testthat::test_that("eval_code.teal_data_module ui is kept the same with modified namespace", { + tdm <- teal_data_module( + ui = function(id) { + ns <- NS(id) + div(id = ns("element")) + }, + server = function(id) NULL + ) + + tdm2 <- within(tdm, 1 + 1) + + output_ui <- tdm2$ui("top_level_ns") + + testthat::expect_match(output_ui$attribs$id, "^top_level_ns-") + testthat::expect_match(output_ui$attribs$id, "-element$") + testthat::expect_match(output_ui$attribs$id, "-mutate_inner-") +}) + +testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data object with expression", { + testthat::local_mocked_bindings( + getDefaultReactiveDomain = function() shiny::MockShinySession$new(), + .package = "shiny" + ) + + tdm <- teal_data_module( + ui = function(id) div(), + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::reactive(teal.data::teal_data(IRIS = iris)) + }) + } + ) + + tdm2 <- eval_code(tdm, expression(IRIS$id <- seq(NROW(IRIS)))) + + # Columns were added via eval_code.teal_data_module + testthat::expect_setequal( + c(names(iris), "id"), + colnames(shiny::isolate(tdm2$server("test")()[["IRIS"]])) + ) +}) + +testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data object with quoted", { + testthat::local_mocked_bindings( + getDefaultReactiveDomain = function() shiny::MockShinySession$new(), + .package = "shiny" + ) + + tdm <- teal_data_module( + ui = function(id) div(), + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::reactive(teal.data::teal_data(IRIS = iris)) + }) + } + ) + + tdm2 <- eval_code(tdm, quote(IRIS$id <- seq(NROW(IRIS)))) + + # Columns were added via eval_code.teal_data_module + testthat::expect_setequal( + c(names(iris), "id"), + colnames(shiny::isolate(tdm2$server("test")()[["IRIS"]])) + ) +}) + +testthat::test_that("within.teal_data_module modifies the reactive tea_data object", { + testthat::local_mocked_bindings( + getDefaultReactiveDomain = function() shiny::MockShinySession$new(), + .package = "shiny" + ) + + tdm <- teal_data_module( + ui = function(id) div(), + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::reactive(teal.data::teal_data(IRIS = iris)) + }) + } + ) + + tdm2 <- within(tdm, IRIS$id <- seq(NROW(IRIS))) + + # teal_data_modules are different + testthat::expect_failure( + testthat::expect_identical( + shiny::isolate(tdm$server("test")()[["IRIS"]]), + shiny::isolate(tdm2$server("test")()[["IRIS"]]) + ) + ) + + # Columns were added via within.teal_data_module + testthat::expect_setequal( + c(names(iris), "id"), + colnames(shiny::isolate(tdm2$server("test")()[["IRIS"]])) + ) + + # Original teal_data_module was left untouched + testthat::expect_failure( + testthat::expect_setequal( + c(names(iris), "id"), + colnames(shiny::isolate(tdm$server("test")()[["IRIS"]])) + ) + ) +}) From 293f25a2bea4cc33e8fdca45ee958bcbcfeb75aa 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, 28 Nov 2023 12:27:27 +0100 Subject: [PATCH 03/28] remove code attribute --- R/teal_data_module-eval_code.R | 5 +---- man/eval_code.Rd | 8 +++++--- man/within.teal_data_module.Rd | 8 +++++--- 3 files changed, 11 insertions(+), 10 deletions(-) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index 49490eb056..62890b8bd4 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -21,7 +21,7 @@ setOldClass("teal_data_module") #' eval_code(tdm, "IRIS <- subset(IRIS, Species == 'virginica')") #' } setMethod("eval_code", signature = c("teal_data_module", "character"), function(object, code) { - tdm <- teal_data_module( + teal_data_module( ui = function(id) { ns <- NS(id) object$ui(ns("mutate_inner")) @@ -33,9 +33,6 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function( }) } ) - - attr(tdm, "code") <- paste(c(attr(object, "code"), code), collapse = "\n") - tdm }) #' @rdname eval_code diff --git a/man/eval_code.Rd b/man/eval_code.Rd index c1bc59f75d..7f49622938 100644 --- a/man/eval_code.Rd +++ b/man/eval_code.Rd @@ -26,9 +26,11 @@ Given code is evaluated in the \code{qenv} environment of \code{teal_data} react \examples{ tdm <- teal_data_module( ui = function(id) div(id = shiny::NS(id)("div_id")), - server = function(id) shiny::moduleServer(id, function(input, output, session) { - shiny::reactive(teal_data(IRIS = iris)) - }) + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::reactive(teal_data(IRIS = iris)) + }) + } ) \dontrun{ eval_code(tdm, "IRIS <- subset(IRIS, Species == 'virginica')") diff --git a/man/within.teal_data_module.Rd b/man/within.teal_data_module.Rd index 8082ed826a..78ba3aa33c 100644 --- a/man/within.teal_data_module.Rd +++ b/man/within.teal_data_module.Rd @@ -30,9 +30,11 @@ through the \code{...} argument: as \code{name:value} pairs are passed to \code{ \examples{ tdm <- teal_data_module( ui = function(id) div(id = shiny::NS(id)("div_id")), - server = function(id) shiny::moduleServer(id, function(input, output, session) { - shiny::reactive(teal_data(IRIS = iris)) - }) + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::reactive(teal_data(IRIS = iris)) + }) + } ) \dontrun{ within(tdm, IRIS <- subset(IRIS, Species == "virginica")) From 3a8579d5487b21c661ad267522cbdd272b02c17a 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, 28 Nov 2023 12:52:42 +0100 Subject: [PATCH 04/28] docs: corrects documentation to pass checks --- R/teal_data_module-eval_code.R | 9 +++++++-- man/eval_code.Rd | 5 +++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index 62890b8bd4..7e2fabda5b 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -1,13 +1,18 @@ setOldClass("teal_data_module") +#' Evaluate the code in the qenv environment #' @name eval_code #' @description #' Given code is evaluated in the `qenv` environment of `teal_data` reactive defined in `teal_data_module`. -#' #' @param object (`teal_data_module`) -#' @inherit teal.code::eval_code +#' @inheritParams teal.code::eval_code +#' @return Returns a `teal_data_module` object. #' @importMethodsFrom teal.code eval_code +NULL + +#' @rdname eval_code #' @export +#' #' @examples #' tdm <- teal_data_module( #' ui = function(id) div(id = shiny::NS(id)("div_id")), diff --git a/man/eval_code.Rd b/man/eval_code.Rd index 7f49622938..dc70e27b3c 100644 --- a/man/eval_code.Rd +++ b/man/eval_code.Rd @@ -2,9 +2,10 @@ % Please edit documentation in R/teal_data_module-eval_code.R \name{eval_code} \alias{eval_code} +\alias{eval_code,teal_data_module,character-method} \alias{eval_code,teal_data_module,language-method} \alias{eval_code,teal_data_module,expression-method} -\title{Evaluate the code in the \code{qenv} environment} +\title{Evaluate the code in the qenv environment} \usage{ \S4method{eval_code}{teal_data_module,character}(object, code) @@ -18,7 +19,7 @@ \item{code}{(\code{character} or \code{language}) code to evaluate. Also accepts and stores comments} } \value{ -\code{qenv} object. +Returns a \code{teal_data_module} object. } \description{ Given code is evaluated in the \code{qenv} environment of \code{teal_data} reactive defined in \code{teal_data_module}. From c04eb56e44230c4aef865ba98a65d19386fd22c4 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, 28 Nov 2023 13:52:43 +0100 Subject: [PATCH 05/28] checks: corrects note with methods --- DESCRIPTION | 1 + NAMESPACE | 1 + R/teal_data_module-eval_code.R | 1 + 3 files changed, 3 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 591875c482..0fa65bf8f2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,6 +40,7 @@ Imports: lifecycle (>= 0.2.0), logger (>= 0.2.0), magrittr (>= 1.5), + methods, rlang (>= 1.0.0), shinyjs, stats, diff --git a/NAMESPACE b/NAMESPACE index 45c968501c..237124e2d1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -50,5 +50,6 @@ import(teal.slice) import(teal.transform) importFrom(lifecycle,deprecate_soft) importFrom(magrittr,"%>%") +importFrom(methods,setMethod) importFrom(stats,setNames) importMethodsFrom(teal.code,eval_code) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index 7e2fabda5b..fd5c9a33bd 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -8,6 +8,7 @@ setOldClass("teal_data_module") #' @inheritParams teal.code::eval_code #' @return Returns a `teal_data_module` object. #' @importMethodsFrom teal.code eval_code +#' @importFrom methods setMethod NULL #' @rdname eval_code From 2992271aef04e62f4f73558dad9e281046f156c3 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, 28 Nov 2023 14:21:17 +0100 Subject: [PATCH 06/28] lintr: ignores name linter and implements suggestion --- tests/testthat/test-teal_data_module-eval_code.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index a5ca33f641..6aef36984c 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -8,7 +8,7 @@ testthat::test_that("within.teal_data_module returns an object with teal_data_mo } ) - tdm2 <- within(tdm, IRIS$id <- seq(NROW(IRIS))) + tdm2 <- within(tdm, IRIS$id <- seq_len(nrow(IRIS))) # nolint: object_name_linter. testthat::expect_s3_class(tdm2, "teal_data_module") }) @@ -46,7 +46,7 @@ testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data } ) - tdm2 <- eval_code(tdm, expression(IRIS$id <- seq(NROW(IRIS)))) + tdm2 <- eval_code(tdm, expression(IRIS$id <- seq_len(nrow(IRIS)))) # nolint: object_name_linter. # Columns were added via eval_code.teal_data_module testthat::expect_setequal( @@ -70,7 +70,7 @@ testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data } ) - tdm2 <- eval_code(tdm, quote(IRIS$id <- seq(NROW(IRIS)))) + tdm2 <- eval_code(tdm, quote(IRIS$id <- seq_len(nrow(IRIS)))) # nolint: object_name. # Columns were added via eval_code.teal_data_module testthat::expect_setequal( @@ -94,7 +94,7 @@ testthat::test_that("within.teal_data_module modifies the reactive tea_data obje } ) - tdm2 <- within(tdm, IRIS$id <- seq(NROW(IRIS))) + tdm2 <- within(tdm, IRIS$id <- seq_len(nrow(IRIS))) # nolint: object_name_linter. # teal_data_modules are different testthat::expect_failure( From f65a38921bf4ffb808ccd4a71c185931c5d6b9ee 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, 28 Nov 2023 14:40:22 +0100 Subject: [PATCH 07/28] docs: updates pkgdown --- _pkgdown.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index eb95ee303d..0ebf24ff57 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -118,6 +118,8 @@ reference: - get_code_tdata - get_metadata - tdata2env + - eval_code + - within.teal_data_module - show_rcode_modal - join_keys.tdata # - title: Functions Moved to Other Packages From d8a095ed1a629c54573e800fecd0420a07fe44b0 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, 28 Nov 2023 14:55:21 +0100 Subject: [PATCH 08/28] fix: corrects example --- R/teal_data_module.R | 2 +- man/teal_data_module.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/teal_data_module.R b/R/teal_data_module.R index 5f63395fca..465e240eb2 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -34,7 +34,7 @@ #' dataset2 <- mtcars #' } #' ) -#' datanames(data) <- c("iris", "mtcars") +#' datanames(data) <- c("dataset1", "dataset2") #' #' data #' }) diff --git a/man/teal_data_module.Rd b/man/teal_data_module.Rd index 3eb672bcda..6bf39fb807 100644 --- a/man/teal_data_module.Rd +++ b/man/teal_data_module.Rd @@ -45,7 +45,7 @@ data <- teal_data_module( dataset2 <- mtcars } ) - datanames(data) <- c("iris", "mtcars") + datanames(data) <- c("dataset1", "dataset2") data }) From 417c2ee7de4f58229128ae841b10c4b854b952be 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, 28 Nov 2023 15:25:03 +0100 Subject: [PATCH 09/28] fix: use event_reactive to avoid problems when data is NULL --- R/teal_data_module-eval_code.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index fd5c9a33bd..5e4b341b30 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -35,7 +35,12 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function( server = function(id) { moduleServer(id, function(input, output, session) { data <- object$server("mutate_inner") - reactive(eval_code(data(), code)) + eventReactive(data(), + { + eval_code(data(), code) + }, + ignoreNULL = TRUE + ) }) } ) From 9605f055c7f54c7d34fbdef63540e43087f026ce 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, 28 Nov 2023 15:49:01 +0100 Subject: [PATCH 10/28] docs: update teal_data_module vignette --- vignettes/data-as-shiny-module.Rmd | 36 +++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd index 66ae5cb9e1..4a5d9a87e2 100644 --- a/vignettes/data-as-shiny-module.Rmd +++ b/vignettes/data-as-shiny-module.Rmd @@ -15,6 +15,7 @@ vignette: > Proper functioning of any `teal` application requires presence of a `teal_data` object. Typically, a `teal_data` object created in the global environment will be passed to the `data` argument in `init`. This `teal_data` object should contain all elements necessary for successful execution of the application's modules. + In some scenarios, however, application developers may opt to postpone some data operations until the application run time. This can be done by passing a special _`shiny` module_ to the `data` argument. The `teal_data_module` function is used to build such a module from the following components: @@ -67,7 +68,7 @@ if (interactive()) { ``` -## Modification Data In-App +## Modification of Data In-App Another reason to postpone data operations is to allow the application user to act the preprocessing stage. An initial, constant form of the data can be created in the global environment and then modified once the app starts. @@ -124,3 +125,36 @@ It is recommended to keep the constant code in the global environment and to mov When using `teal_data_module` to modify a pre-existing `teal_data` object it is crucial that the server function and the data object are defined in the same environment as otherwise the server function will not be able to access the data object. This means server functions defined in packages cannot be used. + +### Extending existing `teal_data_modules` + +The `teal_data_module` can be further modified outside of the initial `shiny` module and processed after user inputs. +The `within` function allows to process at runtime the data in the `teal_data` object contained in `teal_data_module`. + +Building on the previous example, the `data_mod` is handled as a generic connector and here new columns are added once the data is retrieved. + +```{r} +data_mod_2 <- within( + data_mod, + { + # Create new column with Ratio of Sepal.Width and Petal.Width + dataset1$Ratio.Sepal.Petal.Width <- round(dataset1$Sepal.Width / dataset1$Petal.Width, digits = 2L) + # Create new column that converts Miles per Galon to Liter per 100 Km + dataset2$lp100km <- round(dataset2$mpg * 0.42514371, digits = 2L) + dataset2 <- dplyr::relocate( + dataset2, + "lp100km", + .after = "mpg" + ) + } +) + +app <- init( + data = data_mod_2, + module = example_module() +) + +if (interactive()) { + shinyApp(app$ui, app$server) +} +``` From fa6ef28e9a8d0c70e1c56a74e2deb769d529b617 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, 28 Nov 2023 16:30:03 +0100 Subject: [PATCH 11/28] tests: minor changes --- tests/testthat/test-teal_data_module-eval_code.R | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index 6aef36984c..bcb80efb0d 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -13,7 +13,7 @@ testthat::test_that("within.teal_data_module returns an object with teal_data_mo testthat::expect_s3_class(tdm2, "teal_data_module") }) -testthat::test_that("eval_code.teal_data_module ui is kept the same with modified namespace", { +testthat::test_that("eval_code.teal_data_module ui has modified namespace for id", { tdm <- teal_data_module( ui = function(id) { ns <- NS(id) @@ -31,7 +31,7 @@ testthat::test_that("eval_code.teal_data_module ui is kept the same with modifie testthat::expect_match(output_ui$attribs$id, "-mutate_inner-") }) -testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data object with expression", { +testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data object with expression parameter", { testthat::local_mocked_bindings( getDefaultReactiveDomain = function() shiny::MockShinySession$new(), .package = "shiny" @@ -55,7 +55,7 @@ testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data ) }) -testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data object with quoted", { +testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data object with quoted parameter", { testthat::local_mocked_bindings( getDefaultReactiveDomain = function() shiny::MockShinySession$new(), .package = "shiny" @@ -111,10 +111,8 @@ testthat::test_that("within.teal_data_module modifies the reactive tea_data obje ) # Original teal_data_module was left untouched - testthat::expect_failure( - testthat::expect_setequal( - c(names(iris), "id"), - colnames(shiny::isolate(tdm$server("test")()[["IRIS"]])) - ) + testthat::expect_setequal( + c(names(iris)), + colnames(shiny::isolate(tdm$server("test")()[["IRIS"]])) ) }) From 8bf8aaa12f1e5a4f9972b1f439f9f4a64780030e 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 Dec 2023 13:53:38 +0100 Subject: [PATCH 12/28] fix: only performs eval_code if teal_data --- R/teal_data_module-eval_code.R | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index 5e4b341b30..7dcf8fa7d1 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -34,10 +34,21 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function( }, server = function(id) { moduleServer(id, function(input, output, session) { - data <- object$server("mutate_inner") - eventReactive(data(), + teal_data_rv <- object$server("mutate_inner") + + if (!is.reactive(teal_data_rv)) { + stop("The `teal_data_module` must return a reactive expression.", call. = FALSE) + } + + eventReactive(teal_data_rv(), { - eval_code(data(), code) + data <- tryCatch(teal_data_rv(), error = function(e) e) + + if (inherits(data, "teal_data")) { + eval_code(data, code) + } else { + data + } }, ignoreNULL = TRUE ) From 51dcadff6f01851a0ece81ba8bd120ffd81eaec0 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 Dec 2023 14:41:29 +0100 Subject: [PATCH 13/28] tests: implement @gogonzo suggestion about indirect tests --- .../test-teal_data_module-eval_code.R | 45 ++----------------- 1 file changed, 3 insertions(+), 42 deletions(-) diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index bcb80efb0d..2b4a9912ed 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -55,30 +55,6 @@ testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data ) }) -testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data object with quoted parameter", { - testthat::local_mocked_bindings( - getDefaultReactiveDomain = function() shiny::MockShinySession$new(), - .package = "shiny" - ) - - tdm <- teal_data_module( - ui = function(id) div(), - server = function(id) { - shiny::moduleServer(id, function(input, output, session) { - shiny::reactive(teal.data::teal_data(IRIS = iris)) - }) - } - ) - - tdm2 <- eval_code(tdm, quote(IRIS$id <- seq_len(nrow(IRIS)))) # nolint: object_name. - - # Columns were added via eval_code.teal_data_module - testthat::expect_setequal( - c(names(iris), "id"), - colnames(shiny::isolate(tdm2$server("test")()[["IRIS"]])) - ) -}) - testthat::test_that("within.teal_data_module modifies the reactive tea_data object", { testthat::local_mocked_bindings( getDefaultReactiveDomain = function() shiny::MockShinySession$new(), @@ -96,23 +72,8 @@ testthat::test_that("within.teal_data_module modifies the reactive tea_data obje tdm2 <- within(tdm, IRIS$id <- seq_len(nrow(IRIS))) # nolint: object_name_linter. - # teal_data_modules are different - testthat::expect_failure( - testthat::expect_identical( - shiny::isolate(tdm$server("test")()[["IRIS"]]), - shiny::isolate(tdm2$server("test")()[["IRIS"]]) - ) - ) - - # Columns were added via within.teal_data_module - testthat::expect_setequal( - c(names(iris), "id"), - colnames(shiny::isolate(tdm2$server("test")()[["IRIS"]])) - ) - - # Original teal_data_module was left untouched - testthat::expect_setequal( - c(names(iris)), - colnames(shiny::isolate(tdm$server("test")()[["IRIS"]])) + testthat::expect_identical( + shiny::isolate(tdm2$server("test")()[["IRIS"]]), + within(iris, id <- seq_len(NROW(Species))) ) }) From da3c100e35d43dc1cd3a5cbf996abe897137d551 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 Dec 2023 15:32:34 +0100 Subject: [PATCH 14/28] fix: eval_code only accepts teal_data or propagates error messages --- R/teal_data_module-eval_code.R | 17 ++- .../test-teal_data_module-eval_code.R | 122 ++++++++++++++++++ 2 files changed, 138 insertions(+), 1 deletion(-) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index 7dcf8fa7d1..b0cc81f981 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -46,8 +46,23 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function( if (inherits(data, "teal_data")) { eval_code(data, code) - } else { + } else if (inherits(data, "error")) { data + } else { + validate( + need( + FALSE, + paste( + sep = "\n", + "Error when executing `teal_data_module`:", + paste0( + "It must always return a reactive with `teal_data`, it returns object of class(es): ", + paste("'", class(data), "'", collapse = ", ", sep = ""), + "." + ) + ) + ) + ) } }, ignoreNULL = TRUE diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index 2b4a9912ed..4a5b4df5c6 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -77,3 +77,125 @@ testthat::test_that("within.teal_data_module modifies the reactive tea_data obje within(iris, id <- seq_len(NROW(Species))) ) }) + +testthat::test_that("eval_code.teal_data_module will execute several executions until error", { + testthat::local_mocked_bindings( + getDefaultReactiveDomain = function() shiny::MockShinySession$new(), + .package = "shiny" + ) + + tdm <- teal_data_module( + ui = function(id) div(), + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + shiny::reactive(teal.data::teal_data(IRIS = iris)) + }) + } + ) + + tdm2 <- eval_code(tdm, "stop_me <- FALSE") %>% + eval_code("stopifnot(previous_error = stop_me)") + + testthat::expect_error( + shiny::isolate(tdm2$server("test")()[["IRIS"]]), + "previous_error.*when evaluating qenv code" + ) +}) + +testthat::test_that("eval_code.teal_data_module throws error when result is not reactive", { + testthat::local_mocked_bindings( + getDefaultReactiveDomain = function() shiny::MockShinySession$new(), + .package = "shiny" + ) + + tdm <- teal_data_module( + ui = function(id) div(), + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + "I am not reactive, I am a string" + }) + } + ) + + tdm2 <- eval_code(tdm, "1 + 1") + + testthat::expect_error( + shiny::isolate(tdm2$server("test")()[["IRIS"]]), + "The `teal_data_module` must return a reactive expression." + ) +}) + +testthat::test_that("eval_code.teal_data_module throws error when result is not reactive", { + testthat::local_mocked_bindings( + getDefaultReactiveDomain = function() shiny::MockShinySession$new(), + .package = "shiny" + ) + + tdm <- teal_data_module( + ui = function(id) div(), + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + "I am not reactive, I am a string" + }) + } + ) + + tdm2 <- eval_code(tdm, "1 + 1") + + testthat::expect_error( + shiny::isolate(tdm2$server("test")()[["IRIS"]]), + "The `teal_data_module` must return a reactive expression." + ) +}) + +testthat::test_that("eval_code.teal_data_module propagates error from the original/first call", { + testthat::local_mocked_bindings( + getDefaultReactiveDomain = function() shiny::MockShinySession$new(), + .package = "shiny" + ) + + tdm <- teal_data_module( + ui = function(id) div(), + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + reactive( + validate( + FALSE, + "an error at the bottom/original teal_data_module" + ) + ) + }) + } + ) + + tdm2 <- eval_code(tdm, "1 + 1") + + testthat::expect_error( + shiny::isolate(tdm2$server("test")()), + "an error at the bottom/original teal_data_module" + ) +}) + + +testthat::test_that("eval_code.teal_data_module does not execute on anything other than `teal_data` or `error`", { + testthat::local_mocked_bindings( + getDefaultReactiveDomain = function() shiny::MockShinySession$new(), + .package = "shiny" + ) + + tdm <- teal_data_module( + ui = function(id) div(), + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + reactive("I am a string") + }) + } + ) + + tdm2 <- eval_code(tdm, "1 + 1") + + testthat::expect_error( + shiny::isolate(tdm2$server("test")()), + "It must always return a reactive with `teal_data`" + ) +}) From c15c10639bfda558b25645ccc50cbe1ad41d4632 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 Dec 2023 15:39:53 +0100 Subject: [PATCH 15/28] tests: rename test --- tests/testthat/test-teal_data_module-eval_code.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index 4a5b4df5c6..5b3a0fe573 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -177,7 +177,7 @@ testthat::test_that("eval_code.teal_data_module propagates error from the origin }) -testthat::test_that("eval_code.teal_data_module does not execute on anything other than `teal_data` or `error`", { +testthat::test_that("eval_code.teal_data_module does not execute on a object (other than `teal_data` or `error`)", { testthat::local_mocked_bindings( getDefaultReactiveDomain = function() shiny::MockShinySession$new(), .package = "shiny" @@ -187,7 +187,7 @@ testthat::test_that("eval_code.teal_data_module does not execute on anything oth ui = function(id) div(), server = function(id) { shiny::moduleServer(id, function(input, output, session) { - reactive("I am a string") + reactive(list()) }) } ) From c2f708aa1580fd85aba2d5cf8b3425bdbc6bb00b 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 Dec 2023 15:59:10 +0100 Subject: [PATCH 16/28] fix: swaps validate with qenv.error --- tests/testthat/test-teal_data_module-eval_code.R | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index 5b3a0fe573..f281e95790 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -148,7 +148,7 @@ testthat::test_that("eval_code.teal_data_module throws error when result is not ) }) -testthat::test_that("eval_code.teal_data_module propagates error from the original/first call", { +testthat::test_that("eval_code.teal_data_module propagates qenv error from the original/first call", { testthat::local_mocked_bindings( getDefaultReactiveDomain = function() shiny::MockShinySession$new(), .package = "shiny" @@ -159,10 +159,7 @@ testthat::test_that("eval_code.teal_data_module propagates error from the origin server = function(id) { shiny::moduleServer(id, function(input, output, session) { reactive( - validate( - FALSE, - "an error at the bottom/original teal_data_module" - ) + teal_data() |> within("non_existing_var + 1") ) }) } @@ -170,13 +167,12 @@ testthat::test_that("eval_code.teal_data_module propagates error from the origin tdm2 <- eval_code(tdm, "1 + 1") - testthat::expect_error( + testthat::expect_s3_class( shiny::isolate(tdm2$server("test")()), - "an error at the bottom/original teal_data_module" + "error" ) }) - testthat::test_that("eval_code.teal_data_module does not execute on a object (other than `teal_data` or `error`)", { testthat::local_mocked_bindings( getDefaultReactiveDomain = function() shiny::MockShinySession$new(), From 34db6c60e6caad37bb0938981e9be10e642496b5 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 Dec 2023 16:04:20 +0100 Subject: [PATCH 17/28] tests: using quote on an eval_code test --- tests/testthat/test-teal_data_module-eval_code.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index f281e95790..032b539aa8 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -93,7 +93,7 @@ testthat::test_that("eval_code.teal_data_module will execute several executions } ) - tdm2 <- eval_code(tdm, "stop_me <- FALSE") %>% + tdm2 <- eval_code(tdm, quote(stop_me <- FALSE)) %>% eval_code("stopifnot(previous_error = stop_me)") testthat::expect_error( From ef1877cc806cabcd49b9cde18401e1125f723983 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 Dec 2023 16:34:02 +0100 Subject: [PATCH 18/28] fix: typo and removed repeated test --- .../test-teal_data_module-eval_code.R | 31 +++---------------- 1 file changed, 4 insertions(+), 27 deletions(-) diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index 032b539aa8..33917c54ef 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -78,7 +78,7 @@ testthat::test_that("within.teal_data_module modifies the reactive tea_data obje ) }) -testthat::test_that("eval_code.teal_data_module will execute several executions until error", { +testthat::test_that("eval_code.teal_data_module will execute several times until error", { testthat::local_mocked_bindings( getDefaultReactiveDomain = function() shiny::MockShinySession$new(), .package = "shiny" @@ -102,30 +102,7 @@ testthat::test_that("eval_code.teal_data_module will execute several executions ) }) -testthat::test_that("eval_code.teal_data_module throws error when result is not reactive", { - testthat::local_mocked_bindings( - getDefaultReactiveDomain = function() shiny::MockShinySession$new(), - .package = "shiny" - ) - - tdm <- teal_data_module( - ui = function(id) div(), - server = function(id) { - shiny::moduleServer(id, function(input, output, session) { - "I am not reactive, I am a string" - }) - } - ) - - tdm2 <- eval_code(tdm, "1 + 1") - - testthat::expect_error( - shiny::isolate(tdm2$server("test")()[["IRIS"]]), - "The `teal_data_module` must return a reactive expression." - ) -}) - -testthat::test_that("eval_code.teal_data_module throws error when result is not reactive", { +testthat::test_that("eval_code.teal_data_module throws error when original teal_data_module result is not reactive", { testthat::local_mocked_bindings( getDefaultReactiveDomain = function() shiny::MockShinySession$new(), .package = "shiny" @@ -159,13 +136,13 @@ testthat::test_that("eval_code.teal_data_module propagates qenv error from the o server = function(id) { shiny::moduleServer(id, function(input, output, session) { reactive( - teal_data() |> within("non_existing_var + 1") + teal_data(IRIS = iris) |> within("non_existing_var + 1") ) }) } ) - tdm2 <- eval_code(tdm, "1 + 1") + tdm2 <- eval_code(tdm, "IRIS$const <- 1 + 1") testthat::expect_s3_class( shiny::isolate(tdm2$server("test")()), From a861bec97bdb60138f5ad798a8656438b80df4fe 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 Dec 2023 16:38:27 +0100 Subject: [PATCH 19/28] fix: using lang2calls see https://github.com/insightsengineering/teal.code/pull/176 --- R/teal_data_module-eval_code.R | 4 ++-- R/zzz.R | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index b0cc81f981..ccafb0d8cb 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -75,13 +75,13 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function( #' @rdname eval_code #' @export setMethod("eval_code", signature = c("teal_data_module", "language"), function(object, code) { - eval_code(object, code = format_expression(code)) + eval_code(object, code = paste(lang2calls(code), collapse = "\n")) }) #' @rdname eval_code #' @export setMethod("eval_code", signature = c("teal_data_module", "expression"), function(object, code) { - eval_code(object, code = format_expression(code)) + eval_code(object, code = paste(lang2calls(code), collapse = "\n")) }) #' @inherit teal.code::within.qenv params title details diff --git a/R/zzz.R b/R/zzz.R index b8dacf2ec0..fe6f22205c 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -34,5 +34,5 @@ coalesce_r <- getFromNamespace("coalesce_r", "teal.slice") RcodeBlock <- getFromNamespace("RcodeBlock", "teal.reporter") # nolint # Use non-exported function(s) from teal.code -# This one is here because format_expression should not be exported from teal.code -format_expression <- getFromNamespace("format_expression", "teal.code") +# This one is here because lang2calls should not be exported from teal.code +lang2calls <- getFromNamespace("lang2calls", "teal.code") From e31ae858b45e7286e74996eb22017fe5db739719 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 Dec 2023 16:56:14 +0100 Subject: [PATCH 20/28] Update R/teal_data_module-eval_code.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/teal_data_module-eval_code.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index ccafb0d8cb..6ad868fdf0 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -103,9 +103,7 @@ setMethod("eval_code", signature = c("teal_data_module", "expression"), function #' }) #' } #' ) -#' \dontrun{ #' within(tdm, IRIS <- subset(IRIS, Species == "virginica")) -#' } within.teal_data_module <- function(data, expr, ...) { expr <- substitute(expr) extras <- list(...) From 3b9da928b5600c3f19abab9bc1f920a033774fb7 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: Mon, 4 Dec 2023 15:59:53 +0000 Subject: [PATCH 21/28] [skip actions] Roxygen Man Pages Auto Update --- man/within.teal_data_module.Rd | 2 -- 1 file changed, 2 deletions(-) diff --git a/man/within.teal_data_module.Rd b/man/within.teal_data_module.Rd index 78ba3aa33c..8b39b09457 100644 --- a/man/within.teal_data_module.Rd +++ b/man/within.teal_data_module.Rd @@ -36,10 +36,8 @@ tdm <- teal_data_module( }) } ) -\dontrun{ within(tdm, IRIS <- subset(IRIS, Species == "virginica")) } -} \seealso{ \code{\link[base:with]{base::within()}}, \code{\link[=teal_data_module]{teal_data_module()}} } From 71cfbf9683044709a8e2ef77680ff546d8fd4841 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 Dec 2023 17:39:40 +0100 Subject: [PATCH 22/28] pr: implements suggestions --- R/teal_data_module-eval_code.R | 25 ++------- .../test-teal_data_module-eval_code.R | 56 +++++++++---------- 2 files changed, 31 insertions(+), 50 deletions(-) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index 6ad868fdf0..f128490e74 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -42,30 +42,13 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function( eventReactive(teal_data_rv(), { - data <- tryCatch(teal_data_rv(), error = function(e) e) - - if (inherits(data, "teal_data")) { - eval_code(data, code) - } else if (inherits(data, "error")) { - data + if (inherits(teal_data_rv(), c("teal_data", "qenv.error"))) { + eval_code(teal_data_rv(), code) } else { - validate( - need( - FALSE, - paste( - sep = "\n", - "Error when executing `teal_data_module`:", - paste0( - "It must always return a reactive with `teal_data`, it returns object of class(es): ", - paste("'", class(data), "'", collapse = ", ", sep = ""), - "." - ) - ) - ) - ) + teal_data_rv() } }, - ignoreNULL = TRUE + ignoreNULL = FALSE ) }) } diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index 33917c54ef..50775da59c 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -22,7 +22,7 @@ testthat::test_that("eval_code.teal_data_module ui has modified namespace for id server = function(id) NULL ) - tdm2 <- within(tdm, 1 + 1) + tdm2 <- eval_code(tdm, "1 + 1") output_ui <- tdm2$ui("top_level_ns") @@ -31,30 +31,6 @@ testthat::test_that("eval_code.teal_data_module ui has modified namespace for id testthat::expect_match(output_ui$attribs$id, "-mutate_inner-") }) -testthat::test_that("eval_code.teal_data_module modifies the reactive teal_data object with expression parameter", { - testthat::local_mocked_bindings( - getDefaultReactiveDomain = function() shiny::MockShinySession$new(), - .package = "shiny" - ) - - tdm <- teal_data_module( - ui = function(id) div(), - server = function(id) { - shiny::moduleServer(id, function(input, output, session) { - shiny::reactive(teal.data::teal_data(IRIS = iris)) - }) - } - ) - - tdm2 <- eval_code(tdm, expression(IRIS$id <- seq_len(nrow(IRIS)))) # nolint: object_name_linter. - - # Columns were added via eval_code.teal_data_module - testthat::expect_setequal( - c(names(iris), "id"), - colnames(shiny::isolate(tdm2$server("test")()[["IRIS"]])) - ) -}) - testthat::test_that("within.teal_data_module modifies the reactive tea_data object", { testthat::local_mocked_bindings( getDefaultReactiveDomain = function() shiny::MockShinySession$new(), @@ -146,11 +122,11 @@ testthat::test_that("eval_code.teal_data_module propagates qenv error from the o testthat::expect_s3_class( shiny::isolate(tdm2$server("test")()), - "error" + "qenv.error" ) }) -testthat::test_that("eval_code.teal_data_module does not execute on a object (other than `teal_data` or `error`)", { +testthat::test_that("eval_code.teal_data_module handles an arbitrary object (other than `teal_data` or `qenv.error`)", { testthat::local_mocked_bindings( getDefaultReactiveDomain = function() shiny::MockShinySession$new(), .package = "shiny" @@ -167,8 +143,30 @@ testthat::test_that("eval_code.teal_data_module does not execute on a object (ot tdm2 <- eval_code(tdm, "1 + 1") - testthat::expect_error( + testthat::expect_identical( shiny::isolate(tdm2$server("test")()), - "It must always return a reactive with `teal_data`" + list() + ) +}) + +testthat::test_that("eval_code.teal_data_module handles a `NULL` result", { + testthat::local_mocked_bindings( + getDefaultReactiveDomain = function() shiny::MockShinySession$new(), + .package = "shiny" + ) + + tdm <- teal_data_module( + ui = function(id) div(), + server = function(id) { + shiny::moduleServer(id, function(input, output, session) { + reactive(NULL) + }) + } + ) + + tdm2 <- eval_code(tdm, "1 + 1") + + testthat::expect_null( + shiny::isolate(tdm2$server("test")()) ) }) From fc104799434c231f79c4d2ab1787db23d4acc7e7 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 Dec 2023 18:27:52 +0100 Subject: [PATCH 23/28] tests: rewrite tests to use testServer and adds splash --- R/teal_data_module-eval_code.R | 3 +- tests/testthat/test-module_teal_with_splash.R | 89 +++++++++++++++++++ .../test-teal_data_module-eval_code.R | 86 +++++++++--------- 3 files changed, 131 insertions(+), 47 deletions(-) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index f128490e74..df94f3fbd1 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -40,7 +40,7 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function( stop("The `teal_data_module` must return a reactive expression.", call. = FALSE) } - eventReactive(teal_data_rv(), + td <- eventReactive(teal_data_rv(), { if (inherits(teal_data_rv(), c("teal_data", "qenv.error"))) { eval_code(teal_data_rv(), code) @@ -50,6 +50,7 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function( }, ignoreNULL = FALSE ) + td }) } ) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index a68f047f02..a3348fc153 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -210,3 +210,92 @@ testthat::test_that("srv_teal_with_splash gets observe event from srv_teal", { } ) }) + +testthat::test_that("srv_teal_with_splash accepts data after within.teal_data_module", { + testthat::expect_no_error( + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "id", + data = teal_data_module(ui = function(id) div(), server = function(id) reactive(teal_data(IRIS = iris))) %>% + within(IRIS$id <- seq_len(NROW(IRIS$Species))), + modules = modules(example_module()) + ), + expr = { + testthat::expect_s3_class(teal_data_rv, "reactive") + testthat::expect_s3_class(teal_data_rv_validate, "reactive") + testthat::expect_s4_class(teal_data_rv_validate(), "teal_data") + testthat::expect_identical( + teal_data_rv_validate()[["IRIS"]], + within(iris, id <- seq_len(NROW(Species))) + ) + } + ) + ) +}) + +testthat::test_that("srv_teal_with_splash throws error when within.teal_data_module returns qenv.error", { + testthat::expect_no_error( + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "id", + data = teal_data_module(ui = function(id) div(), server = function(id) reactive(teal_data(IRIS = iris))) %>% + within(non_existing_var + 1), + modules = modules(example_module()) + ), + expr = { + testthat::expect_s3_class(teal_data_rv, "reactive") + testthat::expect_s3_class(teal_data_rv(), "qenv.error") + testthat::expect_s3_class(teal_data_rv_validate, "reactive") + testthat::expect_error(teal_data_rv_validate(), "when evaluating qenv code") + } + ) + ) +}) + +testthat::test_that("srv_teal_with_splash throws error when within.teal_data_module returns NULL", { + testthat::expect_no_error( + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "id", + data = teal_data_module(ui = function(id) div(), server = function(id) reactive(NULL)) %>% + within(1 + 1), + modules = modules(example_module()) + ), + expr = { + testthat::expect_s3_class(teal_data_rv, "reactive") + testthat::expect_null(teal_data_rv()) + testthat::expect_s3_class(teal_data_rv_validate, "reactive") + testthat::expect_error(teal_data_rv_validate(), "`teal_data_module` did not return `teal_data` object ") + } + ) + ) +}) + +testthat::test_that( + paste( + "srv_teal_with_splash throws error when within.teal_data_module returns arbitrary object", + "(other than `teal_data` or `qenv.error`)" + ), + { + testthat::expect_no_error( + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "id", + data = teal_data_module(ui = function(id) div(), server = function(id) reactive(NULL)) %>% + within(1 + 1), + modules = modules(example_module()) + ), + expr = { + testthat::expect_s3_class(teal_data_rv, "reactive") + testthat::expect_null(teal_data_rv()) + testthat::expect_s3_class(teal_data_rv_validate, "reactive") + testthat::expect_error(teal_data_rv_validate(), "`teal_data_module` did not return `teal_data` object ") + } + ) + ) + } +) diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index 50775da59c..078c9e57a5 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -32,11 +32,6 @@ testthat::test_that("eval_code.teal_data_module ui has modified namespace for id }) testthat::test_that("within.teal_data_module modifies the reactive tea_data object", { - testthat::local_mocked_bindings( - getDefaultReactiveDomain = function() shiny::MockShinySession$new(), - .package = "shiny" - ) - tdm <- teal_data_module( ui = function(id) div(), server = function(id) { @@ -48,18 +43,18 @@ testthat::test_that("within.teal_data_module modifies the reactive tea_data obje tdm2 <- within(tdm, IRIS$id <- seq_len(nrow(IRIS))) # nolint: object_name_linter. - testthat::expect_identical( - shiny::isolate(tdm2$server("test")()[["IRIS"]]), - within(iris, id <- seq_len(NROW(Species))) + shiny::testServer( + app = tdm2$server, + expr = { + testthat::expect_identical( + td()[["IRIS"]], + within(iris, id <- seq_len(NROW(Species))) + ) + } ) }) testthat::test_that("eval_code.teal_data_module will execute several times until error", { - testthat::local_mocked_bindings( - getDefaultReactiveDomain = function() shiny::MockShinySession$new(), - .package = "shiny" - ) - tdm <- teal_data_module( ui = function(id) div(), server = function(id) { @@ -72,18 +67,16 @@ testthat::test_that("eval_code.teal_data_module will execute several times until tdm2 <- eval_code(tdm, quote(stop_me <- FALSE)) %>% eval_code("stopifnot(previous_error = stop_me)") - testthat::expect_error( - shiny::isolate(tdm2$server("test")()[["IRIS"]]), - "previous_error.*when evaluating qenv code" + shiny::testServer( + app = tdm2$server, + expr = { + testthat::expect_s3_class(td(), "qenv.error") + testthat::expect_match(td()$message, "previous_error.*when evaluating qenv code") + } ) }) testthat::test_that("eval_code.teal_data_module throws error when original teal_data_module result is not reactive", { - testthat::local_mocked_bindings( - getDefaultReactiveDomain = function() shiny::MockShinySession$new(), - .package = "shiny" - ) - tdm <- teal_data_module( ui = function(id) div(), server = function(id) { @@ -96,23 +89,21 @@ testthat::test_that("eval_code.teal_data_module throws error when original teal_ tdm2 <- eval_code(tdm, "1 + 1") testthat::expect_error( - shiny::isolate(tdm2$server("test")()[["IRIS"]]), + shiny::testServer( + app = tdm2$server, + expr = {} + ), "The `teal_data_module` must return a reactive expression." ) }) testthat::test_that("eval_code.teal_data_module propagates qenv error from the original/first call", { - testthat::local_mocked_bindings( - getDefaultReactiveDomain = function() shiny::MockShinySession$new(), - .package = "shiny" - ) - tdm <- teal_data_module( ui = function(id) div(), server = function(id) { shiny::moduleServer(id, function(input, output, session) { reactive( - teal_data(IRIS = iris) |> within("non_existing_var + 1") + teal_data(IRIS = iris) %>% within("non_existing_var + 1") ) }) } @@ -120,18 +111,18 @@ testthat::test_that("eval_code.teal_data_module propagates qenv error from the o tdm2 <- eval_code(tdm, "IRIS$const <- 1 + 1") - testthat::expect_s3_class( - shiny::isolate(tdm2$server("test")()), - "qenv.error" + shiny::testServer( + app = tdm2$server, + expr = { + testthat::expect_s3_class( + td(), + "qenv.error" + ) + } ) }) testthat::test_that("eval_code.teal_data_module handles an arbitrary object (other than `teal_data` or `qenv.error`)", { - testthat::local_mocked_bindings( - getDefaultReactiveDomain = function() shiny::MockShinySession$new(), - .package = "shiny" - ) - tdm <- teal_data_module( ui = function(id) div(), server = function(id) { @@ -143,18 +134,18 @@ testthat::test_that("eval_code.teal_data_module handles an arbitrary object (oth tdm2 <- eval_code(tdm, "1 + 1") - testthat::expect_identical( - shiny::isolate(tdm2$server("test")()), - list() + shiny::testServer( + app = tdm2$server, + expr = { + testthat::expect_identical( + td(), + list() + ) + } ) }) testthat::test_that("eval_code.teal_data_module handles a `NULL` result", { - testthat::local_mocked_bindings( - getDefaultReactiveDomain = function() shiny::MockShinySession$new(), - .package = "shiny" - ) - tdm <- teal_data_module( ui = function(id) div(), server = function(id) { @@ -166,7 +157,10 @@ testthat::test_that("eval_code.teal_data_module handles a `NULL` result", { tdm2 <- eval_code(tdm, "1 + 1") - testthat::expect_null( - shiny::isolate(tdm2$server("test")()) + shiny::testServer( + app = tdm2$server, + expr = { + testthat::expect_null(td()) + } ) }) From af76edc2c12f13d72c9c7858e537af5618cd2fb2 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 Dec 2023 18:30:28 +0100 Subject: [PATCH 24/28] tests: add expect_no_error to testServer calls --- .../test-teal_data_module-eval_code.R | 27 ++++++++++--------- 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index 078c9e57a5..680dbe88a1 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -51,7 +51,8 @@ testthat::test_that("within.teal_data_module modifies the reactive tea_data obje within(iris, id <- seq_len(NROW(Species))) ) } - ) + ) %>% + testthat::expect_no_error() }) testthat::test_that("eval_code.teal_data_module will execute several times until error", { @@ -73,7 +74,8 @@ testthat::test_that("eval_code.teal_data_module will execute several times until testthat::expect_s3_class(td(), "qenv.error") testthat::expect_match(td()$message, "previous_error.*when evaluating qenv code") } - ) + ) %>% + testthat::expect_no_error() }) testthat::test_that("eval_code.teal_data_module throws error when original teal_data_module result is not reactive", { @@ -88,13 +90,11 @@ testthat::test_that("eval_code.teal_data_module throws error when original teal_ tdm2 <- eval_code(tdm, "1 + 1") - testthat::expect_error( - shiny::testServer( - app = tdm2$server, - expr = {} - ), - "The `teal_data_module` must return a reactive expression." - ) + shiny::testServer( + app = tdm2$server, + expr = {} + ) %>% + testthat::expect_error("The `teal_data_module` must return a reactive expression.") }) testthat::test_that("eval_code.teal_data_module propagates qenv error from the original/first call", { @@ -119,7 +119,8 @@ testthat::test_that("eval_code.teal_data_module propagates qenv error from the o "qenv.error" ) } - ) + ) %>% + testthat::expect_no_error() }) testthat::test_that("eval_code.teal_data_module handles an arbitrary object (other than `teal_data` or `qenv.error`)", { @@ -142,7 +143,8 @@ testthat::test_that("eval_code.teal_data_module handles an arbitrary object (oth list() ) } - ) + ) %>% + testthat::expect_no_error() }) testthat::test_that("eval_code.teal_data_module handles a `NULL` result", { @@ -162,5 +164,6 @@ testthat::test_that("eval_code.teal_data_module handles a `NULL` result", { expr = { testthat::expect_null(td()) } - ) + ) %>% + testthat::expect_no_error() }) From d9fdbb9f2dee609247875b57a669b0d644daf70b 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 Dec 2023 09:08:54 +0100 Subject: [PATCH 25/28] pr: remove lingering dontrun --- R/teal_data_module-eval_code.R | 2 -- man/eval_code.Rd | 2 -- 2 files changed, 4 deletions(-) diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index df94f3fbd1..4be1655c82 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -23,9 +23,7 @@ NULL #' }) #' } #' ) -#' \dontrun{ #' eval_code(tdm, "IRIS <- subset(IRIS, Species == 'virginica')") -#' } setMethod("eval_code", signature = c("teal_data_module", "character"), function(object, code) { teal_data_module( ui = function(id) { diff --git a/man/eval_code.Rd b/man/eval_code.Rd index dc70e27b3c..22a67e4570 100644 --- a/man/eval_code.Rd +++ b/man/eval_code.Rd @@ -33,7 +33,5 @@ tdm <- teal_data_module( }) } ) -\dontrun{ eval_code(tdm, "IRIS <- subset(IRIS, Species == 'virginica')") } -} From c012daf61c343f2b5506ac7bb7e9152ca2e16f2d 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 Dec 2023 09:22:48 +0100 Subject: [PATCH 26/28] pr: remove magrittr pipe usage --- tests/testthat/test-module_teal_with_splash.R | 22 ++-- .../test-teal_data_module-eval_code.R | 115 ++++++++++-------- 2 files changed, 75 insertions(+), 62 deletions(-) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index a3348fc153..1051b22239 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -212,13 +212,15 @@ testthat::test_that("srv_teal_with_splash gets observe event from srv_teal", { }) testthat::test_that("srv_teal_with_splash accepts data after within.teal_data_module", { + tdm <- teal_data_module(ui = function(id) div(), server = function(id) reactive(teal_data(IRIS = iris))) + tdm2 <- within(tdm, IRIS$id <- seq_len(NROW(IRIS$Species))) + testthat::expect_no_error( shiny::testServer( app = srv_teal_with_splash, args = list( id = "id", - data = teal_data_module(ui = function(id) div(), server = function(id) reactive(teal_data(IRIS = iris))) %>% - within(IRIS$id <- seq_len(NROW(IRIS$Species))), + data = tdm2, modules = modules(example_module()) ), expr = { @@ -235,13 +237,15 @@ testthat::test_that("srv_teal_with_splash accepts data after within.teal_data_mo }) testthat::test_that("srv_teal_with_splash throws error when within.teal_data_module returns qenv.error", { + tdm <- teal_data_module(ui = function(id) div(), server = function(id) reactive(teal_data(IRIS = iris))) + tdm2 <- within(tdm, non_existing_var + 1) + testthat::expect_no_error( shiny::testServer( app = srv_teal_with_splash, args = list( id = "id", - data = teal_data_module(ui = function(id) div(), server = function(id) reactive(teal_data(IRIS = iris))) %>% - within(non_existing_var + 1), + data = tdm2, modules = modules(example_module()) ), expr = { @@ -255,13 +259,14 @@ testthat::test_that("srv_teal_with_splash throws error when within.teal_data_mod }) testthat::test_that("srv_teal_with_splash throws error when within.teal_data_module returns NULL", { + tdm <- teal_data_module(ui = function(id) div(), server = function(id) reactive(NULL)) + tdm2 <- within(tdm, within(1 + 1)) testthat::expect_no_error( shiny::testServer( app = srv_teal_with_splash, args = list( id = "id", - data = teal_data_module(ui = function(id) div(), server = function(id) reactive(NULL)) %>% - within(1 + 1), + data = tdm2, modules = modules(example_module()) ), expr = { @@ -280,13 +285,14 @@ testthat::test_that( "(other than `teal_data` or `qenv.error`)" ), { + tdm <- teal_data_module(ui = function(id) div(), server = function(id) reactive(NULL)) + tdm2 <- within(tdm, 1 + 1) testthat::expect_no_error( shiny::testServer( app = srv_teal_with_splash, args = list( id = "id", - data = teal_data_module(ui = function(id) div(), server = function(id) reactive(NULL)) %>% - within(1 + 1), + data = tdm2, modules = modules(example_module()) ), expr = { diff --git a/tests/testthat/test-teal_data_module-eval_code.R b/tests/testthat/test-teal_data_module-eval_code.R index 680dbe88a1..9c3fb95551 100644 --- a/tests/testthat/test-teal_data_module-eval_code.R +++ b/tests/testthat/test-teal_data_module-eval_code.R @@ -43,16 +43,17 @@ testthat::test_that("within.teal_data_module modifies the reactive tea_data obje tdm2 <- within(tdm, IRIS$id <- seq_len(nrow(IRIS))) # nolint: object_name_linter. - shiny::testServer( - app = tdm2$server, - expr = { - testthat::expect_identical( - td()[["IRIS"]], - within(iris, id <- seq_len(NROW(Species))) - ) - } - ) %>% - testthat::expect_no_error() + testthat::expect_no_error( + shiny::testServer( + app = tdm2$server, + expr = { + testthat::expect_identical( + td()[["IRIS"]], + within(iris, id <- seq_len(NROW(Species))) + ) + } + ) + ) }) testthat::test_that("eval_code.teal_data_module will execute several times until error", { @@ -65,17 +66,18 @@ testthat::test_that("eval_code.teal_data_module will execute several times until } ) - tdm2 <- eval_code(tdm, quote(stop_me <- FALSE)) %>% - eval_code("stopifnot(previous_error = stop_me)") - - shiny::testServer( - app = tdm2$server, - expr = { - testthat::expect_s3_class(td(), "qenv.error") - testthat::expect_match(td()$message, "previous_error.*when evaluating qenv code") - } - ) %>% - testthat::expect_no_error() + tdm2 <- eval_code(tdm, quote(stop_me <- FALSE)) + tdm2 <- eval_code(tdm2, "stopifnot(previous_error = stop_me)") + + testthat::expect_no_error( + shiny::testServer( + app = tdm2$server, + expr = { + testthat::expect_s3_class(td(), "qenv.error") + testthat::expect_match(td()$message, "previous_error.*when evaluating qenv code") + } + ) + ) }) testthat::test_that("eval_code.teal_data_module throws error when original teal_data_module result is not reactive", { @@ -90,11 +92,13 @@ testthat::test_that("eval_code.teal_data_module throws error when original teal_ tdm2 <- eval_code(tdm, "1 + 1") - shiny::testServer( - app = tdm2$server, - expr = {} - ) %>% - testthat::expect_error("The `teal_data_module` must return a reactive expression.") + testthat::expect_error( + shiny::testServer( + app = tdm2$server, + expr = {} + ), + "The `teal_data_module` must return a reactive expression." + ) }) testthat::test_that("eval_code.teal_data_module propagates qenv error from the original/first call", { @@ -103,7 +107,7 @@ testthat::test_that("eval_code.teal_data_module propagates qenv error from the o server = function(id) { shiny::moduleServer(id, function(input, output, session) { reactive( - teal_data(IRIS = iris) %>% within("non_existing_var + 1") + within(teal_data(IRIS = iris), "non_existing_var + 1") ) }) } @@ -111,16 +115,17 @@ testthat::test_that("eval_code.teal_data_module propagates qenv error from the o tdm2 <- eval_code(tdm, "IRIS$const <- 1 + 1") - shiny::testServer( - app = tdm2$server, - expr = { - testthat::expect_s3_class( - td(), - "qenv.error" - ) - } - ) %>% - testthat::expect_no_error() + testthat::expect_no_error( + shiny::testServer( + app = tdm2$server, + expr = { + testthat::expect_s3_class( + td(), + "qenv.error" + ) + } + ) + ) }) testthat::test_that("eval_code.teal_data_module handles an arbitrary object (other than `teal_data` or `qenv.error`)", { @@ -135,16 +140,17 @@ testthat::test_that("eval_code.teal_data_module handles an arbitrary object (oth tdm2 <- eval_code(tdm, "1 + 1") - shiny::testServer( - app = tdm2$server, - expr = { - testthat::expect_identical( - td(), - list() - ) - } - ) %>% - testthat::expect_no_error() + testthat::expect_no_error( + shiny::testServer( + app = tdm2$server, + expr = { + testthat::expect_identical( + td(), + list() + ) + } + ) + ) }) testthat::test_that("eval_code.teal_data_module handles a `NULL` result", { @@ -159,11 +165,12 @@ testthat::test_that("eval_code.teal_data_module handles a `NULL` result", { tdm2 <- eval_code(tdm, "1 + 1") - shiny::testServer( - app = tdm2$server, - expr = { - testthat::expect_null(td()) - } - ) %>% - testthat::expect_no_error() + testthat::expect_no_error( + shiny::testServer( + app = tdm2$server, + expr = { + testthat::expect_null(td()) + } + ) + ) }) From f661743640244296b5af511cc5e51ce337bf49fa 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 Dec 2023 09:25:33 +0100 Subject: [PATCH 27/28] lintr: corrects problem --- tests/testthat/test-module_teal_with_splash.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 1051b22239..ed09312226 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -213,7 +213,7 @@ testthat::test_that("srv_teal_with_splash gets observe event from srv_teal", { testthat::test_that("srv_teal_with_splash accepts data after within.teal_data_module", { tdm <- teal_data_module(ui = function(id) div(), server = function(id) reactive(teal_data(IRIS = iris))) - tdm2 <- within(tdm, IRIS$id <- seq_len(NROW(IRIS$Species))) + tdm2 <- within(tdm, IRIS$id <- seq_len(NROW(IRIS$Species))) # nolint: object_name_linter. testthat::expect_no_error( shiny::testServer( From b1625ba52389338d8258709bb6b56d490852a6a1 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 Dec 2023 09:31:08 +0100 Subject: [PATCH 28/28] pr: remove magrittr pipe usage and native --- tests/testthat/test-module_nested_tabs.R | 1 - tests/testthat/test-module_teal_with_splash.R | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/testthat/test-module_nested_tabs.R b/tests/testthat/test-module_nested_tabs.R index db0890ceb7..f040e14be9 100644 --- a/tests/testthat/test-module_nested_tabs.R +++ b/tests/testthat/test-module_nested_tabs.R @@ -1,6 +1,5 @@ teal_data <- teal.data::teal_data() teal_data <- within(teal_data, iris <- head(iris)) -teal_data <- teal.data::teal_data() |> within(iris <- head(iris)) datanames(teal_data) <- "iris" filtered_data <- teal_data_to_filtered_data(teal_data) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index ed09312226..adb33fb716 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -96,7 +96,7 @@ testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws then qenv id = "test", data = teal_data_module( ui = function(id) div(), - server = function(id) reactive(teal_data() %>% within(stop("not good"))) + server = function(id) reactive(within(teal_data(), stop("not good"))) ), modules = modules(example_module()) ),