From c9887c90ccdac9da67af8133d7f8bf11c756b679 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 1 Nov 2023 14:33:22 +0100 Subject: [PATCH 01/51] approach 3 --- R/data-data-utils.R | 68 ++++++++++++++++++++++++++++++++++++ R/data-module.R | 42 ++++++++++++++++++++++ R/data-transform_module.R | 23 ++++++++++++ R/init.R | 43 +++++------------------ R/module_nested_tabs.R | 6 +++- R/module_tabs_with_filters.R | 8 ++++- R/module_teal.R | 48 ++++++++++++------------- R/module_teal_with_splash.R | 43 ++++++++++++++++++++--- R/utils.R | 47 +++++++++++++++++++++++++ R/zzz.R | 3 ++ 10 files changed, 266 insertions(+), 65 deletions(-) create mode 100644 R/data-data-utils.R create mode 100644 R/data-module.R create mode 100644 R/data-transform_module.R diff --git a/R/data-data-utils.R b/R/data-data-utils.R new file mode 100644 index 0000000000..c8a5baa62c --- /dev/null +++ b/R/data-data-utils.R @@ -0,0 +1,68 @@ +#' Function runs the `code`, masks the `code` and creates `teal_data` object. +#' @param data (`teal_data`) object +#' @param code (`language`) code to evaluate +#' @param input (`list`) containing inputs to be used in the `code` +#' @param input_mask (`list`) containing inputs to be masked in the `code` +#' +#' @return `teal_data` object +#' +#' @export +eval_and_mask <- function(data, + code, + input = list(), + input_mask = list()) { + # todo: do we need also within_and_mask? + checkmate::assert_list(input) + if (inherits(input, "reactivevalues")) { + input <- shiny::reactiveValuesToList(input) + } + # evaluate code and substitute input + data <- teal.code::eval_code(data, .substitute_code(code, args = input)) + if (inherits(data, "qenv.error")) { + return(data) + } + + if (identical(ls(data@env), character(0))) { + warning( + "Evaluation of `ddl` code haven't created any objects.\n", + "Please make sure that the code is syntactically correct and creates necessary data." + ) + } + + if (!missing(input_mask)) { + # mask dynamic inputs with mask + input <- utils::modifyList(input, input_mask) + + # replace last code entry with masked code + # format_expression needed to convert expression into character(1) + # question: warnings and errors are not masked, is it ok? + data@code[length(data@code)] <- format_expression(.substitute_code(code, args = input)) + } + + # todo: should it be here or in datanames(data)? + if (length(datanames(data)) == 0) { + datanames(data) <- ls(data@env) + } + + data +} + +#' Substitute symbols in the code +#' +#' Function replaces symbols in the provided code by values of the `args` argument. +#' +#' @param code (`language`) code to substitute +#' @param args (`list`) named list or arguments +#' @keywords internal +.substitute_code <- function(code, args) { + do.call( + substitute, + list( + expr = do.call( + substitute, + list(expr = code) + ), + env = args + ) + ) +} diff --git a/R/data-module.R b/R/data-module.R new file mode 100644 index 0000000000..d23af729ce --- /dev/null +++ b/R/data-module.R @@ -0,0 +1,42 @@ +#' Run code and mask inputs +#' +#' Delayed Data Loading module with login and password input. +#' +#' @name submit_button_module +#' +#' +#' @param id (`character`) `shiny` module id. +#' @param ... (`list`) arguments passed to [eval_and_mask()]. +#' @return `shiny` module +NULL + +#' @rdname submit_button_module +#' @export +submit_button_ui <- function(id) { + ns <- NS(id) + actionButton(inputId = ns("submit"), label = "Submit") +} + +#' @rdname submit_button_module +#' @export +submit_button_server <- function(id, data) { + moduleServer(id, function(input, output, session) { + tdata <- eventReactive(input$submit, { + eval_and_mask(input = input, ...) + }) + + # would need to make sure we handle reactivity correctly here as teal::init expects not reactive teal_data... + return(tdata) + }) +} + +# todo: to remove before merge ------------- +#' @export +open_conn <- function(username, password) { + if (password != "pass") stop("Invalid credentials. 'pass' is the password") else TRUE +} +#' @export +close_conn <- function(conn) { + message("closed") + return(NULL) +} diff --git a/R/data-transform_module.R b/R/data-transform_module.R new file mode 100644 index 0000000000..b69533251c --- /dev/null +++ b/R/data-transform_module.R @@ -0,0 +1,23 @@ +#' Transform module for `teal_data` +#' +#' Function creates object of class `teal_trnasform_module` which allows +#' `teal` app developer to transform freely `teal_data` object passed to `data` argument in +#' [teal::init()]. This helps in case when app developer wants to use `teal` app +#' where `data` can be influenced by app user. For example, app developer can create +#' `teal` app which allows user to connect to database and then use data from this database. +#' @param data `teal_data` object +#' @param ui (`function(id)`) function to create UI +#' @param server (`function(id, data)`) `shiny` server +#' which returns `teal_data` object wrapped in `reactive`. +#' @export +teal_transform <- function(data, ui, server) { + checkmate::assert_class(data, "teal_data") + checkmate::assert_function(ui, args = "id") + checkmate::assert_function(server, args = c("id", "data")) + + structure( + list(ui = ui, server = server), + data = data, + class = "teal_transform_module" + ) +} diff --git a/R/init.R b/R/init.R index b697e2829b..15f74cc671 100644 --- a/R/init.R +++ b/R/init.R @@ -106,7 +106,7 @@ #' shinyApp(app$ui, app$server) #' } #' -init <- function(data, +init <- function(data = teal_data(), modules, title = NULL, filter = teal_slices(), @@ -115,10 +115,11 @@ init <- function(data, id = character(0)) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") - if (!inherits(data, c("TealData", "teal_data"))) { + if (!inherits(data, c("TealData", "teal_data", "teal_transform_module"))) { data <- teal.data::to_relational_data(data = data) } - checkmate::assert_multi_class(data, c("TealData", "teal_data")) + + checkmate::assert_multi_class(data, c("TealData", "teal_data", "teal_transform_module")) checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules")) checkmate::assert_string(title, null.ok = TRUE) checkmate::assert( @@ -142,26 +143,12 @@ init <- function(data, if (length(landing) > 1L) stop("Only one `landing_popup_module` can be used.") modules <- drop_module(modules, "teal_module_landing") - # resolve modules datanames - datanames <- teal.data::get_dataname(data) - join_keys <- teal.data::get_join_keys(data) - modules <- resolve_modules_datanames(modules = modules, datanames = datanames, join_keys = join_keys) - - if (!inherits(filter, "teal_slices")) { - checkmate::assert_subset(names(filter), choices = datanames) - # list_to_teal_slices is lifted from teal.slice package, see zzz.R - # This is a temporary measure and will be removed two release cycles from now (now meaning 0.13.0). - filter <- list_to_teal_slices(filter) - } - # convert teal.slice::teal_slices to teal::teal_slices - filter <- as.teal_slices(as.list(filter)) - # Calculate app hash to ensure snapshot compatibility. See ?snapshot. Raw data must be extracted from environments. hashables <- mget(c("data", "modules")) hashables$data <- if (inherits(hashables$data, "teal_data")) { as.list(hashables$data@env) - } else if (inherits(hashables$data, "ddl")) { - attr(hashables$data, "code") + } else if (inherits(data, "teal_transform_module")) { + # what? } else if (hashables$data$is_pulled()) { sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) { hashables$data$get_dataset(dn)$get_raw_data() @@ -172,20 +159,8 @@ init <- function(data, attr(filter, "app_id") <- rlang::hash(hashables) - # check teal_slices - for (i in seq_along(filter)) { - dataname_i <- shiny::isolate(filter[[i]]$dataname) - if (!dataname_i %in% datanames) { - stop( - sprintf( - "filter[[%s]] has a different dataname than available in a 'data':\n %s not in %s", - i, - dataname_i, - toString(datanames) - ) - ) - } - } + # convert teal.slice::teal_slices to teal::teal_slices + filter <- as.teal_slices(as.list(filter)) if (isTRUE(attr(filter, "module_specific"))) { module_names <- unlist(c(module_labels(modules), "global_filters")) @@ -218,7 +193,7 @@ init <- function(data, # the `ui` and `server` with `id = character(0)` and calling the server function directly # rather than through `callModule` res <- list( - ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), + ui = ui_teal_with_splash(id = id, data = data, modules = modules, title = title, header = header, footer = footer), server = function(input, output, session) { if (length(landing) == 1L) { landing_module <- landing[[1L]] diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 0a012f32dd..a84950f03f 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -297,7 +297,11 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi checkmate::assert_class(datasets, "FilteredData") checkmate::assert_class(trigger_data, "reactiveVal") - datanames <- if (is.null(module$datanames)) datasets$datanames() else module$datanames + datanames <- if (is.null(module$datanames) || identical(module$datanames, "all")) { + datasets$datanames() + } else { + module$datanames # todo: include parents! + } # list of reactive filtered data data <- sapply( diff --git a/R/module_tabs_with_filters.R b/R/module_tabs_with_filters.R index 13fd6d5ebe..7f2fca1406 100644 --- a/R/module_tabs_with_filters.R +++ b/R/module_tabs_with_filters.R @@ -122,7 +122,13 @@ srv_tabs_with_filters <- function(id, ) if (!is_module_specific) { - active_datanames <- reactive(active_module()$datanames) + active_datanames <- reactive({ + if (identical(active_module()$datanames, "all")) { + singleton$datanames() + } else { + active_module()$datanames + } + }) singleton <- unlist(datasets)[[1]] singleton$srv_filter_panel("filter_panel", active_datanames = active_datanames) diff --git a/R/module_teal.R b/R/module_teal.R index 413e47d349..7c531ef053 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -160,9 +160,21 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { } ) + reporter <- teal.reporter::Reporter$new() + if (is_arg_used(modules, "reporter") && length(extract_module(modules, "teal_module_previewer")) == 0) { + modules <- append_module(modules, reporter_previewer_module()) + } + + # Replace splash / welcome screen once data is loaded ---- + # ignoreNULL to not trigger at the beginning when data is NULL + # just handle it once because data obtained through delayed loading should + # usually not change afterwards + # if restored from bookmarked state, `filter` is ignored env <- environment() - datasets_reactive <- eventReactive(raw_data(), { + observeEvent(raw_data(), { + logger::log_trace("srv_teal@5 setting main ui after data was pulled") env$progress <- shiny::Progress$new(session) + on.exit(env$progress$close()) env$progress$set(0.25, message = "Setting data") # create a list of data following structure of the nested modules list structure. @@ -171,6 +183,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { # Singleton starts with only global filters active. filter_global <- Filter(function(x) x$id %in% attr(filter, "mapping")$global_filters, filter) datasets_singleton$set_filter_state(filter_global) + module_datasets <- function(modules) { if (inherits(modules, "teal_modules")) { datasets <- lapply(modules$children, module_datasets) @@ -180,11 +193,16 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { } else if (isTRUE(attr(filter, "module_specific"))) { # we should create FilteredData even if modules$datanames is null # null controls a display of filter panel but data should be still passed - datanames <- if (is.null(modules$datanames)) teal.data::get_dataname(raw_data()) else modules$datanames - # todo: subset tdata object to datanames + datanames <- if (is.null(modules$datanames) || modules$datanames == "all") { + include_parent_datanames(raw_data()@datanames, raw_data()@join_keys) # todo: use methods instead + } else { + modules$datanames + } + # todo: subset teal_data to datanames datasets_module <- teal_data_to_filtered_data(raw_data()) # set initial filters + # - filtering filters for this module slices <- Filter(x = filter, f = function(x) { x$id %in% unique(unlist(attr(filter, "mapping")[c(modules$label, "global_filters")])) && x$dataname %in% datanames @@ -201,26 +219,8 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { } datasets <- module_datasets(modules) - logger::log_trace("srv_teal@4 Raw Data transferred to FilteredData.") - datasets - }) - - reporter <- teal.reporter::Reporter$new() - if (is_arg_used(modules, "reporter") && length(extract_module(modules, "teal_module_previewer")) == 0) { - modules <- append_module(modules, reporter_previewer_module()) - } - - # Replace splash / welcome screen once data is loaded ---- - # ignoreNULL to not trigger at the beginning when data is NULL - # just handle it once because data obtained through delayed loading should - # usually not change afterwards - # if restored from bookmarked state, `filter` is ignored - observeEvent(datasets_reactive(), ignoreNULL = TRUE, once = TRUE, { - logger::log_trace("srv_teal@5 setting main ui after data was pulled") - env$progress$set(0.5, message = "Setting up main UI") - on.exit(env$progress$close()) # main_ui_container contains splash screen first and we remove it and replace it by the real UI - + env$progress$set(0.5, message = "Setting up main UI") removeUI(sprintf("#%s:first-child", session$ns("main_ui_container"))) insertUI( selector = paste0("#", session$ns("main_ui_container")), @@ -230,7 +230,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { ui = div(ui_tabs_with_filters( session$ns("main_ui"), modules = modules, - datasets = datasets_reactive(), + datasets = datasets, filter = filter )), # needed so that the UI inputs are available and can be immediately updated, otherwise, updating may not @@ -242,7 +242,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { # registered once (calling server functions twice would trigger observers twice each time) active_module <- srv_tabs_with_filters( id = "main_ui", - datasets = datasets_reactive(), + datasets = datasets, modules = modules, reporter = reporter, filter = filter diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 01348381b2..4056047973 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -19,17 +19,21 @@ #' @export ui_teal_with_splash <- function(id, data, + modules, title, header = tags$p("Add Title Here"), footer = tags$p("Add Footer Here")) { - checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data")) + checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data", "teal_transform_module")) ns <- NS(id) # Startup splash screen for delayed loading # We use delayed loading in all cases, even when the data does not need to be fetched. # This has the benefit that when filtering the data takes a lot of time initially, the # Shiny app does not time out. - splash_ui <- if (inherits(data, "teal_data")) { + + splash_ui <- if (inherits(data, "teal_transform_module")) { + data$ui(id) + } else if (inherits(data, "teal_data")) { div() } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) { div() @@ -56,7 +60,7 @@ ui_teal_with_splash <- function(id, #' If data is not loaded yet, `reactive` returns `NULL`. #' @export srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { - checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data")) + checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data", "teal_transform_module")) moduleServer(id, function(input, output, session) { logger::log_trace("srv_teal_with_splash initializing module with data { toString(get_dataname(data))}.") @@ -66,7 +70,9 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { # raw_data contains teal_data object # either passed to teal::init or returned from ddl - raw_data <- if (inherits(data, "teal_data")) { + raw_data <- if (inherits(data, "teal_transform_module")) { + ddl_out <- data$server(id, data = attr(data, "data")) + } else if (inherits(data, "teal_data")) { reactiveVal(data) } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) { new_data <- do.call( @@ -102,7 +108,34 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { raw_data } - res <- srv_teal(id = "teal", modules = modules, raw_data = raw_data, filter = filter) + raw_data_checked <- reactive({ + data <- raw_data() + if (inherits(data, "qenv.error")) { + # + showNotification(sprintf("Error: %s", data$message)) + return(NULL) + } + + is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) + is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) + + if (!isTRUE(is_modules_ok)) { + showNotification(is_modules_ok) + # NULL won't trigger observe which waits for raw_data() + # we will need to consider validate process for filtered data and modules! + return(NULL) + } + if (!isTRUE(is_filter_ok)) { + showNotification(is_filter_ok) + # we allow app to continue if applied filters are outside + # of possible data range + } + + data + }) + + + res <- srv_teal(id = "teal", modules = modules, raw_data = raw_data_checked, filter = filter) logger::log_trace("srv_teal_with_splash initialized module with data { toString(get_dataname(data))}.") return(res) }) diff --git a/R/utils.R b/R/utils.R index a4a31f2a5d..bed5374994 100644 --- a/R/utils.R +++ b/R/utils.R @@ -140,3 +140,50 @@ resolve_modules_datanames <- function(modules, datanames, join_keys) { modules } } + +check_modules_datanames <- function(modules, datanames) { + recursive_check_datanames <- function(modules, datanames) { + # check teal_modules against datanames + if (inherits(modules, "teal_modules")) { + sapply(modules$children, function(module) recursive_check_datanames(module, datanames = datanames)) + } else { + if (!modules$datanames %in% c("all", datanames)) { + sprintf( + "- Module %s has a different dataname than available in a 'data': %s not in %s", + modules$label, + toString(datanames), + toString(datanames) + ) + } + } + } + check_datanames <- unlist(recursive_check_datanames(modules, datanames)) + if (length(check_datanames)) { + paste(check_datanames, collapse = "\n") + } else { + TRUE + } +} + + +check_filter_datanames <- function(filters, datanames) { + # check teal_slices against datanames + out <- sapply( + filters, function(filter) { + dataname <- shiny::isolate(filter$dataname) + if (!dataname %in% datanames) { + sprintf( + "- Filter %s has a different dataname than available in a 'data':\n %s not in %s", + filter$label, + dataname, + toString(datanames) + ) + } + } + ) + if (length(unlist(out))) { + paste(out, collapse = "\n") + } else { + TRUE + } +} diff --git a/R/zzz.R b/R/zzz.R index fbc9c756d9..ce6fdb281c 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -32,3 +32,6 @@ 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 + + +format_expression <- getFromNamespace("format_expression", "teal.code") From e7a3526d5f5eaaad5d1cac92422bcdff2b3fbe73 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: Wed, 1 Nov 2023 13:41:45 +0000 Subject: [PATCH 02/51] [skip actions] Roxygen Man Pages Auto Update --- DESCRIPTION | 3 +++ man/dot-substitute_code.Rd | 17 +++++++++++++++++ man/eval_and_mask.Rd | 23 +++++++++++++++++++++++ man/init.Rd | 2 +- man/module_nested_tabs.Rd | 6 ++++++ man/module_tabs_with_filters.Rd | 6 ++++++ man/module_teal.Rd | 6 ++++++ man/submit_button_module.Rd | 23 +++++++++++++++++++++++ man/teal_transform.Rd | 23 +++++++++++++++++++++++ man/ui_teal_with_splash.Rd | 7 +++++++ 10 files changed, 115 insertions(+), 1 deletion(-) create mode 100644 man/dot-substitute_code.Rd create mode 100644 man/eval_and_mask.Rd create mode 100644 man/submit_button_module.Rd create mode 100644 man/teal_transform.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 2591116aee..36ca0a34f2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -71,6 +71,9 @@ LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 Collate: + 'data-data-utils.R' + 'data-module.R' + 'data-transform_module.R' 'dummy_functions.R' 'get_rcode_utils.R' 'include_css_js.R' diff --git a/man/dot-substitute_code.Rd b/man/dot-substitute_code.Rd new file mode 100644 index 0000000000..e1305affae --- /dev/null +++ b/man/dot-substitute_code.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-data-utils.R +\name{.substitute_code} +\alias{.substitute_code} +\title{Substitute symbols in the code} +\usage{ +.substitute_code(code, args) +} +\arguments{ +\item{code}{(\code{language}) code to substitute} + +\item{args}{(\code{list}) named list or arguments} +} +\description{ +Function replaces symbols in the provided code by values of the \code{args} argument. +} +\keyword{internal} diff --git a/man/eval_and_mask.Rd b/man/eval_and_mask.Rd new file mode 100644 index 0000000000..6b107be887 --- /dev/null +++ b/man/eval_and_mask.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-data-utils.R +\name{eval_and_mask} +\alias{eval_and_mask} +\title{Function runs the \code{code}, masks the \code{code} and creates \code{teal_data} object.} +\usage{ +eval_and_mask(data, code, input = list(), input_mask = list()) +} +\arguments{ +\item{data}{(\code{teal_data}) object} + +\item{code}{(\code{language}) code to evaluate} + +\item{input}{(\code{list}) containing inputs to be used in the \code{code}} + +\item{input_mask}{(\code{list}) containing inputs to be masked in the \code{code}} +} +\value{ +\code{teal_data} object +} +\description{ +Function runs the \code{code}, masks the \code{code} and creates \code{teal_data} object. +} diff --git a/man/init.Rd b/man/init.Rd index 07bbec2deb..fef6b25b07 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -5,7 +5,7 @@ \title{Create the Server and UI Function For the Shiny App} \usage{ init( - data, + data = teal_data(), modules, title = NULL, filter = teal_slices(), diff --git a/man/module_nested_tabs.Rd b/man/module_nested_tabs.Rd index b21eeaa139..e1f8aa9c44 100644 --- a/man/module_nested_tabs.Rd +++ b/man/module_nested_tabs.Rd @@ -56,6 +56,12 @@ srv_nested_tabs( \item{id}{(\code{character(1)})\cr module id} +\item{modules}{(\code{list}, \code{teal_modules} or \code{teal_module})\cr +nested list of \code{teal_modules} or \code{teal_module} objects or a single +\code{teal_modules} or \code{teal_module} object. These are the specific output modules which +will be displayed in the teal application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for +more details.} + \item{datasets}{(\verb{named list} of \code{FilteredData})\cr object to store filter state and filtered datasets, shared across modules. For more details see \code{\link[teal.slice:FilteredData]{teal.slice::FilteredData}}. Structure of the list must be the same as structure diff --git a/man/module_tabs_with_filters.Rd b/man/module_tabs_with_filters.Rd index 1be1c16d21..224cb51068 100644 --- a/man/module_tabs_with_filters.Rd +++ b/man/module_tabs_with_filters.Rd @@ -20,6 +20,12 @@ srv_tabs_with_filters( \item{id}{(\code{character(1)})\cr module id} +\item{modules}{(\code{list}, \code{teal_modules} or \code{teal_module})\cr +nested list of \code{teal_modules} or \code{teal_module} objects or a single +\code{teal_modules} or \code{teal_module} object. These are the specific output modules which +will be displayed in the teal application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for +more details.} + \item{datasets}{(\verb{named list} of \code{FilteredData})\cr object to store filter state and filtered datasets, shared across modules. For more details see \code{\link[teal.slice:FilteredData]{teal.slice::FilteredData}}. Structure of the list must be the same as structure diff --git a/man/module_teal.Rd b/man/module_teal.Rd index 10c1c8654c..6b66f26c10 100644 --- a/man/module_teal.Rd +++ b/man/module_teal.Rd @@ -35,6 +35,12 @@ argument) will be placed in the app's \code{ui} function so code which needs to \item{footer}{(\code{shiny.tag} or \code{character})\cr the footer of the app} +\item{modules}{(\code{list}, \code{teal_modules} or \code{teal_module})\cr +nested list of \code{teal_modules} or \code{teal_module} objects or a single +\code{teal_modules} or \code{teal_module} object. These are the specific output modules which +will be displayed in the teal application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for +more details.} + \item{raw_data}{(\code{reactive})\cr returns the \code{teal_data}, only evaluated once, \code{NULL} value is ignored} } diff --git a/man/submit_button_module.Rd b/man/submit_button_module.Rd new file mode 100644 index 0000000000..13afc1dc1b --- /dev/null +++ b/man/submit_button_module.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-module.R +\name{submit_button_module} +\alias{submit_button_module} +\alias{submit_button_ui} +\alias{submit_button_server} +\title{Run code and mask inputs} +\usage{ +submit_button_ui(id) + +submit_button_server(id, data) +} +\arguments{ +\item{id}{(\code{character}) \code{shiny} module id.} + +\item{...}{(\code{list}) arguments passed to \code{\link[=eval_and_mask]{eval_and_mask()}}.} +} +\value{ +\code{shiny} module +} +\description{ +Delayed Data Loading module with login and password input. +} diff --git a/man/teal_transform.Rd b/man/teal_transform.Rd new file mode 100644 index 0000000000..825200e564 --- /dev/null +++ b/man/teal_transform.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-transform_module.R +\name{teal_transform} +\alias{teal_transform} +\title{Transform module for \code{teal_data}} +\usage{ +teal_transform(data, ui, server) +} +\arguments{ +\item{data}{\code{teal_data} object} + +\item{ui}{(\verb{function(id)}) function to create UI} + +\item{server}{(\verb{function(id, data)}) \code{shiny} server +which returns \code{teal_data} object wrapped in \code{reactive}.} +} +\description{ +Function creates object of class \code{teal_trnasform_module} which allows +\code{teal} app developer to transform freely \code{teal_data} object passed to \code{data} argument in +\code{\link[=init]{init()}}. This helps in case when app developer wants to use \code{teal} app +where \code{data} can be influenced by app user. For example, app developer can create +\code{teal} app which allows user to connect to database and then use data from this database. +} diff --git a/man/ui_teal_with_splash.Rd b/man/ui_teal_with_splash.Rd index 0ece4d3027..098901459f 100644 --- a/man/ui_teal_with_splash.Rd +++ b/man/ui_teal_with_splash.Rd @@ -7,6 +7,7 @@ ui_teal_with_splash( id, data, + modules, title, header = tags$p("Add Title Here"), footer = tags$p("Add Footer Here") @@ -26,6 +27,12 @@ NOTE: teal does not guarantee reproducibility of the code when names of the list do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} or \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}} with \code{check = TRUE} enabled.} +\item{modules}{(\code{list}, \code{teal_modules} or \code{teal_module})\cr +nested list of \code{teal_modules} or \code{teal_module} objects or a single +\code{teal_modules} or \code{teal_module} object. These are the specific output modules which +will be displayed in the teal application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for +more details.} + \item{title}{(\code{NULL} or \code{character})\cr The browser window title (defaults to the host URL of the page).} From e9df3257a7b73f82aff401530f3175abbedd13a4 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 1 Nov 2023 15:02:38 +0100 Subject: [PATCH 03/51] ddl_login_password wrapper --- R/data-data-utils.R | 30 ++++++++++++++++++++++++++++++ R/data-module.R | 42 ------------------------------------------ R/init.R | 2 +- 3 files changed, 31 insertions(+), 43 deletions(-) delete mode 100644 R/data-module.R diff --git a/R/data-data-utils.R b/R/data-data-utils.R index c8a5baa62c..f23aed813f 100644 --- a/R/data-data-utils.R +++ b/R/data-data-utils.R @@ -66,3 +66,33 @@ eval_and_mask <- function(data, ) ) } + +#' Convenience wrapper for ddl_login_password +ddl_login_password <- function(data, code, input_mask) { + srv <- function(id, data) { + moduleServer(id, function(input, output, session) { + eventReactive(input$submit, { + eval_and_mask(data, code = code, input = input, input_mask = input_mask) + }) + }) + } + + ui <- function(id) { + ns <- NS(id) + actionButton(inputId = ns("submit"), label = "Submit") + } + + teal_transform(data, ui, server) +} + + +# todo: to remove before merge ------------- +#' @export +open_conn <- function(username, password) { + if (password != "pass") stop("Invalid credentials. 'pass' is the password") else TRUE +} +#' @export +close_conn <- function(conn) { + message("closed") + return(NULL) +} diff --git a/R/data-module.R b/R/data-module.R deleted file mode 100644 index d23af729ce..0000000000 --- a/R/data-module.R +++ /dev/null @@ -1,42 +0,0 @@ -#' Run code and mask inputs -#' -#' Delayed Data Loading module with login and password input. -#' -#' @name submit_button_module -#' -#' -#' @param id (`character`) `shiny` module id. -#' @param ... (`list`) arguments passed to [eval_and_mask()]. -#' @return `shiny` module -NULL - -#' @rdname submit_button_module -#' @export -submit_button_ui <- function(id) { - ns <- NS(id) - actionButton(inputId = ns("submit"), label = "Submit") -} - -#' @rdname submit_button_module -#' @export -submit_button_server <- function(id, data) { - moduleServer(id, function(input, output, session) { - tdata <- eventReactive(input$submit, { - eval_and_mask(input = input, ...) - }) - - # would need to make sure we handle reactivity correctly here as teal::init expects not reactive teal_data... - return(tdata) - }) -} - -# todo: to remove before merge ------------- -#' @export -open_conn <- function(username, password) { - if (password != "pass") stop("Invalid credentials. 'pass' is the password") else TRUE -} -#' @export -close_conn <- function(conn) { - message("closed") - return(NULL) -} diff --git a/R/init.R b/R/init.R index 15f74cc671..8e4c4158ea 100644 --- a/R/init.R +++ b/R/init.R @@ -193,7 +193,7 @@ init <- function(data = teal_data(), # the `ui` and `server` with `id = character(0)` and calling the server function directly # rather than through `callModule` res <- list( - ui = ui_teal_with_splash(id = id, data = data, modules = modules, title = title, header = header, footer = footer), + ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), server = function(input, output, session) { if (length(landing) == 1L) { landing_module <- landing[[1L]] From c2e84eb7d38055fb1410cb6f1caf2c9b4a4ec625 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: Wed, 1 Nov 2023 14:07:25 +0000 Subject: [PATCH 04/51] [skip actions] Roxygen Man Pages Auto Update --- DESCRIPTION | 1 - man/ddl_login_password.Rd | 11 +++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) create mode 100644 man/ddl_login_password.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 36ca0a34f2..7efe22a1fa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -72,7 +72,6 @@ Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 Collate: 'data-data-utils.R' - 'data-module.R' 'data-transform_module.R' 'dummy_functions.R' 'get_rcode_utils.R' diff --git a/man/ddl_login_password.Rd b/man/ddl_login_password.Rd new file mode 100644 index 0000000000..f2a82dfa92 --- /dev/null +++ b/man/ddl_login_password.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-data-utils.R +\name{ddl_login_password} +\alias{ddl_login_password} +\title{Convenience wrapper for ddl_login_password} +\usage{ +ddl_login_password(data, code, input_mask) +} +\description{ +Convenience wrapper for ddl_login_password +} From a8f85ca2ac1f718f9e63ee337742b01988c9eb70 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 1 Nov 2023 16:51:51 +0100 Subject: [PATCH 05/51] remove redundant --- R/module_teal_with_splash.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 4056047973..fe98276808 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -19,7 +19,6 @@ #' @export ui_teal_with_splash <- function(id, data, - modules, title, header = tags$p("Add Title Here"), footer = tags$p("Add Footer Here")) { From dc3d7e37517dd0718e5a981c505f7a0713ad608d 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: Wed, 1 Nov 2023 15:56:56 +0000 Subject: [PATCH 06/51] [skip actions] Roxygen Man Pages Auto Update --- man/module_nested_tabs.Rd | 6 ------ man/module_tabs_with_filters.Rd | 6 ------ man/module_teal.Rd | 6 ------ man/ui_teal_with_splash.Rd | 7 ------- 4 files changed, 25 deletions(-) diff --git a/man/module_nested_tabs.Rd b/man/module_nested_tabs.Rd index e1f8aa9c44..b21eeaa139 100644 --- a/man/module_nested_tabs.Rd +++ b/man/module_nested_tabs.Rd @@ -56,12 +56,6 @@ srv_nested_tabs( \item{id}{(\code{character(1)})\cr module id} -\item{modules}{(\code{list}, \code{teal_modules} or \code{teal_module})\cr -nested list of \code{teal_modules} or \code{teal_module} objects or a single -\code{teal_modules} or \code{teal_module} object. These are the specific output modules which -will be displayed in the teal application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for -more details.} - \item{datasets}{(\verb{named list} of \code{FilteredData})\cr object to store filter state and filtered datasets, shared across modules. For more details see \code{\link[teal.slice:FilteredData]{teal.slice::FilteredData}}. Structure of the list must be the same as structure diff --git a/man/module_tabs_with_filters.Rd b/man/module_tabs_with_filters.Rd index 224cb51068..1be1c16d21 100644 --- a/man/module_tabs_with_filters.Rd +++ b/man/module_tabs_with_filters.Rd @@ -20,12 +20,6 @@ srv_tabs_with_filters( \item{id}{(\code{character(1)})\cr module id} -\item{modules}{(\code{list}, \code{teal_modules} or \code{teal_module})\cr -nested list of \code{teal_modules} or \code{teal_module} objects or a single -\code{teal_modules} or \code{teal_module} object. These are the specific output modules which -will be displayed in the teal application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for -more details.} - \item{datasets}{(\verb{named list} of \code{FilteredData})\cr object to store filter state and filtered datasets, shared across modules. For more details see \code{\link[teal.slice:FilteredData]{teal.slice::FilteredData}}. Structure of the list must be the same as structure diff --git a/man/module_teal.Rd b/man/module_teal.Rd index 6b66f26c10..10c1c8654c 100644 --- a/man/module_teal.Rd +++ b/man/module_teal.Rd @@ -35,12 +35,6 @@ argument) will be placed in the app's \code{ui} function so code which needs to \item{footer}{(\code{shiny.tag} or \code{character})\cr the footer of the app} -\item{modules}{(\code{list}, \code{teal_modules} or \code{teal_module})\cr -nested list of \code{teal_modules} or \code{teal_module} objects or a single -\code{teal_modules} or \code{teal_module} object. These are the specific output modules which -will be displayed in the teal application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for -more details.} - \item{raw_data}{(\code{reactive})\cr returns the \code{teal_data}, only evaluated once, \code{NULL} value is ignored} } diff --git a/man/ui_teal_with_splash.Rd b/man/ui_teal_with_splash.Rd index 098901459f..0ece4d3027 100644 --- a/man/ui_teal_with_splash.Rd +++ b/man/ui_teal_with_splash.Rd @@ -7,7 +7,6 @@ ui_teal_with_splash( id, data, - modules, title, header = tags$p("Add Title Here"), footer = tags$p("Add Footer Here") @@ -27,12 +26,6 @@ NOTE: teal does not guarantee reproducibility of the code when names of the list do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} or \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}} with \code{check = TRUE} enabled.} -\item{modules}{(\code{list}, \code{teal_modules} or \code{teal_module})\cr -nested list of \code{teal_modules} or \code{teal_module} objects or a single -\code{teal_modules} or \code{teal_module} object. These are the specific output modules which -will be displayed in the teal application. See \code{\link[=modules]{modules()}} and \code{\link[=module]{module()}} for -more details.} - \item{title}{(\code{NULL} or \code{character})\cr The browser window title (defaults to the host URL of the page).} From 08c72142172cc487f0c3a94d641ed9f0ea1e2b36 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 2 Nov 2023 07:31:45 +0100 Subject: [PATCH 07/51] fixes --- R/modules.R | 2 +- R/utils.R | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/modules.R b/R/modules.R index 472a1076b1..789083e669 100644 --- a/R/modules.R +++ b/R/modules.R @@ -318,7 +318,7 @@ module <- function(label = "module", structure( list( label = label, - server = server, ui = ui, datanames = datanames, + server = server, ui = ui, datanames = unique(datanames), server_args = server_args, ui_args = ui_args ), class = "teal_module" diff --git a/R/utils.R b/R/utils.R index bed5374994..9474078f6d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -147,11 +147,12 @@ check_modules_datanames <- function(modules, datanames) { if (inherits(modules, "teal_modules")) { sapply(modules$children, function(module) recursive_check_datanames(module, datanames = datanames)) } else { - if (!modules$datanames %in% c("all", datanames)) { + extra_datanames <- setdiff(modules$datanames, c("all", datanames)) + if (length(extra_datanames)) { sprintf( "- Module %s has a different dataname than available in a 'data': %s not in %s", modules$label, - toString(datanames), + toString(extra_datanames), toString(datanames) ) } From 221976a40a99a76bdb362a7a24e63c48f85e3045 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 2 Nov 2023 07:36:13 +0100 Subject: [PATCH 08/51] :O --- R/module_nested_tabs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index a84950f03f..32f1c70c4f 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -300,7 +300,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi datanames <- if (is.null(module$datanames) || identical(module$datanames, "all")) { datasets$datanames() } else { - module$datanames # todo: include parents! + unique(module$datanames) # todo: include parents! } # list of reactive filtered data From 55a5a80d75ae0e4ef8383228a6b8a35e4c20d632 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 3 Nov 2023 07:39:22 +0100 Subject: [PATCH 09/51] modifying class to be defacto simpler version of `teal_module` --- R/data-data-utils.R | 2 +- R/data-transform_module.R | 43 ++++++++++++++++++++++++++++--------- R/init.R | 6 +++--- R/module_nested_tabs.R | 5 ++--- R/module_teal_with_splash.R | 22 ++++++++++++------- 5 files changed, 53 insertions(+), 25 deletions(-) diff --git a/R/data-data-utils.R b/R/data-data-utils.R index f23aed813f..674db157ce 100644 --- a/R/data-data-utils.R +++ b/R/data-data-utils.R @@ -82,7 +82,7 @@ ddl_login_password <- function(data, code, input_mask) { actionButton(inputId = ns("submit"), label = "Submit") } - teal_transform(data, ui, server) + delayed_data(data, ui, server) } diff --git a/R/data-transform_module.R b/R/data-transform_module.R index b69533251c..9519a2526a 100644 --- a/R/data-transform_module.R +++ b/R/data-transform_module.R @@ -1,23 +1,46 @@ -#' Transform module for `teal_data` +#' `delayed_data` for `teal_data` #' -#' Function creates object of class `teal_trnasform_module` which allows +#' Function creates object of class `delayed_data` which allows #' `teal` app developer to transform freely `teal_data` object passed to `data` argument in #' [teal::init()]. This helps in case when app developer wants to use `teal` app #' where `data` can be influenced by app user. For example, app developer can create #' `teal` app which allows user to connect to database and then use data from this database. -#' @param data `teal_data` object +#' @param ... (`any`) arguments passed to `server` function. #' @param ui (`function(id)`) function to create UI -#' @param server (`function(id, data)`) `shiny` server -#' which returns `teal_data` object wrapped in `reactive`. +#' @param server (`function(id)`) `shiny` server which returns `teal_data` object wrapped in +#' `reactive`. `server` should have `id` argument and exactly the same formals as specified in `...`. #' @export -teal_transform <- function(data, ui, server) { - checkmate::assert_class(data, "teal_data") +delayed_data <- function(ui, server, ...) { checkmate::assert_function(ui, args = "id") - checkmate::assert_function(server, args = c("id", "data")) + server_args <- list(...) + if (is.null(names(server_args))) { + stop("All arguments passed to delayed_data() should be named") + } + + server_formals <- names(formals(server)) + extra_args <- setdiff(names(server_args), server_formals) + if (length(extra_args) > 0) { + stop( + "Unexpected arguments specified in delayed_data(): ", + toString(extra_args), + "\n arguments specified in `...` should be the same as in `server` function", + call. = FALSE + ) + } + + extra_formals <- setdiff(server_formals, c("id", names(server_args))) + if (length(extra_formals) > 0) { + stop( + "Missing arguments specified in delayed_data(): ", + toString(extra_formals), + "\n arguments specified in `...` should be the same as in `server` function", + call. = FALSE + ) + } structure( list(ui = ui, server = server), - data = data, - class = "teal_transform_module" + server_args = server_args, + class = "delayed_data" ) } diff --git a/R/init.R b/R/init.R index 8e4c4158ea..3ec7e03352 100644 --- a/R/init.R +++ b/R/init.R @@ -115,11 +115,11 @@ init <- function(data = teal_data(), id = character(0)) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") - if (!inherits(data, c("TealData", "teal_data", "teal_transform_module"))) { + if (!inherits(data, c("TealData", "teal_data", "delayed_data"))) { data <- teal.data::to_relational_data(data = data) } - checkmate::assert_multi_class(data, c("TealData", "teal_data", "teal_transform_module")) + checkmate::assert_multi_class(data, c("TealData", "teal_data", "delayed_data")) checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules")) checkmate::assert_string(title, null.ok = TRUE) checkmate::assert( @@ -147,7 +147,7 @@ init <- function(data = teal_data(), hashables <- mget(c("data", "modules")) hashables$data <- if (inherits(hashables$data, "teal_data")) { as.list(hashables$data@env) - } else if (inherits(data, "teal_transform_module")) { + } else if (inherits(data, "delayed_data")) { # what? } else if (hashables$data$is_pulled()) { sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) { diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 32f1c70c4f..14f52dc441 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -112,8 +112,7 @@ ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L, is_mod checkmate::assert_class(datasets, class = "FilteredData") ns <- NS(id) - args <- isolate(teal.transform::resolve_delayed(modules$ui_args, datasets)) - args <- c(list(id = ns("module")), args) + args <- c(list(id = ns("module")), modules$ui_args) if (is_arg_used(modules$ui, "datasets")) { args <- c(args, datasets = datasets) @@ -300,7 +299,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi datanames <- if (is.null(module$datanames) || identical(module$datanames, "all")) { datasets$datanames() } else { - unique(module$datanames) # todo: include parents! + unique(module$datanames) # todo: include parents! unique shouldn't be needed here! } # list of reactive filtered data diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index fe98276808..297997013a 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -22,7 +22,7 @@ ui_teal_with_splash <- function(id, title, header = tags$p("Add Title Here"), footer = tags$p("Add Footer Here")) { - checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data", "teal_transform_module")) + checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data", "delayed_data")) ns <- NS(id) # Startup splash screen for delayed loading @@ -30,8 +30,8 @@ ui_teal_with_splash <- function(id, # This has the benefit that when filtering the data takes a lot of time initially, the # Shiny app does not time out. - splash_ui <- if (inherits(data, "teal_transform_module")) { - data$ui(id) + splash_ui <- if (inherits(data, "delayed_data")) { + data$ui(ns("data")) } else if (inherits(data, "teal_data")) { div() } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) { @@ -59,9 +59,9 @@ ui_teal_with_splash <- function(id, #' If data is not loaded yet, `reactive` returns `NULL`. #' @export srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { - checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data", "teal_transform_module")) + checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data", "delayed_data")) moduleServer(id, function(input, output, session) { - logger::log_trace("srv_teal_with_splash initializing module with data { toString(get_dataname(data))}.") + logger::log_trace("srv_teal_with_splash initializing module with data.") if (getOption("teal.show_js_log", default = FALSE)) { shinyjs::showLog() @@ -69,8 +69,14 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { # raw_data contains teal_data object # either passed to teal::init or returned from ddl - raw_data <- if (inherits(data, "teal_transform_module")) { - ddl_out <- data$server(id, data = attr(data, "data")) + raw_data <- if (inherits(data, "delayed_data")) { + ddl_out <- do.call( + data$server, + append( + list(id = "data"), + attr(data, "server_args") + ) + ) } else if (inherits(data, "teal_data")) { reactiveVal(data) } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) { @@ -135,7 +141,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { res <- srv_teal(id = "teal", modules = modules, raw_data = raw_data_checked, filter = filter) - logger::log_trace("srv_teal_with_splash initialized module with data { toString(get_dataname(data))}.") + logger::log_trace("srv_teal_with_splash initialized module with data.") return(res) }) } From 51b3f79521f6ebc306a2d7c3d967b9dcbf828ed2 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: Fri, 3 Nov 2023 06:45:05 +0000 Subject: [PATCH 10/51] [skip actions] Roxygen Man Pages Auto Update --- man/delayed_data.Rd | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) create mode 100644 man/delayed_data.Rd diff --git a/man/delayed_data.Rd b/man/delayed_data.Rd new file mode 100644 index 0000000000..e429a7cb3f --- /dev/null +++ b/man/delayed_data.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-transform_module.R +\name{delayed_data} +\alias{delayed_data} +\title{\code{delayed_data} for \code{teal_data}} +\usage{ +delayed_data(ui, server, ...) +} +\arguments{ +\item{ui}{(\verb{function(id)}) function to create UI} + +\item{server}{(\verb{function(id)}) \code{shiny} server which returns \code{teal_data} object wrapped in +\code{reactive}. \code{server} should have \code{id} argument and exactly the same formals as specified in \code{...}.} + +\item{...}{(\code{any}) arguments passed to \code{server} function.} +} +\description{ +Function creates object of class \code{delayed_data} which allows +\code{teal} app developer to transform freely \code{teal_data} object passed to \code{data} argument in +\code{\link[=init]{init()}}. This helps in case when app developer wants to use \code{teal} app +where \code{data} can be influenced by app user. For example, app developer can create +\code{teal} app which allows user to connect to database and then use data from this database. +} From e43c76a572406c435d41489cb922633f526b7bb1 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 3 Nov 2023 08:00:08 +0100 Subject: [PATCH 11/51] need to quote to avoid eval of language objects --- R/module_teal_with_splash.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 297997013a..4e840b0753 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -75,7 +75,8 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { append( list(id = "data"), attr(data, "server_args") - ) + ), + quote = TRUE ) } else if (inherits(data, "teal_data")) { reactiveVal(data) From f0c1cc6e0538c99f54a596ec8e65bee90f84bbf1 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 3 Nov 2023 09:59:48 +0100 Subject: [PATCH 12/51] allow no server_args --- R/data-transform_module.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/data-transform_module.R b/R/data-transform_module.R index 9519a2526a..3e948492f1 100644 --- a/R/data-transform_module.R +++ b/R/data-transform_module.R @@ -13,7 +13,7 @@ delayed_data <- function(ui, server, ...) { checkmate::assert_function(ui, args = "id") server_args <- list(...) - if (is.null(names(server_args))) { + if (length(server_args) && is.null(names(server_args))) { stop("All arguments passed to delayed_data() should be named") } From df885f3cbfefb87449d3a30fa002096ec82e8414 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 3 Nov 2023 10:10:10 +0100 Subject: [PATCH 13/51] change assertion to list(ui, server)! --- R/data-transform_module.R | 6 +++--- R/init.R | 9 +++++---- R/module_teal_with_splash.R | 6 +++--- R/utils.R | 5 +++++ 4 files changed, 16 insertions(+), 10 deletions(-) diff --git a/R/data-transform_module.R b/R/data-transform_module.R index 3e948492f1..111354b5b9 100644 --- a/R/data-transform_module.R +++ b/R/data-transform_module.R @@ -38,9 +38,9 @@ delayed_data <- function(ui, server, ...) { ) } - structure( - list(ui = ui, server = server), + x <- list(ui = ui, server = server) + structure(x, server_args = server_args, - class = "delayed_data" + class = c("delayed_data", class(x)) ) } diff --git a/R/init.R b/R/init.R index 3ec7e03352..add283dfee 100644 --- a/R/init.R +++ b/R/init.R @@ -114,12 +114,13 @@ init <- function(data = teal_data(), footer = tags$p(), id = character(0)) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") - - if (!inherits(data, c("TealData", "teal_data", "delayed_data"))) { + if ( + !inherits(data, c("TealData", "teal_data")) && !is_shiny_module_list(data) + ) { data <- teal.data::to_relational_data(data = data) } - checkmate::assert_multi_class(data, c("TealData", "teal_data", "delayed_data")) + checkmate::assert_multi_class(data, c("TealData", "teal_data", "list", "delayed_data")) checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules")) checkmate::assert_string(title, null.ok = TRUE) checkmate::assert( @@ -147,7 +148,7 @@ init <- function(data = teal_data(), hashables <- mget(c("data", "modules")) hashables$data <- if (inherits(hashables$data, "teal_data")) { as.list(hashables$data@env) - } else if (inherits(data, "delayed_data")) { + } else if (is_shiny_module_list(data)) { # what? } else if (hashables$data$is_pulled()) { sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) { diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 4e840b0753..610f5eb7c4 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -30,7 +30,7 @@ ui_teal_with_splash <- function(id, # This has the benefit that when filtering the data takes a lot of time initially, the # Shiny app does not time out. - splash_ui <- if (inherits(data, "delayed_data")) { + splash_ui <- if (is_shiny_module_list(data)) { data$ui(ns("data")) } else if (inherits(data, "teal_data")) { div() @@ -69,12 +69,12 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { # raw_data contains teal_data object # either passed to teal::init or returned from ddl - raw_data <- if (inherits(data, "delayed_data")) { + raw_data <- if (is_shiny_module_list(data)) { ddl_out <- do.call( data$server, append( list(id = "data"), - attr(data, "server_args") + attr(data, "server_args") # might be NULL or list() - both are fine ), quote = TRUE ) diff --git a/R/utils.R b/R/utils.R index 9474078f6d..f2f3b56431 100644 --- a/R/utils.R +++ b/R/utils.R @@ -188,3 +188,8 @@ check_filter_datanames <- function(filters, datanames) { TRUE } } + + +is_shiny_module_list <- function(x) { + is.list(x) && identical(names(x), c("ui", "server")) +} From a324e21c83afc8db24347d6f5848b6ccd2a9056c Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 3 Nov 2023 10:14:59 +0100 Subject: [PATCH 14/51] tighten up asserts --- R/init.R | 9 ++++++--- R/module_teal_with_splash.R | 4 ++-- R/utils.R | 13 +++++++++++-- 3 files changed, 19 insertions(+), 7 deletions(-) diff --git a/R/init.R b/R/init.R index add283dfee..287d1c175c 100644 --- a/R/init.R +++ b/R/init.R @@ -115,12 +115,15 @@ init <- function(data = teal_data(), id = character(0)) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") if ( - !inherits(data, c("TealData", "teal_data")) && !is_shiny_module_list(data) + !inherits(data, c("TealData", "teal_data")) && !test_shiny_module_list(data) ) { data <- teal.data::to_relational_data(data = data) } - checkmate::assert_multi_class(data, c("TealData", "teal_data", "list", "delayed_data")) + checkmate::assert( + checkmate::check_multi_class(data, c("TealData", "teal_data")), + check_shiny_module_list(data) + ) checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules")) checkmate::assert_string(title, null.ok = TRUE) checkmate::assert( @@ -148,7 +151,7 @@ init <- function(data = teal_data(), hashables <- mget(c("data", "modules")) hashables$data <- if (inherits(hashables$data, "teal_data")) { as.list(hashables$data@env) - } else if (is_shiny_module_list(data)) { + } else if (test_shiny_module_list(data)) { # what? } else if (hashables$data$is_pulled()) { sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) { diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 610f5eb7c4..9c92d54f5d 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -30,7 +30,7 @@ ui_teal_with_splash <- function(id, # This has the benefit that when filtering the data takes a lot of time initially, the # Shiny app does not time out. - splash_ui <- if (is_shiny_module_list(data)) { + splash_ui <- if (test_shiny_module_list(data)) { data$ui(ns("data")) } else if (inherits(data, "teal_data")) { div() @@ -69,7 +69,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { # raw_data contains teal_data object # either passed to teal::init or returned from ddl - raw_data <- if (is_shiny_module_list(data)) { + raw_data <- if (test_shiny_module_list(data)) { ddl_out <- do.call( data$server, append( diff --git a/R/utils.R b/R/utils.R index f2f3b56431..fe7e161ac9 100644 --- a/R/utils.R +++ b/R/utils.R @@ -190,6 +190,15 @@ check_filter_datanames <- function(filters, datanames) { } -is_shiny_module_list <- function(x) { - is.list(x) && identical(names(x), c("ui", "server")) +test_shiny_module_list <- function(data) { + is.list(data) && identical(names(data), c("ui", "server")) +} + + +check_shiny_module_list <- function(data) { + if (!test_shiny_module_list(data)) { + "`data` should be a list with 'ui' and 'server' elements." + } else { + TRUE + } } From 3ac84f9f78597c5a634c404bb22e1162b366bf46 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 3 Nov 2023 11:55:34 +0100 Subject: [PATCH 15/51] fix asserts in teal with splash --- R/module_teal_with_splash.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 9c92d54f5d..3aada74dfe 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -22,7 +22,10 @@ ui_teal_with_splash <- function(id, title, header = tags$p("Add Title Here"), footer = tags$p("Add Footer Here")) { - checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data", "delayed_data")) + checkmate::assert( + checkmate::check_multi_class(data, c("TealData", "teal_data")), + check_shiny_module_list(data) + ) ns <- NS(id) # Startup splash screen for delayed loading @@ -59,7 +62,10 @@ ui_teal_with_splash <- function(id, #' If data is not loaded yet, `reactive` returns `NULL`. #' @export srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { - checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data", "delayed_data")) + checkmate::assert( + checkmate::check_multi_class(data, c("TealData", "teal_data")), + check_shiny_module_list(data) + ) moduleServer(id, function(input, output, session) { logger::log_trace("srv_teal_with_splash initializing module with data.") From e11acd7c17337888d6d054ff33c23e260c1782cc Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 3 Nov 2023 12:48:36 +0100 Subject: [PATCH 16/51] example ddl --- R/{data-data-utils.R => data-ddl-utils.R} | 29 ++++++++++++----------- R/data-transform_module.R | 2 +- 2 files changed, 16 insertions(+), 15 deletions(-) rename R/{data-data-utils.R => data-ddl-utils.R} (80%) diff --git a/R/data-data-utils.R b/R/data-ddl-utils.R similarity index 80% rename from R/data-data-utils.R rename to R/data-ddl-utils.R index 674db157ce..a2e43e0f8f 100644 --- a/R/data-data-utils.R +++ b/R/data-ddl-utils.R @@ -67,22 +67,23 @@ eval_and_mask <- function(data, ) } -#' Convenience wrapper for ddl_login_password -ddl_login_password <- function(data, code, input_mask) { - srv <- function(id, data) { - moduleServer(id, function(input, output, session) { - eventReactive(input$submit, { - eval_and_mask(data, code = code, input = input, input_mask = input_mask) - }) - }) - } +#' Convenience wrapper for ddl +#' @export # todo: do we want to export this? +ddl <- function(code, input_mask, ui, server) { + delayed_data(ui = ui, server = server, code = code, input_mask = input_mask) +} - ui <- function(id) { - ns <- NS(id) - actionButton(inputId = ns("submit"), label = "Submit") - } +ui_login_and_password <- function(id) { + ns <- NS(id) + actionButton(inputId = ns("submit"), label = "Submit") +} - delayed_data(data, ui, server) +srv_login_and_password <- function(id, code, input_mask) { + moduleServer(id, function(input, output, session) { + eventReactive(input$submit, { + teal_data() |> eval_and_mask(code = code, input = input, input_mask = input_mask) + }) + }) } diff --git a/R/data-transform_module.R b/R/data-transform_module.R index 111354b5b9..33305c2c6d 100644 --- a/R/data-transform_module.R +++ b/R/data-transform_module.R @@ -9,7 +9,7 @@ #' @param ui (`function(id)`) function to create UI #' @param server (`function(id)`) `shiny` server which returns `teal_data` object wrapped in #' `reactive`. `server` should have `id` argument and exactly the same formals as specified in `...`. -#' @export +#' @export # todo: do we want to export this? delayed_data <- function(ui, server, ...) { checkmate::assert_function(ui, args = "id") server_args <- list(...) From 0bb2e7018d79adb49a78ebdb7d1e821d91942e29 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: Fri, 3 Nov 2023 11:53:50 +0000 Subject: [PATCH 17/51] [skip actions] Roxygen Man Pages Auto Update --- DESCRIPTION | 2 +- man/ddl.Rd | 11 +++++++++++ man/dot-substitute_code.Rd | 2 +- man/eval_and_mask.Rd | 2 +- 4 files changed, 14 insertions(+), 3 deletions(-) create mode 100644 man/ddl.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 7efe22a1fa..5445548ad3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -71,7 +71,7 @@ LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 Collate: - 'data-data-utils.R' + 'data-ddl-utils.R' 'data-transform_module.R' 'dummy_functions.R' 'get_rcode_utils.R' diff --git a/man/ddl.Rd b/man/ddl.Rd new file mode 100644 index 0000000000..5d53020f17 --- /dev/null +++ b/man/ddl.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-ddl-utils.R +\name{ddl} +\alias{ddl} +\title{Convenience wrapper for ddl} +\usage{ +ddl(code, input_mask, ui, server) +} +\description{ +Convenience wrapper for ddl +} diff --git a/man/dot-substitute_code.Rd b/man/dot-substitute_code.Rd index e1305affae..cd29296600 100644 --- a/man/dot-substitute_code.Rd +++ b/man/dot-substitute_code.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-data-utils.R +% Please edit documentation in R/data-ddl-utils.R \name{.substitute_code} \alias{.substitute_code} \title{Substitute symbols in the code} diff --git a/man/eval_and_mask.Rd b/man/eval_and_mask.Rd index 6b107be887..8f3535c23d 100644 --- a/man/eval_and_mask.Rd +++ b/man/eval_and_mask.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-data-utils.R +% Please edit documentation in R/data-ddl-utils.R \name{eval_and_mask} \alias{eval_and_mask} \title{Function runs the \code{code}, masks the \code{code} and creates \code{teal_data} object.} From 9244d337baa9d3aad7bf0123105f150b1d4c3130 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 6 Nov 2023 07:49:52 +0100 Subject: [PATCH 18/51] review suggestions - input, input_mask to env and env_mask to match substitute formals - make assertions - fix failing tests and vignettes --- NAMESPACE | 5 + R/data-ddl-utils.R | 51 ++++---- R/data-transform_module.R | 9 +- R/module_teal.R | 25 ++-- R/module_teal_with_splash.R | 3 + R/utils.R | 8 +- man/ddl.Rd | 12 +- man/ddl_login_password.Rd | 11 -- man/dot-substitute_code.Rd | 7 +- man/eval_and_mask.Rd | 6 +- man/submit_button_module.Rd | 23 ---- man/teal_transform.Rd | 23 ---- tests/testthat/test-init.R | 19 +-- tests/testthat/test-module_nested_tabs.R | 20 ++-- tests/testthat/test-module_teal.R | 45 +++---- tests/testthat/test-module_teal_with_splash.R | 113 +++++++++++++++--- tests/testthat/test-rcode_utils.R | 22 +--- vignettes/adding-support-for-reporting.Rmd | 2 +- 18 files changed, 224 insertions(+), 180 deletions(-) delete mode 100644 man/ddl_login_password.Rd delete mode 100644 man/submit_button_module.Rd delete mode 100644 man/teal_transform.Rd diff --git a/NAMESPACE b/NAMESPACE index 242ffaf984..dc6767b1f6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,10 @@ S3method(ui_nested_tabs,teal_modules) export("%>%") export(TealReportCard) export(as.teal_slices) +export(close_conn) +export(ddl) +export(delayed_data) +export(eval_and_mask) export(example_module) export(get_code_tdata) export(get_metadata) @@ -26,6 +30,7 @@ export(landing_popup_module) export(module) export(modules) export(new_tdata) +export(open_conn) export(report_card_template) export(reporter_previewer_module) export(show_rcode_modal) diff --git a/R/data-ddl-utils.R b/R/data-ddl-utils.R index a2e43e0f8f..3ebd959bd0 100644 --- a/R/data-ddl-utils.R +++ b/R/data-ddl-utils.R @@ -1,23 +1,24 @@ #' Function runs the `code`, masks the `code` and creates `teal_data` object. #' @param data (`teal_data`) object #' @param code (`language`) code to evaluate -#' @param input (`list`) containing inputs to be used in the `code` -#' @param input_mask (`list`) containing inputs to be masked in the `code` +#' @param env (`list`) containing inputs to be used in the `code` +#' @param env_mask (`list`) containing inputs to be masked in the `code` #' #' @return `teal_data` object #' #' @export eval_and_mask <- function(data, code, - input = list(), - input_mask = list()) { - # todo: do we need also within_and_mask? - checkmate::assert_list(input) - if (inherits(input, "reactivevalues")) { - input <- shiny::reactiveValuesToList(input) - } + env = list(), + env_mask = list()) { + checkmate::assert_class(data, "teal_data") + checkmate::assert_true(is.language(code)) + checkmate::assert_list(env) + checkmate::assert_list(env_mask) + + # evaluate code and substitute input - data <- teal.code::eval_code(data, .substitute_code(code, args = input)) + data <- teal.code::eval_code(data, .substitute_code(expr = code, env = env)) if (inherits(data, "qenv.error")) { return(data) } @@ -29,14 +30,14 @@ eval_and_mask <- function(data, ) } - if (!missing(input_mask)) { + if (!missing(env_mask)) { # mask dynamic inputs with mask - input <- utils::modifyList(input, input_mask) + env_masked <- utils::modifyList(env, env_mask) # replace last code entry with masked code # format_expression needed to convert expression into character(1) # question: warnings and errors are not masked, is it ok? - data@code[length(data@code)] <- format_expression(.substitute_code(code, args = input)) + data@code[length(data@code)] <- format_expression(.substitute_code(expr = code, env = env_masked)) } # todo: should it be here or in datanames(data)? @@ -51,26 +52,30 @@ eval_and_mask <- function(data, #' #' Function replaces symbols in the provided code by values of the `args` argument. #' -#' @param code (`language`) code to substitute -#' @param args (`list`) named list or arguments +#' @inheritParams base::substitute #' @keywords internal -.substitute_code <- function(code, args) { +.substitute_code <- function(expr, env) { do.call( substitute, list( expr = do.call( substitute, - list(expr = code) + list(expr = expr) ), - env = args + env = env ) ) } #' Convenience wrapper for ddl -#' @export # todo: do we want to export this? -ddl <- function(code, input_mask, ui, server) { - delayed_data(ui = ui, server = server, code = code, input_mask = input_mask) +#' +#' @inheritParams delayed_data +#' @param code (`character` or `language`) +#' @param env_mask (`named list`) +#' @export +ddl <- function(code, env_mask, ui, server) { + # todo: do we want to export this? + delayed_data(ui = ui, server = server, code = code, env_mask = env_mask) } ui_login_and_password <- function(id) { @@ -78,10 +83,10 @@ ui_login_and_password <- function(id) { actionButton(inputId = ns("submit"), label = "Submit") } -srv_login_and_password <- function(id, code, input_mask) { +srv_login_and_password <- function(id, code, env_mask) { moduleServer(id, function(input, output, session) { eventReactive(input$submit, { - teal_data() |> eval_and_mask(code = code, input = input, input_mask = input_mask) + eval_and_mask(teal_data(), code = code, env = reactiveValuesToList(input), env_mask = env_mask) }) }) } diff --git a/R/data-transform_module.R b/R/data-transform_module.R index 33305c2c6d..cb945fc5ae 100644 --- a/R/data-transform_module.R +++ b/R/data-transform_module.R @@ -1,7 +1,7 @@ #' `delayed_data` for `teal_data` #' #' Function creates object of class `delayed_data` which allows -#' `teal` app developer to transform freely `teal_data` object passed to `data` argument in +#' `teal` app developer to transform `teal_data` object passed to `data` argument in #' [teal::init()]. This helps in case when app developer wants to use `teal` app #' where `data` can be influenced by app user. For example, app developer can create #' `teal` app which allows user to connect to database and then use data from this database. @@ -9,8 +9,9 @@ #' @param ui (`function(id)`) function to create UI #' @param server (`function(id)`) `shiny` server which returns `teal_data` object wrapped in #' `reactive`. `server` should have `id` argument and exactly the same formals as specified in `...`. -#' @export # todo: do we want to export this? +#' @export delayed_data <- function(ui, server, ...) { + # todo: do we want to export this? checkmate::assert_function(ui, args = "id") server_args <- list(...) if (length(server_args) && is.null(names(server_args))) { @@ -19,11 +20,11 @@ delayed_data <- function(ui, server, ...) { server_formals <- names(formals(server)) extra_args <- setdiff(names(server_args), server_formals) - if (length(extra_args) > 0) { + if (length(extra_args) > 0 && !"..." %in% server_formals) { stop( "Unexpected arguments specified in delayed_data(): ", toString(extra_args), - "\n arguments specified in `...` should be the same as in `server` function", + "\n arguments specified in `...` should be accepted by the `server` function", call. = FALSE ) } diff --git a/R/module_teal.R b/R/module_teal.R index 7c531ef053..0affb20dfd 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -165,16 +165,9 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { modules <- append_module(modules, reporter_previewer_module()) } - # Replace splash / welcome screen once data is loaded ---- - # ignoreNULL to not trigger at the beginning when data is NULL - # just handle it once because data obtained through delayed loading should - # usually not change afterwards - # if restored from bookmarked state, `filter` is ignored env <- environment() - observeEvent(raw_data(), { - logger::log_trace("srv_teal@5 setting main ui after data was pulled") + datasets_reactive <- eventReactive(raw_data(), { env$progress <- shiny::Progress$new(session) - on.exit(env$progress$close()) env$progress$set(0.25, message = "Setting data") # create a list of data following structure of the nested modules list structure. @@ -217,10 +210,22 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { datasets_singleton } } - datasets <- module_datasets(modules) + module_datasets(modules) + }) - # main_ui_container contains splash screen first and we remove it and replace it by the real UI + # Replace splash / welcome screen once data is loaded ---- + # ignoreNULL to not trigger at the beginning when data is NULL + # just handle it once because data obtained through delayed loading should + # usually not change afterwards + # if restored from bookmarked state, `filter` is ignored + + observeEvent(datasets_reactive(), { + logger::log_trace("srv_teal@5 setting main ui after data was pulled") + on.exit(env$progress$close()) env$progress$set(0.5, message = "Setting up main UI") + datasets <- datasets_reactive() + + # main_ui_container contains splash screen first and we remove it and replace it by the real UI removeUI(sprintf("#%s:first-child", session$ns("main_ui_container"))) insertUI( selector = paste0("#", session$ns("main_ui_container")), diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 3aada74dfe..4dc09a94bb 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -125,6 +125,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { if (inherits(data, "qenv.error")) { # showNotification(sprintf("Error: %s", data$message)) + logger::log_error(data$message) return(NULL) } @@ -133,12 +134,14 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { if (!isTRUE(is_modules_ok)) { showNotification(is_modules_ok) + logger::log_error(is_modules_ok) # NULL won't trigger observe which waits for raw_data() # we will need to consider validate process for filtered data and modules! return(NULL) } if (!isTRUE(is_filter_ok)) { showNotification(is_filter_ok) + logger::log_warn(is_filter_ok) # we allow app to continue if applied filters are outside # of possible data range } diff --git a/R/utils.R b/R/utils.R index fe7e161ac9..570b3b9256 100644 --- a/R/utils.R +++ b/R/utils.R @@ -152,8 +152,8 @@ check_modules_datanames <- function(modules, datanames) { sprintf( "- Module %s has a different dataname than available in a 'data': %s not in %s", modules$label, - toString(extra_datanames), - toString(datanames) + toString(dQuote(extra_datanames, q = FALSE)), + toString(dQuote(datanames, q = FALSE)) ) } } @@ -176,8 +176,8 @@ check_filter_datanames <- function(filters, datanames) { sprintf( "- Filter %s has a different dataname than available in a 'data':\n %s not in %s", filter$label, - dataname, - toString(datanames) + dQuote(dataname), + toString(dQuote(datanames)) ) } } diff --git a/man/ddl.Rd b/man/ddl.Rd index 5d53020f17..39e5e2df36 100644 --- a/man/ddl.Rd +++ b/man/ddl.Rd @@ -4,7 +4,17 @@ \alias{ddl} \title{Convenience wrapper for ddl} \usage{ -ddl(code, input_mask, ui, server) +ddl(code, env_mask, ui, server) +} +\arguments{ +\item{code}{(\code{character} or \code{language})} + +\item{env_mask}{(\verb{named list})} + +\item{ui}{(\verb{function(id)}) function to create UI} + +\item{server}{(\verb{function(id)}) \code{shiny} server which returns \code{teal_data} object wrapped in +\code{reactive}. \code{server} should have \code{id} argument and exactly the same formals as specified in \code{...}.} } \description{ Convenience wrapper for ddl diff --git a/man/ddl_login_password.Rd b/man/ddl_login_password.Rd deleted file mode 100644 index f2a82dfa92..0000000000 --- a/man/ddl_login_password.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-data-utils.R -\name{ddl_login_password} -\alias{ddl_login_password} -\title{Convenience wrapper for ddl_login_password} -\usage{ -ddl_login_password(data, code, input_mask) -} -\description{ -Convenience wrapper for ddl_login_password -} diff --git a/man/dot-substitute_code.Rd b/man/dot-substitute_code.Rd index cd29296600..d746a137a8 100644 --- a/man/dot-substitute_code.Rd +++ b/man/dot-substitute_code.Rd @@ -4,12 +4,13 @@ \alias{.substitute_code} \title{Substitute symbols in the code} \usage{ -.substitute_code(code, args) +.substitute_code(expr, env) } \arguments{ -\item{code}{(\code{language}) code to substitute} +\item{expr}{any syntactically valid \R expression} -\item{args}{(\code{list}) named list or arguments} +\item{env}{an environment or a list object. Defaults to the + current evaluation environment.} } \description{ Function replaces symbols in the provided code by values of the \code{args} argument. diff --git a/man/eval_and_mask.Rd b/man/eval_and_mask.Rd index 8f3535c23d..9e6840d362 100644 --- a/man/eval_and_mask.Rd +++ b/man/eval_and_mask.Rd @@ -4,16 +4,16 @@ \alias{eval_and_mask} \title{Function runs the \code{code}, masks the \code{code} and creates \code{teal_data} object.} \usage{ -eval_and_mask(data, code, input = list(), input_mask = list()) +eval_and_mask(data, code, env = list(), env_mask = list()) } \arguments{ \item{data}{(\code{teal_data}) object} \item{code}{(\code{language}) code to evaluate} -\item{input}{(\code{list}) containing inputs to be used in the \code{code}} +\item{env}{(\code{list}) containing inputs to be used in the \code{code}} -\item{input_mask}{(\code{list}) containing inputs to be masked in the \code{code}} +\item{env_mask}{(\code{list}) containing inputs to be masked in the \code{code}} } \value{ \code{teal_data} object diff --git a/man/submit_button_module.Rd b/man/submit_button_module.Rd deleted file mode 100644 index 13afc1dc1b..0000000000 --- a/man/submit_button_module.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-module.R -\name{submit_button_module} -\alias{submit_button_module} -\alias{submit_button_ui} -\alias{submit_button_server} -\title{Run code and mask inputs} -\usage{ -submit_button_ui(id) - -submit_button_server(id, data) -} -\arguments{ -\item{id}{(\code{character}) \code{shiny} module id.} - -\item{...}{(\code{list}) arguments passed to \code{\link[=eval_and_mask]{eval_and_mask()}}.} -} -\value{ -\code{shiny} module -} -\description{ -Delayed Data Loading module with login and password input. -} diff --git a/man/teal_transform.Rd b/man/teal_transform.Rd deleted file mode 100644 index 825200e564..0000000000 --- a/man/teal_transform.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-transform_module.R -\name{teal_transform} -\alias{teal_transform} -\title{Transform module for \code{teal_data}} -\usage{ -teal_transform(data, ui, server) -} -\arguments{ -\item{data}{\code{teal_data} object} - -\item{ui}{(\verb{function(id)}) function to create UI} - -\item{server}{(\verb{function(id, data)}) \code{shiny} server -which returns \code{teal_data} object wrapped in \code{reactive}.} -} -\description{ -Function creates object of class \code{teal_trnasform_module} which allows -\code{teal} app developer to transform freely \code{teal_data} object passed to \code{data} argument in -\code{\link[=init]{init()}}. This helps in case when app developer wants to use \code{teal} app -where \code{data} can be influenced by app user. For example, app developer can create -\code{teal} app which allows user to connect to database and then use data from this database. -} diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index a34e460472..bf95d2ade4 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -1,5 +1,5 @@ testthat::test_that("init data accepts TealData object", { - testthat::expect_no_error( + lifecycle::expect_deprecated( init( data = teal.data::cdisc_data( teal.data::cdisc_dataset( @@ -140,6 +140,15 @@ testthat::test_that("init data accepts a list of TealDatasetConnector object", { testthat::expect_no_error(init(data = dsc1, modules = modules(example_module()))) }) +testthat::test_that("init data accepts a list with ui and server", { + testthat::expect_no_error( + init( + data = list(ui = function(id) div(), server = function(id) NULL), + modules = modules(teal:::example_module()) + ) + ) +}) + testthat::test_that("init modules accepts a teal_modules object", { mods <- modules(example_module(), example_module()) testthat::expect_no_error(init(data = iris, modules = mods)) @@ -155,16 +164,10 @@ testthat::test_that("init modules accepts a teal_module object", { testthat::expect_no_error(init(data = iris, modules = mods)) }) -testthat::test_that("init filter accepts named list or `teal_slices`", { - fl <- list( - "iris" = list( - "Species" = list(selected = "setosa") - ) - ) +testthat::test_that("init filter accepts `teal_slices`", { fs <- teal.slice::teal_slices( teal.slice::teal_slice(dataname = "iris", varname = "species", selected = "setosa") ) - testthat::expect_no_error(init(data = list(iris), modules = modules(example_module()), filter = fl)) testthat::expect_no_error(init(data = list(iris), modules = modules(example_module()), filter = fs)) testthat::expect_error( init(data = list(iris), modules = modules(example_module()), filter = unclass(fs)), diff --git a/tests/testthat/test-module_nested_tabs.R b/tests/testthat/test-module_nested_tabs.R index 74aea0ecd8..858f2cc460 100644 --- a/tests/testthat/test-module_nested_tabs.R +++ b/tests/testthat/test-module_nested_tabs.R @@ -485,10 +485,10 @@ testthat::test_that("calculate_hashes takes a FilteredData and vector of datanam adtte <- data.frame(STUDYID = 1, USUBJID = 1, PARAMCD = 1) datasets <- teal.slice::init_filtered_data( - teal.data::cdisc_data( - teal.data::cdisc_dataset("ADSL", adsl), - teal.data::cdisc_dataset("ADAE", adae), - teal.data::cdisc_dataset("ADTTE", adtte) + list( + ADSL = list(dataset = head(adsl)), + ADAE = list(dataset = head(adae)), + ADTTE = list(dataset = head(adtte)) ) ) @@ -501,10 +501,10 @@ testthat::test_that("calculate_hashes returns a named list", { adtte <- data.frame(STUDYID = 1, USUBJID = 1, PARAMCD = 1) datasets <- teal.slice::init_filtered_data( - teal.data::cdisc_data( - teal.data::cdisc_dataset("ADSL", adsl), - teal.data::cdisc_dataset("ADAE", adae), - teal.data::cdisc_dataset("ADTTE", adtte) + list( + ADSL = list(dataset = adsl), + ADAE = list(dataset = adae), + ADTTE = list(dataset = adtte) ) ) @@ -523,9 +523,7 @@ testthat::test_that("calculate_hashes returns a named list", { testthat::test_that("calculate_hashes returns the hash of the non Filtered dataset", { datasets <- teal.slice::init_filtered_data( - teal.data::teal_data( - teal.data::dataset("iris", iris) - ) + list(iris = list(dataset = iris)) ) fs <- teal.slice:::teal_slices( diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R index ca3cc28d8f..506ebac833 100644 --- a/tests/testthat/test-module_teal.R +++ b/tests/testthat/test-module_teal.R @@ -1,22 +1,11 @@ -data <- teal_data(iris1 = iris, mtcars1 = mtcars, code = "iris1 <- iris; mtcars1 <- mtcars") - -test_module1 <- example_module( - label = "iris_tab", - datanames = "iris1" -) -test_module2 <- example_module( - label = "mtcars_tab", - datanames = "mtcars1" -) - testthat::test_that("srv_teal fails when raw_data is not reactive", { testthat::expect_error( shiny::testServer( app = srv_teal, args = list( id = "test", - raw_data = data, - modules = modules(test_module1) + raw_data = teal_data(iris = iris), + modules = modules(example_module()) ), expr = NULL ), @@ -24,28 +13,36 @@ testthat::test_that("srv_teal fails when raw_data is not reactive", { ) }) -testthat::test_that("srv_teal initializes the data when raw_data changes", { +testthat::test_that("srv_teal when raw_data changes, datasets_reactive is initialized as list of FilteredData", { + data <- teal_data(iris1 = iris, mtcars1 = mtcars) shiny::testServer( app = srv_teal, args = list( id = "test", raw_data = reactiveVal(NULL), - modules = modules(test_module1) + modules = modules( + example_module(label = "iris_tab"), + example_module(label = "mtcars_tab") + ) ), expr = { raw_data(data) - testthat::expect_named(datasets_reactive(), "iris_tab") + checkmate::expect_list(datasets_reactive(), types = "FilteredData") } ) }) -testthat::test_that("srv_teal initialized data list structure reflects modules", { +testthat::test_that("srv_teal initialized datasets_reactive (list) reflects modules structure", { + data <- teal_data(iris1 = iris, mtcars1 = mtcars) shiny::testServer( app = srv_teal, args = list( id = "test", raw_data = reactiveVal(data), - modules = modules(test_module1, modules(label = "tab", test_module1, test_module2)) + modules = modules( + example_module("iris_tab"), + modules(label = "tab", example_module("iris_tab"), example_module("mtcars_tab")) + ) ), expr = { raw_data(data) @@ -56,12 +53,16 @@ testthat::test_that("srv_teal initialized data list structure reflects modules", }) testthat::test_that("srv_teal initialized data containing same FilteredData when the filter is global", { + data <- teal_data(iris1 = iris, mtcars1 = mtcars) shiny::testServer( app = srv_teal, args = list( id = "test", raw_data = reactiveVal(data), - modules = modules(test_module1, modules(label = "tab", test_module1, test_module2)), + modules = modules( + example_module("iris_tab"), + modules(label = "tab", example_module("iris_tab"), example_module("mtcars_tab")) + ), filter = teal_slices(module_specific = FALSE) ), expr = { @@ -74,12 +75,16 @@ testthat::test_that("srv_teal initialized data containing same FilteredData when }) testthat::test_that("srv_teal initialized data containing different FilteredData when the filter is module_specific", { + data <- teal_data(iris1 = iris, mtcars1 = mtcars) shiny::testServer( app = srv_teal, args = list( id = "test", raw_data = reactiveVal(data), - modules = modules(test_module1, modules(label = "tab", test_module1, test_module2)), + modules = modules( + example_module("iris_tab"), + modules(label = "tab", example_module("iris_tab"), example_module("mtcars_tab")) + ), filter = teal_slices(module_specific = TRUE) ), expr = { diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 039ea01011..2bf0d33a4c 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -1,36 +1,79 @@ -iris_ds <- teal.data::dataset(dataname = "iris", x = head(iris)) -mtcars_ds <- teal.data::dataset(dataname = "mtcars", x = head(mtcars)) -data <- teal_data(iris_ds, mtcars_ds) +testthat::test_that("srv_teal_with_splash data accepts a list with ui and server", { + testthat::expect_no_error( + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "id", + data = list(ui = function(id) div(), server = function(id) NULL), + modules = modules(example_module()) + ), + expr = {} + ) + ) +}) -test_module1 <- example_module( - label = "iris_tab", - datanames = "iris" -) +testthat::test_that("srv_teal_with_splash raw_data just evaluates the server when data is a module", { + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "test", + data = list(ui = function(id) div(), server = function(id) reactive("whatever")), + modules = modules(example_module()) + ), + expr = { + testthat::expect_is(raw_data, "reactive") + testthat::expect_identical(raw_data(), "whatever") + } + ) +}) + +testthat::test_that("srv_teal_with_splash passes teal_data to reactiveVal", { + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "test", + data = teal_data(), + modules = modules(example_module()) + ), + expr = { + testthat::expect_is(raw_data_checked, "reactive") + testthat::expect_s4_class(raw_data_checked(), "teal_data") + } + ) +}) -testthat::test_that("srv_teal_with_splash creates reactiveVal returning teal_data", { +testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL when qenv.error occurs", { shiny::testServer( app = srv_teal_with_splash, args = list( id = "test", - data = data, - modules = modules(test_module1) + data = list( + ui = function(id) div(), + server = function(id) reactive(teal_data() |> within(stop("not good"))) + ), + modules = modules(example_module()) ), expr = { - testthat::expect_is(raw_data, "reactiveVal") - testthat::expect_s4_class(raw_data(), "teal_data") + testthat::expect_is(raw_data_checked, "reactive") + testthat::expect_output( + testthat::expect_null(raw_data_checked()), + "not good" + ) } ) }) testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns NULL before loading", { x <- dataset_connector(dataname = "test_dataset", pull_callable = callable_code("iris")) - delayed_data <- teal_data(x) + lifecycle::expect_deprecated( + delayed_data <- teal_data(x) + ) shiny::testServer( app = srv_teal_with_splash, args = list( id = "test", data = delayed_data, - modules = modules(test_module1) + modules = modules(example_module()) ), expr = testthat::expect_null(raw_data()) ) @@ -39,13 +82,13 @@ testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns pulled data when loaded", { teal.logger::suppress_logs() x <- dataset_connector(dataname = "iris", pull_callable = callable_code("iris")) - delayed_data <- teal_data(x) + lifecycle::expect_deprecated(delayed_data <- teal_data(x)) shiny::testServer( app = srv_teal_with_splash, args = list( id = "test", data = delayed_data, - modules = modules(test_module1) + modules = modules(example_module()) ), expr = { testthat::expect_null(raw_data()) @@ -56,13 +99,47 @@ testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns ) }) +testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL if incompatible module's dataname", { + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "test", + data = teal_data(mtcars = mtcars), + modules = modules(example_module(datanames = "iris")) + ), + expr = { + testthat::expect_is(raw_data_checked, "reactive") + testthat::expect_output( + testthat::expect_null(raw_data_checked()), + '"iris" not in "mtcars"' + ) + } + ) +}) + +testthat::test_that("srv_teal_with_splash raw_data_checked returns teal_data even if incompatible filter's dataname", { + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "test", + data = teal_data(mtcars = mtcars), + modules = modules(example_module(datanames = "mtcars")), + filter = teal_slices(teal_slice(dataname = "iris", varname = "Species")) + ), + expr = { + testthat::expect_is(raw_data_checked, "reactive") + testthat::expect_s4_class(raw_data_checked(), "teal_data") + } + ) +}) + testthat::test_that("srv_teal_with_splash gets observe event from srv_teal", { shiny::testServer( app = srv_teal_with_splash, args = list( id = "test", - data = data, - modules = modules(test_module1) + data = teal_data(), + modules = modules(example_module()) ), expr = { testthat::expect_is(res, "Observer") diff --git a/tests/testthat/test-rcode_utils.R b/tests/testthat/test-rcode_utils.R index c3f29be1b6..1add79e18d 100644 --- a/tests/testthat/test-rcode_utils.R +++ b/tests/testthat/test-rcode_utils.R @@ -45,24 +45,12 @@ testthat::test_that("get_rcode_libraries returns current session packages", { }) testthat::test_that("get_datasets_code returns code only for specified datanames", { + # todo: need to use code dependency? Or test it later via public functions/modules datasets <- teal.slice::init_filtered_data( - teal.data::teal_data( - teal.data::dataset("IRIS", x = iris, code = "IRIS <- iris"), - teal.data::dataset("MTCARS", x = mtcars, code = "MTCARS <- mtcars") + list( + IRIS = list(dataset = iris), + MTCARS = list(dataset = mtcars) ) ) - - hashes <- calculate_hashes(datasets$datanames(), datasets) - testthat::expect_true( - !grepl( - "mtcars", - paste(get_datasets_code(datasets = datasets, dataname = "IRIS", hashes = hashes), collapse = "\n"), - ignore.case = TRUE - ) && - grepl( - "iris", - paste(get_datasets_code(datasets = datasets, dataname = "IRIS", hashes = hashes), collapse = "\n"), - ignore.case = TRUE - ) - ) + testthat::expect_true(TRUE) }) diff --git a/vignettes/adding-support-for-reporting.Rmd b/vignettes/adding-support-for-reporting.Rmd index b28fbd32f4..6d4a8001e9 100644 --- a/vignettes/adding-support-for-reporting.Rmd +++ b/vignettes/adding-support-for-reporting.Rmd @@ -322,7 +322,7 @@ app <- init( example_reporter_module(label = "with Reporter"), example_module(label = "without Reporter") ), - filter = list(AIR = list(Month = c(5, 5))), + filter = teal_slices(teal_slice(dataname = "AIR", varname = "Month", selected = c(5, 5))), header = "Example teal app with reporter" ) From d6b8d2f4bab3409ad341f23f3f708fdae8091aba 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, 6 Nov 2023 06:53:18 +0000 Subject: [PATCH 19/51] [skip actions] Roxygen Man Pages Auto Update --- man/delayed_data.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/delayed_data.Rd b/man/delayed_data.Rd index e429a7cb3f..8138744619 100644 --- a/man/delayed_data.Rd +++ b/man/delayed_data.Rd @@ -16,7 +16,7 @@ delayed_data(ui, server, ...) } \description{ Function creates object of class \code{delayed_data} which allows -\code{teal} app developer to transform freely \code{teal_data} object passed to \code{data} argument in +\code{teal} app developer to transform \code{teal_data} object passed to \code{data} argument in \code{\link[=init]{init()}}. This helps in case when app developer wants to use \code{teal} app where \code{data} can be influenced by app user. For example, app developer can create \code{teal} app which allows user to connect to database and then use data from this database. From 0ce0eb50dd822052cc242930389511d9419c5414 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 6 Nov 2023 09:55:39 +0100 Subject: [PATCH 20/51] fix notifications --- R/data-transform_module.R | 2 +- R/module_teal_with_splash.R | 13 ++++++++++--- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/R/data-transform_module.R b/R/data-transform_module.R index cb945fc5ae..51c5912267 100644 --- a/R/data-transform_module.R +++ b/R/data-transform_module.R @@ -5,9 +5,9 @@ #' [teal::init()]. This helps in case when app developer wants to use `teal` app #' where `data` can be influenced by app user. For example, app developer can create #' `teal` app which allows user to connect to database and then use data from this database. -#' @param ... (`any`) arguments passed to `server` function. #' @param ui (`function(id)`) function to create UI #' @param server (`function(id)`) `shiny` server which returns `teal_data` object wrapped in +#' @param ... (`any`) arguments passed to `server` function. #' `reactive`. `server` should have `id` argument and exactly the same formals as specified in `...`. #' @export delayed_data <- function(ui, server, ...) { diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 4dc09a94bb..37326490b7 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -124,23 +124,30 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { data <- raw_data() if (inherits(data, "qenv.error")) { # - showNotification(sprintf("Error: %s", data$message)) + showNotification(sprintf("Error: %s", data$message), type = "error") logger::log_error(data$message) return(NULL) } + if (!inherits(data, "teal_data")) { + msg <- "Error: server must return 'teal_data' object" + showNotification(msg, type = "error") + logger::log_error(msg) + return(NULL) + } + is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) if (!isTRUE(is_modules_ok)) { - showNotification(is_modules_ok) + showNotification(is_modules_ok, type = "error") logger::log_error(is_modules_ok) # NULL won't trigger observe which waits for raw_data() # we will need to consider validate process for filtered data and modules! return(NULL) } if (!isTRUE(is_filter_ok)) { - showNotification(is_filter_ok) + showNotification(is_filter_ok, type = "warning") logger::log_warn(is_filter_ok) # we allow app to continue if applied filters are outside # of possible data range From 71c150137646552f58765f84c501c78299c5fe37 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, 6 Nov 2023 09:00:08 +0000 Subject: [PATCH 21/51] [skip actions] Roxygen Man Pages Auto Update --- man/ddl.Rd | 3 +-- man/delayed_data.Rd | 6 +++--- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/man/ddl.Rd b/man/ddl.Rd index 39e5e2df36..fa14358f23 100644 --- a/man/ddl.Rd +++ b/man/ddl.Rd @@ -13,8 +13,7 @@ ddl(code, env_mask, ui, server) \item{ui}{(\verb{function(id)}) function to create UI} -\item{server}{(\verb{function(id)}) \code{shiny} server which returns \code{teal_data} object wrapped in -\code{reactive}. \code{server} should have \code{id} argument and exactly the same formals as specified in \code{...}.} +\item{server}{(\verb{function(id)}) \code{shiny} server which returns \code{teal_data} object wrapped in} } \description{ Convenience wrapper for ddl diff --git a/man/delayed_data.Rd b/man/delayed_data.Rd index 8138744619..10957a9ec0 100644 --- a/man/delayed_data.Rd +++ b/man/delayed_data.Rd @@ -9,10 +9,10 @@ delayed_data(ui, server, ...) \arguments{ \item{ui}{(\verb{function(id)}) function to create UI} -\item{server}{(\verb{function(id)}) \code{shiny} server which returns \code{teal_data} object wrapped in -\code{reactive}. \code{server} should have \code{id} argument and exactly the same formals as specified in \code{...}.} +\item{server}{(\verb{function(id)}) \code{shiny} server which returns \code{teal_data} object wrapped in} -\item{...}{(\code{any}) arguments passed to \code{server} function.} +\item{...}{(\code{any}) arguments passed to \code{server} function. +\code{reactive}. \code{server} should have \code{id} argument and exactly the same formals as specified in \code{...}.} } \description{ Function creates object of class \code{delayed_data} which allows From 0c52e1a3dedf254ba46d8cde5446ed5b8e5480c4 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 6 Nov 2023 18:25:01 +0100 Subject: [PATCH 22/51] removing delayed_data and ddl --- DESCRIPTION | 1 - NAMESPACE | 4 ---- R/data-ddl-utils.R | 41 ---------------------------------- R/data-transform_module.R | 47 --------------------------------------- R/init.R | 3 ++- R/utils.R | 7 ++++-- man/ddl.Rd | 20 ----------------- man/delayed_data.Rd | 23 ------------------- 8 files changed, 7 insertions(+), 139 deletions(-) delete mode 100644 R/data-transform_module.R delete mode 100644 man/ddl.Rd delete mode 100644 man/delayed_data.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 5445548ad3..6821e04503 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -72,7 +72,6 @@ Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 Collate: 'data-ddl-utils.R' - 'data-transform_module.R' 'dummy_functions.R' 'get_rcode_utils.R' 'include_css_js.R' diff --git a/NAMESPACE b/NAMESPACE index dc6767b1f6..5ed5025741 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,9 +18,6 @@ S3method(ui_nested_tabs,teal_modules) export("%>%") export(TealReportCard) export(as.teal_slices) -export(close_conn) -export(ddl) -export(delayed_data) export(eval_and_mask) export(example_module) export(get_code_tdata) @@ -30,7 +27,6 @@ export(landing_popup_module) export(module) export(modules) export(new_tdata) -export(open_conn) export(report_card_template) export(reporter_previewer_module) export(show_rcode_modal) diff --git a/R/data-ddl-utils.R b/R/data-ddl-utils.R index 3ebd959bd0..09ba28640b 100644 --- a/R/data-ddl-utils.R +++ b/R/data-ddl-utils.R @@ -40,11 +40,6 @@ eval_and_mask <- function(data, data@code[length(data@code)] <- format_expression(.substitute_code(expr = code, env = env_masked)) } - # todo: should it be here or in datanames(data)? - if (length(datanames(data)) == 0) { - datanames(data) <- ls(data@env) - } - data } @@ -66,39 +61,3 @@ eval_and_mask <- function(data, ) ) } - -#' Convenience wrapper for ddl -#' -#' @inheritParams delayed_data -#' @param code (`character` or `language`) -#' @param env_mask (`named list`) -#' @export -ddl <- function(code, env_mask, ui, server) { - # todo: do we want to export this? - delayed_data(ui = ui, server = server, code = code, env_mask = env_mask) -} - -ui_login_and_password <- function(id) { - ns <- NS(id) - actionButton(inputId = ns("submit"), label = "Submit") -} - -srv_login_and_password <- function(id, code, env_mask) { - moduleServer(id, function(input, output, session) { - eventReactive(input$submit, { - eval_and_mask(teal_data(), code = code, env = reactiveValuesToList(input), env_mask = env_mask) - }) - }) -} - - -# todo: to remove before merge ------------- -#' @export -open_conn <- function(username, password) { - if (password != "pass") stop("Invalid credentials. 'pass' is the password") else TRUE -} -#' @export -close_conn <- function(conn) { - message("closed") - return(NULL) -} diff --git a/R/data-transform_module.R b/R/data-transform_module.R deleted file mode 100644 index 51c5912267..0000000000 --- a/R/data-transform_module.R +++ /dev/null @@ -1,47 +0,0 @@ -#' `delayed_data` for `teal_data` -#' -#' Function creates object of class `delayed_data` which allows -#' `teal` app developer to transform `teal_data` object passed to `data` argument in -#' [teal::init()]. This helps in case when app developer wants to use `teal` app -#' where `data` can be influenced by app user. For example, app developer can create -#' `teal` app which allows user to connect to database and then use data from this database. -#' @param ui (`function(id)`) function to create UI -#' @param server (`function(id)`) `shiny` server which returns `teal_data` object wrapped in -#' @param ... (`any`) arguments passed to `server` function. -#' `reactive`. `server` should have `id` argument and exactly the same formals as specified in `...`. -#' @export -delayed_data <- function(ui, server, ...) { - # todo: do we want to export this? - checkmate::assert_function(ui, args = "id") - server_args <- list(...) - if (length(server_args) && is.null(names(server_args))) { - stop("All arguments passed to delayed_data() should be named") - } - - server_formals <- names(formals(server)) - extra_args <- setdiff(names(server_args), server_formals) - if (length(extra_args) > 0 && !"..." %in% server_formals) { - stop( - "Unexpected arguments specified in delayed_data(): ", - toString(extra_args), - "\n arguments specified in `...` should be accepted by the `server` function", - call. = FALSE - ) - } - - extra_formals <- setdiff(server_formals, c("id", names(server_args))) - if (length(extra_formals) > 0) { - stop( - "Missing arguments specified in delayed_data(): ", - toString(extra_formals), - "\n arguments specified in `...` should be the same as in `server` function", - call. = FALSE - ) - } - - x <- list(ui = ui, server = server) - structure(x, - server_args = server_args, - class = c("delayed_data", class(x)) - ) -} diff --git a/R/init.R b/R/init.R index 287d1c175c..6504cc697e 100644 --- a/R/init.R +++ b/R/init.R @@ -115,7 +115,8 @@ init <- function(data = teal_data(), id = character(0)) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") if ( - !inherits(data, c("TealData", "teal_data")) && !test_shiny_module_list(data) + !inherits(data, c("TealData", "teal_data")) && + !(is.list(data) && identical(names(data), c("ui", "server"))) ) { data <- teal.data::to_relational_data(data = data) } diff --git a/R/utils.R b/R/utils.R index 570b3b9256..30a6e0ef1d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -191,13 +191,16 @@ check_filter_datanames <- function(filters, datanames) { test_shiny_module_list <- function(data) { - is.list(data) && identical(names(data), c("ui", "server")) + is.list(data) && + identical(names(data), c("ui", "server")) && + identical(names(formals(data$ui)), "id") && + identical(names(formals(data$server)), "id") } check_shiny_module_list <- function(data) { if (!test_shiny_module_list(data)) { - "`data` should be a list with 'ui' and 'server' elements." + "`data` should be a list with 'ui' and 'server' functions having 'id' argument only." } else { TRUE } diff --git a/man/ddl.Rd b/man/ddl.Rd deleted file mode 100644 index fa14358f23..0000000000 --- a/man/ddl.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-ddl-utils.R -\name{ddl} -\alias{ddl} -\title{Convenience wrapper for ddl} -\usage{ -ddl(code, env_mask, ui, server) -} -\arguments{ -\item{code}{(\code{character} or \code{language})} - -\item{env_mask}{(\verb{named list})} - -\item{ui}{(\verb{function(id)}) function to create UI} - -\item{server}{(\verb{function(id)}) \code{shiny} server which returns \code{teal_data} object wrapped in} -} -\description{ -Convenience wrapper for ddl -} diff --git a/man/delayed_data.Rd b/man/delayed_data.Rd deleted file mode 100644 index 10957a9ec0..0000000000 --- a/man/delayed_data.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-transform_module.R -\name{delayed_data} -\alias{delayed_data} -\title{\code{delayed_data} for \code{teal_data}} -\usage{ -delayed_data(ui, server, ...) -} -\arguments{ -\item{ui}{(\verb{function(id)}) function to create UI} - -\item{server}{(\verb{function(id)}) \code{shiny} server which returns \code{teal_data} object wrapped in} - -\item{...}{(\code{any}) arguments passed to \code{server} function. -\code{reactive}. \code{server} should have \code{id} argument and exactly the same formals as specified in \code{...}.} -} -\description{ -Function creates object of class \code{delayed_data} which allows -\code{teal} app developer to transform \code{teal_data} object passed to \code{data} argument in -\code{\link[=init]{init()}}. This helps in case when app developer wants to use \code{teal} app -where \code{data} can be influenced by app user. For example, app developer can create -\code{teal} app which allows user to connect to database and then use data from this database. -} From 9b7de0f035f54b02bffcf4c384261a32c5c3c830 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 6 Nov 2023 18:36:02 +0100 Subject: [PATCH 23/51] add test for teal::init --- tests/testthat/test-init.R | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index bf95d2ade4..b00c8b8fd3 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -23,7 +23,7 @@ testthat::test_that("init data accepts teal_data object", { ) }) -testthat::test_that("init data throws an error with input other than TealData, teal_data and ddl", { +testthat::test_that("init data throws an error with input other than TealData, teal_data and list(ui, server)", { character_vector <- c("a", "b", "c") numeric_vector <- c(1, 2, 3) matrix_d <- as.matrix(c(1, 2, 3)) @@ -149,6 +149,23 @@ testthat::test_that("init data accepts a list with ui and server", { ) }) +testthat::test_that("init data doesn't accept ui and server with other formals than id", { + testthat::expect_error( + init( + data = list(ui = function(id, x) div(), server = function(id) NULL), + modules = modules(teal:::example_module()) + ), + " having 'id' argument only" + ) + testthat::expect_error( + init( + data = list(ui = function(id) div(), server = function(id, x) NULL), + modules = modules(teal:::example_module()) + ), + " having 'id' argument only" + ) +}) + testthat::test_that("init modules accepts a teal_modules object", { mods <- modules(example_module(), example_module()) testthat::expect_no_error(init(data = iris, modules = mods)) From 640c27bb8816d38081f1d2a5b6cd0adf1f406d6b Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 8 Nov 2023 09:45:25 +0100 Subject: [PATCH 24/51] - introduce `data_module` - remove eval_and_mask - fixing checks --- DESCRIPTION | 2 +- NAMESPACE | 2 +- R/data-ddl-utils.R | 63 ------------------- R/data_module.R | 40 ++++++++++++ R/init.R | 14 ++--- R/module_teal.R | 2 +- R/module_teal_with_splash.R | 15 ++--- R/utils.R | 17 ----- R/zzz.R | 3 - _pkgdown.yml | 2 + man/data_module.Rd | 42 +++++++++++++ man/dot-substitute_code.Rd | 18 ------ man/eval_and_mask.Rd | 23 ------- man/init.Rd | 2 +- tests/testthat/test-init.R | 14 ++--- tests/testthat/test-module_teal_with_splash.R | 10 +-- vignettes/data-as-shiny-module.Rmd | 61 ++++++++++++++++++ 17 files changed, 170 insertions(+), 160 deletions(-) delete mode 100644 R/data-ddl-utils.R create mode 100644 R/data_module.R create mode 100644 man/data_module.Rd delete mode 100644 man/dot-substitute_code.Rd delete mode 100644 man/eval_and_mask.Rd create mode 100644 vignettes/data-as-shiny-module.Rmd diff --git a/DESCRIPTION b/DESCRIPTION index 6821e04503..810c400b21 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -71,7 +71,7 @@ LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 Collate: - 'data-ddl-utils.R' + 'data_module.R' 'dummy_functions.R' 'get_rcode_utils.R' 'include_css_js.R' diff --git a/NAMESPACE b/NAMESPACE index 5ed5025741..b55fc15891 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,7 +18,7 @@ S3method(ui_nested_tabs,teal_modules) export("%>%") export(TealReportCard) export(as.teal_slices) -export(eval_and_mask) +export(data_module) export(example_module) export(get_code_tdata) export(get_metadata) diff --git a/R/data-ddl-utils.R b/R/data-ddl-utils.R deleted file mode 100644 index 09ba28640b..0000000000 --- a/R/data-ddl-utils.R +++ /dev/null @@ -1,63 +0,0 @@ -#' Function runs the `code`, masks the `code` and creates `teal_data` object. -#' @param data (`teal_data`) object -#' @param code (`language`) code to evaluate -#' @param env (`list`) containing inputs to be used in the `code` -#' @param env_mask (`list`) containing inputs to be masked in the `code` -#' -#' @return `teal_data` object -#' -#' @export -eval_and_mask <- function(data, - code, - env = list(), - env_mask = list()) { - checkmate::assert_class(data, "teal_data") - checkmate::assert_true(is.language(code)) - checkmate::assert_list(env) - checkmate::assert_list(env_mask) - - - # evaluate code and substitute input - data <- teal.code::eval_code(data, .substitute_code(expr = code, env = env)) - if (inherits(data, "qenv.error")) { - return(data) - } - - if (identical(ls(data@env), character(0))) { - warning( - "Evaluation of `ddl` code haven't created any objects.\n", - "Please make sure that the code is syntactically correct and creates necessary data." - ) - } - - if (!missing(env_mask)) { - # mask dynamic inputs with mask - env_masked <- utils::modifyList(env, env_mask) - - # replace last code entry with masked code - # format_expression needed to convert expression into character(1) - # question: warnings and errors are not masked, is it ok? - data@code[length(data@code)] <- format_expression(.substitute_code(expr = code, env = env_masked)) - } - - data -} - -#' Substitute symbols in the code -#' -#' Function replaces symbols in the provided code by values of the `args` argument. -#' -#' @inheritParams base::substitute -#' @keywords internal -.substitute_code <- function(expr, env) { - do.call( - substitute, - list( - expr = do.call( - substitute, - list(expr = expr) - ), - env = env - ) - ) -} diff --git a/R/data_module.R b/R/data_module.R new file mode 100644 index 0000000000..ea735d684f --- /dev/null +++ b/R/data_module.R @@ -0,0 +1,40 @@ +#' Data module +#' +#' Data input for `teal::init` in form of a module +#' +#' @param ui (`function(id)`)\cr +#' `shiny` `ui` module with `id` argument +#' @param server (`function(id)`)\cr +#' `shiny` server function with `id` as argument. Module should return reactive `teal_data`. +#' @examples +#' data <- data_module( +#' ui = function(id) { +#' ns <- NS(id) +#' actionButton(ns("submit"), label = "Load data") +#' }, +#' server = function(id) { +#' moduleServer(id, function(input, output, session) { +#' eventReactive(input$submit, { +#' data <- within( +#' teal.data::teal_data(), +#' { +#' dataset1 <- iris +#' dataset2 <- mtcars +#' } +#' ) +#' teal.data::datanames(data) <- c("iris", "mtcars") +#' +#' data +#' }) +#' }) +#' } +#' ) +#' @export +data_module <- function(ui, server) { + checkmate::assert_function(ui, args = "id", nargs = 1) + checkmate::assert_function(server, args = "id", nargs = 1) + structure( + list(ui = ui, server = server), + class = "data_module" + ) +} diff --git a/R/init.R b/R/init.R index 6504cc697e..2d61306dc7 100644 --- a/R/init.R +++ b/R/init.R @@ -106,7 +106,7 @@ #' shinyApp(app$ui, app$server) #' } #' -init <- function(data = teal_data(), +init <- function(data, modules, title = NULL, filter = teal_slices(), @@ -114,17 +114,11 @@ init <- function(data = teal_data(), footer = tags$p(), id = character(0)) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") - if ( - !inherits(data, c("TealData", "teal_data")) && - !(is.list(data) && identical(names(data), c("ui", "server"))) - ) { + if (!inherits(data, c("TealData", "teal_data", "data_module"))) { data <- teal.data::to_relational_data(data = data) } - checkmate::assert( - checkmate::check_multi_class(data, c("TealData", "teal_data")), - check_shiny_module_list(data) - ) + checkmate::assert_multi_class(data, c("TealData", "teal_data", "data_module")) checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules")) checkmate::assert_string(title, null.ok = TRUE) checkmate::assert( @@ -152,7 +146,7 @@ init <- function(data = teal_data(), hashables <- mget(c("data", "modules")) hashables$data <- if (inherits(hashables$data, "teal_data")) { as.list(hashables$data@env) - } else if (test_shiny_module_list(data)) { + } else if (inherits(data, "data_module")) { # what? } else if (hashables$data$is_pulled()) { sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) { diff --git a/R/module_teal.R b/R/module_teal.R index 0affb20dfd..0c7720a6f4 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -226,7 +226,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { datasets <- datasets_reactive() # main_ui_container contains splash screen first and we remove it and replace it by the real UI - removeUI(sprintf("#%s:first-child", session$ns("main_ui_container"))) + removeUI(sprintf("#%s > div:nth-child(1)", session$ns("main_ui_container"))) insertUI( selector = paste0("#", session$ns("main_ui_container")), where = "beforeEnd", diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 37326490b7..2222ece9f7 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -22,10 +22,7 @@ ui_teal_with_splash <- function(id, title, header = tags$p("Add Title Here"), footer = tags$p("Add Footer Here")) { - checkmate::assert( - checkmate::check_multi_class(data, c("TealData", "teal_data")), - check_shiny_module_list(data) - ) + checkmate::assert_multi_class(data, c("TealData", "teal_data", "data_module")) ns <- NS(id) # Startup splash screen for delayed loading @@ -33,7 +30,7 @@ ui_teal_with_splash <- function(id, # This has the benefit that when filtering the data takes a lot of time initially, the # Shiny app does not time out. - splash_ui <- if (test_shiny_module_list(data)) { + splash_ui <- if (inherits(data, "data_module")) { data$ui(ns("data")) } else if (inherits(data, "teal_data")) { div() @@ -62,10 +59,8 @@ ui_teal_with_splash <- function(id, #' If data is not loaded yet, `reactive` returns `NULL`. #' @export srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { - checkmate::assert( - checkmate::check_multi_class(data, c("TealData", "teal_data")), - check_shiny_module_list(data) - ) + checkmate::check_multi_class(data, c("TealData", "teal_data", "data_module")) + moduleServer(id, function(input, output, session) { logger::log_trace("srv_teal_with_splash initializing module with data.") @@ -75,7 +70,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { # raw_data contains teal_data object # either passed to teal::init or returned from ddl - raw_data <- if (test_shiny_module_list(data)) { + raw_data <- if (inherits(data, "data_module")) { ddl_out <- do.call( data$server, append( diff --git a/R/utils.R b/R/utils.R index 30a6e0ef1d..858317b27d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -188,20 +188,3 @@ check_filter_datanames <- function(filters, datanames) { TRUE } } - - -test_shiny_module_list <- function(data) { - is.list(data) && - identical(names(data), c("ui", "server")) && - identical(names(formals(data$ui)), "id") && - identical(names(formals(data$server)), "id") -} - - -check_shiny_module_list <- function(data) { - if (!test_shiny_module_list(data)) { - "`data` should be a list with 'ui' and 'server' functions having 'id' argument only." - } else { - TRUE - } -} diff --git a/R/zzz.R b/R/zzz.R index ce6fdb281c..fbc9c756d9 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -32,6 +32,3 @@ 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 - - -format_expression <- getFromNamespace("format_expression", "teal.code") diff --git a/_pkgdown.yml b/_pkgdown.yml index 01209c9ae4..7d3e183f82 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -62,6 +62,7 @@ articles: - including-general-data-in-teal - including-mae-data-in-teal - preprocessing-data + - data-as-shiny-module - title: Extending teal navbar: Extending teal contents: @@ -92,6 +93,7 @@ reference: - title: Core `teal` Functions desc: Main functions needed to build a `teal` app contents: + - data_module - init - module - modules diff --git a/man/data_module.Rd b/man/data_module.Rd new file mode 100644 index 0000000000..4ec746e83d --- /dev/null +++ b/man/data_module.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_module.R +\name{data_module} +\alias{data_module} +\title{Data module} +\usage{ +data_module(ui, server) +} +\arguments{ +\item{ui}{(\verb{function(id)})\cr +\code{shiny} \code{ui} module with \code{id} argument} + +\item{server}{(\verb{function(id)})\cr +\code{shiny} server function with \code{id} as argument. Module should return reactive \code{teal_data}.} +} +\description{ +Data input for \code{teal::init} in form of a module +} +\examples{ +data <- data_module( + ui = function(id) { + ns <- NS(id) + actionButton(ns("submit"), label = "Load data") + }, + server = function(id) { + moduleServer(id, function(input, output, session) { + eventReactive(input$submit, { + data <- within( + teal.data::teal_data(), + { + dataset1 <- iris + dataset2 <- mtcars + } + ) + teal.data::datanames(data) <- c("iris", "mtcars") + + data + }) + }) + } +) +} diff --git a/man/dot-substitute_code.Rd b/man/dot-substitute_code.Rd deleted file mode 100644 index d746a137a8..0000000000 --- a/man/dot-substitute_code.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-ddl-utils.R -\name{.substitute_code} -\alias{.substitute_code} -\title{Substitute symbols in the code} -\usage{ -.substitute_code(expr, env) -} -\arguments{ -\item{expr}{any syntactically valid \R expression} - -\item{env}{an environment or a list object. Defaults to the - current evaluation environment.} -} -\description{ -Function replaces symbols in the provided code by values of the \code{args} argument. -} -\keyword{internal} diff --git a/man/eval_and_mask.Rd b/man/eval_and_mask.Rd deleted file mode 100644 index 9e6840d362..0000000000 --- a/man/eval_and_mask.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-ddl-utils.R -\name{eval_and_mask} -\alias{eval_and_mask} -\title{Function runs the \code{code}, masks the \code{code} and creates \code{teal_data} object.} -\usage{ -eval_and_mask(data, code, env = list(), env_mask = list()) -} -\arguments{ -\item{data}{(\code{teal_data}) object} - -\item{code}{(\code{language}) code to evaluate} - -\item{env}{(\code{list}) containing inputs to be used in the \code{code}} - -\item{env_mask}{(\code{list}) containing inputs to be masked in the \code{code}} -} -\value{ -\code{teal_data} object -} -\description{ -Function runs the \code{code}, masks the \code{code} and creates \code{teal_data} object. -} diff --git a/man/init.Rd b/man/init.Rd index fef6b25b07..07bbec2deb 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -5,7 +5,7 @@ \title{Create the Server and UI Function For the Shiny App} \usage{ init( - data = teal_data(), + data, modules, title = NULL, filter = teal_slices(), diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index b00c8b8fd3..44c8242fc3 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -140,29 +140,29 @@ testthat::test_that("init data accepts a list of TealDatasetConnector object", { testthat::expect_no_error(init(data = dsc1, modules = modules(example_module()))) }) -testthat::test_that("init data accepts a list with ui and server", { +testthat::test_that("init data accepts data_module", { testthat::expect_no_error( init( - data = list(ui = function(id) div(), server = function(id) NULL), + data = data_module(ui = function(id) div(), server = function(id) NULL), modules = modules(teal:::example_module()) ) ) }) -testthat::test_that("init data doesn't accept ui and server with other formals than id", { +testthat::test_that("init data_module doesn't accept ui and server with other formals than id", { testthat::expect_error( init( - data = list(ui = function(id, x) div(), server = function(id) NULL), + data = data_module(ui = function(id, x) div(), server = function(id) NULL), modules = modules(teal:::example_module()) ), - " having 'id' argument only" + "Must have exactly 1 formal arguments" ) testthat::expect_error( init( - data = list(ui = function(id) div(), server = function(id, x) NULL), + data = data_module(ui = function(id) div(), server = function(id, x) NULL), modules = modules(teal:::example_module()) ), - " having 'id' argument only" + "Must have exactly 1 formal arguments" ) }) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 2bf0d33a4c..1fe373f2a6 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -1,10 +1,10 @@ -testthat::test_that("srv_teal_with_splash data accepts a list with ui and server", { +testthat::test_that("srv_teal_with_splash data accepts data_module", { testthat::expect_no_error( shiny::testServer( app = srv_teal_with_splash, args = list( id = "id", - data = list(ui = function(id) div(), server = function(id) NULL), + data = data_module(ui = function(id) div(), server = function(id) NULL), modules = modules(example_module()) ), expr = {} @@ -12,12 +12,12 @@ testthat::test_that("srv_teal_with_splash data accepts a list with ui and server ) }) -testthat::test_that("srv_teal_with_splash raw_data just evaluates the server when data is a module", { +testthat::test_that("srv_teal_with_splash raw_data evaluates the server when data is data_module", { shiny::testServer( app = srv_teal_with_splash, args = list( id = "test", - data = list(ui = function(id) div(), server = function(id) reactive("whatever")), + data = data_module(ui = function(id) div(), server = function(id) reactive("whatever")), modules = modules(example_module()) ), expr = { @@ -47,7 +47,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL when qen app = srv_teal_with_splash, args = list( id = "test", - data = list( + data = data_module( ui = function(id) div(), server = function(id) reactive(teal_data() |> within(stop("not good"))) ), diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd new file mode 100644 index 0000000000..89f817378b --- /dev/null +++ b/vignettes/data-as-shiny-module.Rmd @@ -0,0 +1,61 @@ +--- +title: "Data as shiny module" +author: "NEST CoreDev" +output: + rmarkdown::html_vignette: + toc: true +vignette: > + %\VignetteIndexEntry{Data as shiny module} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +## Introduction + +Every `teal` application needs `teal_data` object to work. Typically, app developer passes `teal_data` object created in +`.GlobalEnv` to the `data` argument. Such `teal_data` object should contain objects necessary to successfully call +the `modules`. In some cases, app developer can postpone some data operations by passing `shiny` module to the `data` +argument and `teal` will run a module each time when a new session starts. + +## Postponed data creation + +Some data is needed to be created each time when user opens an app. This could be a case when users need up to +date data which constantly changes. Then obviously, app developer can't load the data once in the `.GlobalEnv` but +`teal` needs to create them each time when new session starts. `data` argument should be specified then as a `list` +which: +- contains `ui` and `server` functions, +- `ui` and `server` should have `id` argument only and such +- `server` should call `moduleServer` returning reactive `teal_data` + +```{r} +ui <- function(id) { + ns <- NS(id) + actionButton(ns("submit"), label = "Load data") +} + +server <- function(id) { + moduleServer(id, function(input, output, session) { + eventReactive(input$submit, { + data <- within( + teal.data::teal_data(), + { + dataset1 <- iris + dataset2 <- mtcars + } + ) + teal.data::datanames(data) <- c("iris", "mtcars") + + data + }) + }) +} +``` + + +```{r} + +``` + +## Postponed data modification + +## Authorized data access From 82fb25aacd361db3f7b417aef1aa4c62a73dbc0c Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 8 Nov 2023 08:48:31 +0000 Subject: [PATCH 25/51] [skip actions] Restyle files --- vignettes/data-as-shiny-module.Rmd | 1 - 1 file changed, 1 deletion(-) diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd index 89f817378b..3f8136b7a5 100644 --- a/vignettes/data-as-shiny-module.Rmd +++ b/vignettes/data-as-shiny-module.Rmd @@ -53,7 +53,6 @@ server <- function(id) { ```{r} - ``` ## Postponed data modification From cfb27bcd90783cae615234f26b39879afc812579 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 8 Nov 2023 11:30:02 +0100 Subject: [PATCH 26/51] add vignette --- R/dummy_functions.R | 15 +- R/init.R | 4 +- man/example_module.Rd | 4 +- man/init.Rd | 4 +- man/srv_teal_with_splash.Rd | 4 +- man/ui_teal_with_splash.Rd | 4 +- vignettes/data-as-shiny-module.Rmd | 230 +++++++++++++++++++++++++---- 7 files changed, 224 insertions(+), 41 deletions(-) diff --git a/R/dummy_functions.R b/R/dummy_functions.R index 1fdaea0d8e..6d03ad65f1 100644 --- a/R/dummy_functions.R +++ b/R/dummy_functions.R @@ -75,6 +75,7 @@ example_datasets <- function() { # nolint #' #' @description `r lifecycle::badge("experimental")` #' @inheritParams module +#' @param src (`logical(1)`) whether to display reproducible R code in the module. #' @return A `teal` module which can be included in the `modules` argument to [teal::init()]. #' @examples #' app <- init( @@ -88,7 +89,7 @@ example_datasets <- function() { # nolint #' shinyApp(app$ui, app$server) #' } #' @export -example_module <- function(label = "example teal module", datanames = "all") { +example_module <- function(label = "example teal module", datanames = "all", src = TRUE) { checkmate::assert_string(label) module( label, @@ -96,13 +97,23 @@ example_module <- function(label = "example teal module", datanames = "all") { checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { output$text <- renderPrint(data[[input$dataname]]()) + teal.widgets::verbatim_popup_srv( + id = "rcode", + verbatim_content = attr(data, "code")(), + title = "Association Plot" + ) }) }, ui = function(id, data) { ns <- NS(id) teal.widgets::standard_layout( output = verbatimTextOutput(ns("text")), - encoding = selectInput(ns("dataname"), "Choose a dataset", choices = names(data)) + encoding = div( + selectInput(ns("dataname"), "Choose a dataset", choices = names(data)), + if (src) { + teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") + } + ) ) }, datanames = datanames diff --git a/R/init.R b/R/init.R index 2d61306dc7..83b0441d3d 100644 --- a/R/init.R +++ b/R/init.R @@ -15,10 +15,10 @@ #' an end-user, don't use this function, but instead this module. #' #' @param data (`TealData` or `TealDataset` or `TealDatasetConnector` or `list` or `data.frame` -#' or `MultiAssayExperiment`, `teal_data`)\cr +#' or `MultiAssayExperiment`, `teal_data`, `data_module`)\cr #' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()], #' [teal.data::cdisc_dataset()], [teal.data::dataset()], [teal.data::dataset_connector()] or -#' [teal.data::cdisc_dataset_connector()] or a single `data.frame` or a `MultiAssayExperiment` +#' [teal.data::cdisc_dataset_connector()] or [teal::data_module()] or a single `data.frame` or a `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 #' do not match the original object names. To ensure reproducibility please use [teal.data::teal_data()] diff --git a/man/example_module.Rd b/man/example_module.Rd index 9a0c88862b..c2a58c3dec 100644 --- a/man/example_module.Rd +++ b/man/example_module.Rd @@ -4,7 +4,7 @@ \alias{example_module} \title{An example \code{teal} module} \usage{ -example_module(label = "example teal module", datanames = "all") +example_module(label = "example teal module", datanames = "all", src = TRUE) } \arguments{ \item{label}{(\code{character(1)}) Label shown in the navigation item for the module. Any label possible except @@ -15,6 +15,8 @@ filter panel will automatically update the shown filters to include only filters in the listed datasets. \code{NULL} will hide the filter panel, and the keyword \code{'all'} will show filters of all datasets. \code{datanames} also determines a subset of datasets which are appended to the \code{data} argument in \code{server} function.} + +\item{src}{(\code{logical(1)}) whether to display reproducible R code in the module.} } \value{ A \code{teal} module which can be included in the \code{modules} argument to \code{\link[=init]{init()}}. diff --git a/man/init.Rd b/man/init.Rd index 07bbec2deb..3306650cc1 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -16,10 +16,10 @@ init( } \arguments{ \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} -or \code{MultiAssayExperiment}, \code{teal_data})\cr +or \code{MultiAssayExperiment}, \code{teal_data}, \code{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 a single \code{data.frame} or a \code{MultiAssayExperiment} +\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or \code{\link[=data_module]{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 do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} diff --git a/man/srv_teal_with_splash.Rd b/man/srv_teal_with_splash.Rd index 7ab0c6efea..0d4db5fd44 100644 --- a/man/srv_teal_with_splash.Rd +++ b/man/srv_teal_with_splash.Rd @@ -15,10 +15,10 @@ See the vignette for an example. However, \code{\link[=ui_teal_with_splash]{ui_t 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})\cr +or \code{MultiAssayExperiment}, \code{teal_data}, \code{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 a single \code{data.frame} or a \code{MultiAssayExperiment} +\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or \code{\link[=data_module]{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 do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} diff --git a/man/ui_teal_with_splash.Rd b/man/ui_teal_with_splash.Rd index 0ece4d3027..2e0e6a1961 100644 --- a/man/ui_teal_with_splash.Rd +++ b/man/ui_teal_with_splash.Rd @@ -17,10 +17,10 @@ ui_teal_with_splash( 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})\cr +or \code{MultiAssayExperiment}, \code{teal_data}, \code{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 a single \code{data.frame} or a \code{MultiAssayExperiment} +\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or \code{\link[=data_module]{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 do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd index 3f8136b7a5..a4ff1b5107 100644 --- a/vignettes/data-as-shiny-module.Rmd +++ b/vignettes/data-as-shiny-module.Rmd @@ -12,49 +12,219 @@ vignette: > ## Introduction -Every `teal` application needs `teal_data` object to work. Typically, app developer passes `teal_data` object created in -`.GlobalEnv` to the `data` argument. Such `teal_data` object should contain objects necessary to successfully call -the `modules`. In some cases, app developer can postpone some data operations by passing `shiny` module to the `data` -argument and `teal` will run a module each time when a new session starts. +For the proper functioning of any `teal` application, the presence of a `teal_data` object is essential. Usually, application developers provide the `teal_data` object created within the `.GlobalEnv` environment as an argument for the `data` parameter. This `teal_data` object should encompass the required elements necessary for successful execution of the application's modules. In certain scenarios, application developers may opt to defer specific data operations by assigning a shiny module to the data parameter, allowing `teal` to execute the module every time a new session starts. ## Postponed data creation -Some data is needed to be created each time when user opens an app. This could be a case when users need up to -date data which constantly changes. Then obviously, app developer can't load the data once in the `.GlobalEnv` but -`teal` needs to create them each time when new session starts. `data` argument should be specified then as a `list` -which: -- contains `ui` and `server` functions, -- `ui` and `server` should have `id` argument only and such -- `server` should call `moduleServer` returning reactive `teal_data` +In scenarios where certain data must be created anew each time a user opens the app, such as when the data is dynamic and frequently changing, loading the data once in the `.GlobalEnv` is not suitable. Instead, teal can generate the necessary objects each time a new session begins by specifying the `data_module` using the following components: + +- `ui` Function: This function should accept an `id` argument and define the user interface elements for the data module. + +- `server` Function: Similarly, the server function should accept an `id` argument and define the server logic for the data module. `moduleServer` should return a reactive `teal_data` object, which will be used by the application to ensure the availability of up-to-date data upon each session start. + +By following these requirements, teal can efficiently handle dynamic data updates and create the necessary objects for a seamless user experience. ```{r} -ui <- function(id) { - ns <- NS(id) - actionButton(ns("submit"), label = "Load data") +library(teal) +data_mod <- data_module( + ui = function(id) div(), + server = function(id) { + moduleServer(id, function(input, output, session) { + reactive({ + data <- within( + teal.data::teal_data(), + { + dataset1 <- iris + dataset2 <- mtcars + } + ) + teal.data::datanames(data) <- c("dataset1", "dataset2") + data + }) + }) + } +) + + +app <- init( + data = data_mod, + module = list(example_module()) +) + +if (interactive()) { + shinyApp(app$ui, app$server) } +``` + + +## Postponed data modification + +In certain scenarios, app developers may want to pre-create a `data` object before a `teal` session initializes, allowing app users to interact with this `data` from the session's start. This can be achieved by using the `data_module` function to efficiently modify the existing data object. + +The following code snippet illustrates how data_module can be utilized to subset the `dataset1` based on the selected `Species` from the `input$species` variable: + +```{r} +data <- within(teal_data(), { + dataset1 <- iris + dataset2 <- mtcars +}) +teal.data::datanames(data) <- c("dataset1", "dataset2") -server <- function(id) { - moduleServer(id, function(input, output, session) { - eventReactive(input$submit, { - data <- within( - teal.data::teal_data(), - { - dataset1 <- iris - dataset2 <- mtcars - } - ) - teal.data::datanames(data) <- c("iris", "mtcars") - - data +data_mod <- data_module( + ui = function(id) { + ns <- NS(id) + div( + selectInput(ns("species"), "Select species to filter", choices = unique(iris$Species), multiple = TRUE), + actionButton(ns("submit"), "Submit") + ) + }, + server = function(id) { + moduleServer(id, function(input, output, session) { + eventReactive(input$submit, { + data_modified <- within( + data, + dataset1 <- subset(dataset1, Species %in% selected), + selected = input$species + ) + data_modified + }) }) - }) + } +) + +app <- init( + data = data_mod, + module = list(example_module()) +) + +if (interactive()) { + shinyApp(app$ui, app$server) } ``` +It's important to note that this approach reduces app loading time as `data` creation in the `.GlobalEnv` only involves data transformation. However, it's crucial to ensure that the initial server function is defined in the same environment as the data object to enable this functionality. This requirement ensures that data exists in the same environment as the calling environment of the `server` function, allowing for efficient data modification and interaction. + +## Handling sensitive information + +In certain cases, app developers may need to load data from a source that requires user authorization. To maintain security and privacy, it's essential not to expose user credentials or sensitive information in the reproducible code of the `teal_data` object. A common solution to this issue is to apply a mechanism that masks sensitive data with relevant replacements. + +Let's imagine there is `login` function defined somewhere, which requires `username` and `password`. ```{r} +data <- within( + teal_data(), + login <- function(username, password) { + if (password == "pass") { + TRUE + } else { + stop("invalid credentials") + } + } +) ``` -## Postponed data modification +One can load the data by successfully calling `login` which allows to continue evaluation in `teal_data` object. +After running following code, `data_loaded` returns a code which exposes sensitive credentials (not nice!). + +```{r} +data_loaded <- within( + data, + { + con <- login(username = username, password = password) + dataset <- iris + }, + username = "that is me", + password = "pass" +) + +cat(paste(teal.code::get_code(data_loaded), collapse = "\n")) +``` + +Developer aware of this flaw, should replace sensitive information. Instead of having `"pass"` in the code, one should replace it with `readlines("enter your password: ")` so returned code will be re-executable in the interactive session. + +```r +data_masked <- replace_code( + data_loaded, + substitute( + { + con <- login(username = username, password = password) + dataset <- iris + }, + list( + username = quote(readline("Type your username: ")), + password = quote(readline("Type your password: ")) + ) + ) +) + +cat(paste(teal.code::get_code(data_masked), collapse = "\n")) +``` + +The same code is included below in the logic of the `data_module` and passed to `teal` application. + +```{r} +data_mod <- data_module( + ui = function(id) { + ns <- NS(id) + tagList( + textInput(ns("username"), label = "Username"), + passwordInput(ns("password"), label = "Password"), + actionButton(ns("submit"), label = "Submit") + ) + }, + server = function(id) { + moduleServer(id, function(input, output, session) { + eventReactive(input$submit, { + data <- within( + teal_data(), + { + login <- function(username, password) { + if (password == "pass") { + TRUE + } else { + stop("invalid credentials") + } + } + } + ) + + data_loaded <- within( + data, + { + con <- login(username = username, password = password) + dataset <- iris + }, + username = input$username, + password = input$password + ) + teal.data::datanames(data_loaded) <- "dataset" + + data_masked <- replace_code( + data_loaded, + substitute( + { + con <- login(username = username, password = password) + dataset <- iris + }, + list( + username = quote(readline("Type your username: ")), + password = quote(readline("Type your password: ")) + ) + ) + ) + }) + }) + } +) + +app <- init( + data = data_mod, + module = list(example_module()) +) + +if (interactive()) { + shinyApp(app$ui, app$server) +} +``` -## Authorized data access +Please note that `replace_code` is a potential violation of reproducibility, and should be handled with care. \ No newline at end of file From 147c02f518d3424843cfc7a3dd61ba18bb1a19fa Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 8 Nov 2023 10:33:10 +0000 Subject: [PATCH 27/51] [skip actions] Restyle files --- vignettes/data-as-shiny-module.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd index a4ff1b5107..1ef236d666 100644 --- a/vignettes/data-as-shiny-module.Rmd +++ b/vignettes/data-as-shiny-module.Rmd @@ -227,4 +227,4 @@ if (interactive()) { } ``` -Please note that `replace_code` is a potential violation of reproducibility, and should be handled with care. \ No newline at end of file +Please note that `replace_code` is a potential violation of reproducibility, and should be handled with care. From cd292ea08eef68149cc41e4fb2d4f00607a77ddc Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 8 Nov 2023 11:40:02 +0100 Subject: [PATCH 28/51] empty From e80c8cef021f59c06cb2ec632f3ada3d108077ed Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 8 Nov 2023 13:02:31 +0100 Subject: [PATCH 29/51] data_module -> teal_data_module --- DESCRIPTION | 2 +- NAMESPACE | 2 +- R/init.R | 10 +++++----- R/module_teal_with_splash.R | 8 ++++---- R/{data_module.R => teal_data_module.R} | 6 +++--- _pkgdown.yml | 2 +- man/init.Rd | 4 ++-- man/srv_teal_with_splash.Rd | 4 ++-- man/{data_module.Rd => teal_data_module.Rd} | 10 +++++----- man/ui_teal_with_splash.Rd | 4 ++-- tests/testthat/test-init.R | 10 +++++----- tests/testthat/test-module_teal_with_splash.R | 10 +++++----- vignettes/data-as-shiny-module.Rmd | 14 +++++++------- 13 files changed, 43 insertions(+), 43 deletions(-) rename R/{data_module.R => teal_data_module.R} (90%) rename man/{data_module.Rd => teal_data_module.Rd} (84%) diff --git a/DESCRIPTION b/DESCRIPTION index 810c400b21..3d099a4a43 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -71,7 +71,6 @@ LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 Collate: - 'data_module.R' 'dummy_functions.R' 'get_rcode_utils.R' 'include_css_js.R' @@ -89,6 +88,7 @@ Collate: 'show_rcode_modal.R' 'tdata.R' 'teal.R' + 'teal_data_module.R' 'teal_reporter.R' 'teal_slices-store.R' 'teal_slices.R' diff --git a/NAMESPACE b/NAMESPACE index b55fc15891..e8f450b895 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,7 +18,6 @@ S3method(ui_nested_tabs,teal_modules) export("%>%") export(TealReportCard) export(as.teal_slices) -export(data_module) export(example_module) export(get_code_tdata) export(get_metadata) @@ -32,6 +31,7 @@ export(reporter_previewer_module) export(show_rcode_modal) export(srv_teal_with_splash) export(tdata2env) +export(teal_data_module) export(teal_slices) export(ui_teal_with_splash) export(validate_has_data) diff --git a/R/init.R b/R/init.R index 83b0441d3d..5601ffe3e6 100644 --- a/R/init.R +++ b/R/init.R @@ -15,10 +15,10 @@ #' an end-user, don't use this function, but instead this module. #' #' @param data (`TealData` or `TealDataset` or `TealDatasetConnector` or `list` or `data.frame` -#' or `MultiAssayExperiment`, `teal_data`, `data_module`)\cr +#' or `MultiAssayExperiment`, `teal_data`, `teal_data_module`)\cr #' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()], #' [teal.data::cdisc_dataset()], [teal.data::dataset()], [teal.data::dataset_connector()] or -#' [teal.data::cdisc_dataset_connector()] or [teal::data_module()] or a single `data.frame` or a `MultiAssayExperiment` +#' [teal.data::cdisc_dataset_connector()] or [teal::teal_data_module()] or a single `data.frame` or a `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 #' do not match the original object names. To ensure reproducibility please use [teal.data::teal_data()] @@ -114,11 +114,11 @@ init <- function(data, footer = tags$p(), id = character(0)) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") - if (!inherits(data, c("TealData", "teal_data", "data_module"))) { + if (!inherits(data, c("TealData", "teal_data", "teal_data_module"))) { data <- teal.data::to_relational_data(data = data) } - checkmate::assert_multi_class(data, c("TealData", "teal_data", "data_module")) + checkmate::assert_multi_class(data, c("TealData", "teal_data", "teal_data_module")) checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules")) checkmate::assert_string(title, null.ok = TRUE) checkmate::assert( @@ -146,7 +146,7 @@ init <- function(data, hashables <- mget(c("data", "modules")) hashables$data <- if (inherits(hashables$data, "teal_data")) { as.list(hashables$data@env) - } else if (inherits(data, "data_module")) { + } else if (inherits(data, "teal_data_module")) { # what? } else if (hashables$data$is_pulled()) { sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) { diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 2222ece9f7..0bfef61bfa 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -22,7 +22,7 @@ ui_teal_with_splash <- function(id, title, header = tags$p("Add Title Here"), footer = tags$p("Add Footer Here")) { - checkmate::assert_multi_class(data, c("TealData", "teal_data", "data_module")) + checkmate::assert_multi_class(data, c("TealData", "teal_data", "teal_data_module")) ns <- NS(id) # Startup splash screen for delayed loading @@ -30,7 +30,7 @@ ui_teal_with_splash <- function(id, # This has the benefit that when filtering the data takes a lot of time initially, the # Shiny app does not time out. - splash_ui <- if (inherits(data, "data_module")) { + splash_ui <- if (inherits(data, "teal_data_module")) { data$ui(ns("data")) } else if (inherits(data, "teal_data")) { div() @@ -59,7 +59,7 @@ ui_teal_with_splash <- function(id, #' If data is not loaded yet, `reactive` returns `NULL`. #' @export srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { - checkmate::check_multi_class(data, c("TealData", "teal_data", "data_module")) + checkmate::check_multi_class(data, c("TealData", "teal_data", "teal_data_module")) moduleServer(id, function(input, output, session) { logger::log_trace("srv_teal_with_splash initializing module with data.") @@ -70,7 +70,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { # raw_data contains teal_data object # either passed to teal::init or returned from ddl - raw_data <- if (inherits(data, "data_module")) { + raw_data <- if (inherits(data, "teal_data_module")) { ddl_out <- do.call( data$server, append( diff --git a/R/data_module.R b/R/teal_data_module.R similarity index 90% rename from R/data_module.R rename to R/teal_data_module.R index ea735d684f..1cffa0282a 100644 --- a/R/data_module.R +++ b/R/teal_data_module.R @@ -7,7 +7,7 @@ #' @param server (`function(id)`)\cr #' `shiny` server function with `id` as argument. Module should return reactive `teal_data`. #' @examples -#' data <- data_module( +#' data <- teal_data_module( #' ui = function(id) { #' ns <- NS(id) #' actionButton(ns("submit"), label = "Load data") @@ -30,11 +30,11 @@ #' } #' ) #' @export -data_module <- function(ui, server) { +teal_data_module <- function(ui, server) { checkmate::assert_function(ui, args = "id", nargs = 1) checkmate::assert_function(server, args = "id", nargs = 1) structure( list(ui = ui, server = server), - class = "data_module" + class = "teal_data_module" ) } diff --git a/_pkgdown.yml b/_pkgdown.yml index 7d3e183f82..46955166dc 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -93,7 +93,7 @@ reference: - title: Core `teal` Functions desc: Main functions needed to build a `teal` app contents: - - data_module + - teal_data_module - init - module - modules diff --git a/man/init.Rd b/man/init.Rd index 3306650cc1..87f62f05fe 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -16,10 +16,10 @@ init( } \arguments{ \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} -or \code{MultiAssayExperiment}, \code{teal_data}, \code{data_module})\cr +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[=data_module]{data_module()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} +\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 do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} diff --git a/man/srv_teal_with_splash.Rd b/man/srv_teal_with_splash.Rd index 0d4db5fd44..399dc6d64e 100644 --- a/man/srv_teal_with_splash.Rd +++ b/man/srv_teal_with_splash.Rd @@ -15,10 +15,10 @@ See the vignette for an example. However, \code{\link[=ui_teal_with_splash]{ui_t 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{data_module})\cr +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[=data_module]{data_module()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} +\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 do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} diff --git a/man/data_module.Rd b/man/teal_data_module.Rd similarity index 84% rename from man/data_module.Rd rename to man/teal_data_module.Rd index 4ec746e83d..bc1650ff9b 100644 --- a/man/data_module.Rd +++ b/man/teal_data_module.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data_module.R -\name{data_module} -\alias{data_module} +% Please edit documentation in R/teal_data_module.R +\name{teal_data_module} +\alias{teal_data_module} \title{Data module} \usage{ -data_module(ui, server) +teal_data_module(ui, server) } \arguments{ \item{ui}{(\verb{function(id)})\cr @@ -17,7 +17,7 @@ data_module(ui, server) Data input for \code{teal::init} in form of a module } \examples{ -data <- data_module( +data <- teal_data_module( ui = function(id) { ns <- NS(id) actionButton(ns("submit"), label = "Load data") diff --git a/man/ui_teal_with_splash.Rd b/man/ui_teal_with_splash.Rd index 2e0e6a1961..85ab99abcd 100644 --- a/man/ui_teal_with_splash.Rd +++ b/man/ui_teal_with_splash.Rd @@ -17,10 +17,10 @@ ui_teal_with_splash( 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{data_module})\cr +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[=data_module]{data_module()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} +\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 do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 44c8242fc3..85576e7e95 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -140,26 +140,26 @@ testthat::test_that("init data accepts a list of TealDatasetConnector object", { testthat::expect_no_error(init(data = dsc1, modules = modules(example_module()))) }) -testthat::test_that("init data accepts data_module", { +testthat::test_that("init data accepts teal_data_module", { testthat::expect_no_error( init( - data = data_module(ui = function(id) div(), server = function(id) NULL), + data = teal_data_module(ui = function(id) div(), server = function(id) NULL), modules = modules(teal:::example_module()) ) ) }) -testthat::test_that("init data_module doesn't accept ui and server with other formals than id", { +testthat::test_that("init teal_data_module doesn't accept ui and server with other formals than id", { testthat::expect_error( init( - data = data_module(ui = function(id, x) div(), server = function(id) NULL), + data = teal_data_module(ui = function(id, x) div(), server = function(id) NULL), modules = modules(teal:::example_module()) ), "Must have exactly 1 formal arguments" ) testthat::expect_error( init( - data = data_module(ui = function(id) div(), server = function(id, x) NULL), + data = teal_data_module(ui = function(id) div(), server = function(id, x) NULL), modules = modules(teal:::example_module()) ), "Must have exactly 1 formal arguments" diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 1fe373f2a6..736c416932 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -1,10 +1,10 @@ -testthat::test_that("srv_teal_with_splash data accepts data_module", { +testthat::test_that("srv_teal_with_splash data accepts teal_data_module", { testthat::expect_no_error( shiny::testServer( app = srv_teal_with_splash, args = list( id = "id", - data = data_module(ui = function(id) div(), server = function(id) NULL), + data = teal_data_module(ui = function(id) div(), server = function(id) NULL), modules = modules(example_module()) ), expr = {} @@ -12,12 +12,12 @@ testthat::test_that("srv_teal_with_splash data accepts data_module", { ) }) -testthat::test_that("srv_teal_with_splash raw_data evaluates the server when data is data_module", { +testthat::test_that("srv_teal_with_splash raw_data evaluates the server when data is teal_data_module", { shiny::testServer( app = srv_teal_with_splash, args = list( id = "test", - data = data_module(ui = function(id) div(), server = function(id) reactive("whatever")), + data = teal_data_module(ui = function(id) div(), server = function(id) reactive("whatever")), modules = modules(example_module()) ), expr = { @@ -47,7 +47,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL when qen app = srv_teal_with_splash, args = list( id = "test", - data = data_module( + data = teal_data_module( ui = function(id) div(), server = function(id) reactive(teal_data() |> within(stop("not good"))) ), diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd index 1ef236d666..7c9007a58c 100644 --- a/vignettes/data-as-shiny-module.Rmd +++ b/vignettes/data-as-shiny-module.Rmd @@ -16,7 +16,7 @@ For the proper functioning of any `teal` application, the presence of a `teal_da ## Postponed data creation -In scenarios where certain data must be created anew each time a user opens the app, such as when the data is dynamic and frequently changing, loading the data once in the `.GlobalEnv` is not suitable. Instead, teal can generate the necessary objects each time a new session begins by specifying the `data_module` using the following components: +In scenarios where certain data must be created anew each time a user opens the app, such as when the data is dynamic and frequently changing, loading the data once in the `.GlobalEnv` is not suitable. Instead, teal can generate the necessary objects each time a new session begins by specifying the `teal_data_module` using the following components: - `ui` Function: This function should accept an `id` argument and define the user interface elements for the data module. @@ -26,7 +26,7 @@ By following these requirements, teal can efficiently handle dynamic data update ```{r} library(teal) -data_mod <- data_module( +data_mod <- teal_data_module( ui = function(id) div(), server = function(id) { moduleServer(id, function(input, output, session) { @@ -59,9 +59,9 @@ if (interactive()) { ## Postponed data modification -In certain scenarios, app developers may want to pre-create a `data` object before a `teal` session initializes, allowing app users to interact with this `data` from the session's start. This can be achieved by using the `data_module` function to efficiently modify the existing data object. +In certain scenarios, app developers may want to pre-create a `data` object before a `teal` session initializes, allowing app users to interact with this `data` from the session's start. This can be achieved by using the `teal_data_module` function to efficiently modify the existing data object. -The following code snippet illustrates how data_module can be utilized to subset the `dataset1` based on the selected `Species` from the `input$species` variable: +The following code snippet illustrates how teal_data_module can be utilized to subset the `dataset1` based on the selected `Species` from the `input$species` variable: ```{r} data <- within(teal_data(), { @@ -70,7 +70,7 @@ data <- within(teal_data(), { }) teal.data::datanames(data) <- c("dataset1", "dataset2") -data_mod <- data_module( +data_mod <- teal_data_module( ui = function(id) { ns <- NS(id) div( @@ -160,10 +160,10 @@ data_masked <- replace_code( cat(paste(teal.code::get_code(data_masked), collapse = "\n")) ``` -The same code is included below in the logic of the `data_module` and passed to `teal` application. +The same code is included below in the logic of the `teal_data_module` and passed to `teal` application. ```{r} -data_mod <- data_module( +data_mod <- teal_data_module( ui = function(id) { ns <- NS(id) tagList( From 724dcdb4d7f975882a64a8ea7843083941544e22 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 8 Nov 2023 15:18:03 +0100 Subject: [PATCH 30/51] WIP tests --- R/init.R | 16 +++ tests/testthat/test-init.R | 3 + tests/testthat/test-module_teal_with_splash.R | 12 +- vignettes/data-as-shiny-module.Rmd | 125 ------------------ 4 files changed, 24 insertions(+), 132 deletions(-) diff --git a/R/init.R b/R/init.R index 5601ffe3e6..706162c346 100644 --- a/R/init.R +++ b/R/init.R @@ -187,6 +187,22 @@ init <- function(data, } } + if (inherits(data, "teal_data")) { + # in case of teal_data_module this check is postponed to the srv_teal_with_splash + is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) + if (!isTRUE(is_modules_ok)) { + logger::log_error(is_modules_ok) + stop(is_modules_ok) + } + + is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) + if (!isTRUE(is_filter_ok)) { + logger::log_warn(is_filter_ok) + # we allow app to continue if applied filters are outside + # of possible data range + } + } + # Note regarding case `id = character(0)`: # rather than using `callModule` and creating a submodule of this module, we directly modify # the `ui` and `server` with `id = character(0)` and calling the server function directly diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 85576e7e95..9cdda6574b 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -191,3 +191,6 @@ testthat::test_that("init filter accepts `teal_slices`", { "Assertion failed" ) }) + +# todo: when modules datanames not matching datanames(data) +# todo: when filters datanames not matching datanames(data) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 736c416932..18751c2b69 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -1,4 +1,4 @@ -testthat::test_that("srv_teal_with_splash data accepts teal_data_module", { +testthat::test_that("srv_teal_with_splash data accepts a teal_data_module", { testthat::expect_no_error( shiny::testServer( app = srv_teal_with_splash, @@ -12,7 +12,7 @@ testthat::test_that("srv_teal_with_splash data accepts teal_data_module", { ) }) -testthat::test_that("srv_teal_with_splash raw_data evaluates the server when data is teal_data_module", { +testthat::test_that("srv_teal_with_splash raw_data evaluates the server of teal_data_module", { shiny::testServer( app = srv_teal_with_splash, args = list( @@ -65,9 +65,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL when qen testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns NULL before loading", { x <- dataset_connector(dataname = "test_dataset", pull_callable = callable_code("iris")) - lifecycle::expect_deprecated( - delayed_data <- teal_data(x) - ) + delayed_data <- teal_data(x) shiny::testServer( app = srv_teal_with_splash, args = list( @@ -82,7 +80,7 @@ testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns pulled data when loaded", { teal.logger::suppress_logs() x <- dataset_connector(dataname = "iris", pull_callable = callable_code("iris")) - lifecycle::expect_deprecated(delayed_data <- teal_data(x)) + delayed_data <- teal_data(x) shiny::testServer( app = srv_teal_with_splash, args = list( @@ -111,7 +109,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL if incom testthat::expect_is(raw_data_checked, "reactive") testthat::expect_output( testthat::expect_null(raw_data_checked()), - '"iris" not in "mtcars"' + "“iris” not in “mtcars”" ) } ) diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd index 7c9007a58c..7b3da971b9 100644 --- a/vignettes/data-as-shiny-module.Rmd +++ b/vignettes/data-as-shiny-module.Rmd @@ -103,128 +103,3 @@ if (interactive()) { ``` It's important to note that this approach reduces app loading time as `data` creation in the `.GlobalEnv` only involves data transformation. However, it's crucial to ensure that the initial server function is defined in the same environment as the data object to enable this functionality. This requirement ensures that data exists in the same environment as the calling environment of the `server` function, allowing for efficient data modification and interaction. - -## Handling sensitive information - -In certain cases, app developers may need to load data from a source that requires user authorization. To maintain security and privacy, it's essential not to expose user credentials or sensitive information in the reproducible code of the `teal_data` object. A common solution to this issue is to apply a mechanism that masks sensitive data with relevant replacements. - -Let's imagine there is `login` function defined somewhere, which requires `username` and `password`. - -```{r} -data <- within( - teal_data(), - login <- function(username, password) { - if (password == "pass") { - TRUE - } else { - stop("invalid credentials") - } - } -) -``` - -One can load the data by successfully calling `login` which allows to continue evaluation in `teal_data` object. -After running following code, `data_loaded` returns a code which exposes sensitive credentials (not nice!). - -```{r} -data_loaded <- within( - data, - { - con <- login(username = username, password = password) - dataset <- iris - }, - username = "that is me", - password = "pass" -) - -cat(paste(teal.code::get_code(data_loaded), collapse = "\n")) -``` - -Developer aware of this flaw, should replace sensitive information. Instead of having `"pass"` in the code, one should replace it with `readlines("enter your password: ")` so returned code will be re-executable in the interactive session. - -```r -data_masked <- replace_code( - data_loaded, - substitute( - { - con <- login(username = username, password = password) - dataset <- iris - }, - list( - username = quote(readline("Type your username: ")), - password = quote(readline("Type your password: ")) - ) - ) -) - -cat(paste(teal.code::get_code(data_masked), collapse = "\n")) -``` - -The same code is included below in the logic of the `teal_data_module` and passed to `teal` application. - -```{r} -data_mod <- teal_data_module( - ui = function(id) { - ns <- NS(id) - tagList( - textInput(ns("username"), label = "Username"), - passwordInput(ns("password"), label = "Password"), - actionButton(ns("submit"), label = "Submit") - ) - }, - server = function(id) { - moduleServer(id, function(input, output, session) { - eventReactive(input$submit, { - data <- within( - teal_data(), - { - login <- function(username, password) { - if (password == "pass") { - TRUE - } else { - stop("invalid credentials") - } - } - } - ) - - data_loaded <- within( - data, - { - con <- login(username = username, password = password) - dataset <- iris - }, - username = input$username, - password = input$password - ) - teal.data::datanames(data_loaded) <- "dataset" - - data_masked <- replace_code( - data_loaded, - substitute( - { - con <- login(username = username, password = password) - dataset <- iris - }, - list( - username = quote(readline("Type your username: ")), - password = quote(readline("Type your password: ")) - ) - ) - ) - }) - }) - } -) - -app <- init( - data = data_mod, - module = list(example_module()) -) - -if (interactive()) { - shinyApp(app$ui, app$server) -} -``` - -Please note that `replace_code` is a potential violation of reproducibility, and should be handled with care. From a98682d2cf25350ad63ea5352fb57c8ae5342b05 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 9 Nov 2023 07:04:01 +0100 Subject: [PATCH 31/51] - add asserts on datanames in teal::init - more tests - address @chlebowa comments --- R/init.R | 3 ++- R/module_teal_with_splash.R | 7 +++---- R/teal_data_module.R | 3 +++ R/utils.R | 10 +++++----- man/teal_data_module.Rd | 3 +++ tests/testthat/test-init.R | 19 +++++++++++++++++-- tests/testthat/test-module_teal_with_splash.R | 2 +- 7 files changed, 34 insertions(+), 13 deletions(-) diff --git a/R/init.R b/R/init.R index 706162c346..27b6e360f2 100644 --- a/R/init.R +++ b/R/init.R @@ -147,7 +147,7 @@ init <- function(data, hashables$data <- if (inherits(hashables$data, "teal_data")) { as.list(hashables$data@env) } else if (inherits(data, "teal_data_module")) { - # what? + body(data$server) } else if (hashables$data$is_pulled()) { sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) { hashables$data$get_dataset(dn)$get_raw_data() @@ -198,6 +198,7 @@ init <- function(data, is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) if (!isTRUE(is_filter_ok)) { logger::log_warn(is_filter_ok) + warning(is_filter_ok) # we allow app to continue if applied filters are outside # of possible data range } diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 0bfef61bfa..4fd5e581e4 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -31,7 +31,7 @@ ui_teal_with_splash <- function(id, # Shiny app does not time out. splash_ui <- if (inherits(data, "teal_data_module")) { - data$ui(ns("data")) + data$ui(ns("teal_data_module")) } else if (inherits(data, "teal_data")) { div() } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) { @@ -71,10 +71,10 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { # raw_data contains teal_data object # either passed to teal::init or returned from ddl raw_data <- if (inherits(data, "teal_data_module")) { - ddl_out <- do.call( + do.call( data$server, append( - list(id = "data"), + list(id = "teal_data_module"), attr(data, "server_args") # might be NULL or list() - both are fine ), quote = TRUE @@ -130,7 +130,6 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { return(NULL) } - is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) diff --git a/R/teal_data_module.R b/R/teal_data_module.R index 1cffa0282a..e1e0400803 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -6,6 +6,9 @@ #' `shiny` `ui` module with `id` argument #' @param server (`function(id)`)\cr #' `shiny` server function with `id` as argument. Module should return reactive `teal_data`. +#' +#' @return object of class `teal_data_module` +#' #' @examples #' data <- teal_data_module( #' ui = function(id) { diff --git a/R/utils.R b/R/utils.R index 858317b27d..81a6c40fbe 100644 --- a/R/utils.R +++ b/R/utils.R @@ -150,7 +150,7 @@ check_modules_datanames <- function(modules, datanames) { extra_datanames <- setdiff(modules$datanames, c("all", datanames)) if (length(extra_datanames)) { sprintf( - "- Module %s has a different dataname than available in a 'data': %s not in %s", + "- Module '%s' has a different dataname than available in a 'data': %s not in %s", modules$label, toString(dQuote(extra_datanames, q = FALSE)), toString(dQuote(datanames, q = FALSE)) @@ -174,10 +174,10 @@ check_filter_datanames <- function(filters, datanames) { dataname <- shiny::isolate(filter$dataname) if (!dataname %in% datanames) { sprintf( - "- Filter %s has a different dataname than available in a 'data':\n %s not in %s", - filter$label, - dQuote(dataname), - toString(dQuote(datanames)) + "- Filter '%s' has a different dataname than available in a 'data':\n %s not in %s", + shiny::isolate(filter$id), + dQuote(dataname, q = FALSE), + toString(dQuote(datanames, q = FALSE)) ) } } diff --git a/man/teal_data_module.Rd b/man/teal_data_module.Rd index bc1650ff9b..d976065943 100644 --- a/man/teal_data_module.Rd +++ b/man/teal_data_module.Rd @@ -13,6 +13,9 @@ teal_data_module(ui, server) \item{server}{(\verb{function(id)})\cr \code{shiny} server function with \code{id} as argument. Module should return reactive \code{teal_data}.} } +\value{ +object of class \code{teal_data_module} +} \description{ Data input for \code{teal::init} in form of a module } diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 9cdda6574b..daec873c16 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -192,5 +192,20 @@ testthat::test_that("init filter accepts `teal_slices`", { ) }) -# todo: when modules datanames not matching datanames(data) -# todo: when filters datanames not matching datanames(data) +testthat::test_that("init throws when incompatible module's datanames", { + testthat::expect_error( + init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))), + '"iris" not in "mtcars"' + ) +}) + +testthat::test_that("init throws when incompatible filter's datanames", { + testthat::expect_warning( + init( + data = teal_data(mtcars = mtcars), + modules = modules(example_module()), + filter = teal_slices(teal_slice(dataname = "iris", varname = "Species")) + ), + '"iris" not in "mtcars"' + ) +}) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 18751c2b69..4dbafd18b1 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -109,7 +109,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL if incom testthat::expect_is(raw_data_checked, "reactive") testthat::expect_output( testthat::expect_null(raw_data_checked()), - "“iris” not in “mtcars”" + '"iris" not in "mtcars"' ) } ) From 507fbc3a9cae9380836af4a248988213d938f1a0 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 9 Nov 2023 08:35:07 +0100 Subject: [PATCH 32/51] lint --- R/init.R | 6 ++++-- man/init.Rd | 3 ++- man/srv_teal_with_splash.Rd | 3 ++- man/ui_teal_with_splash.Rd | 3 ++- 4 files changed, 10 insertions(+), 5 deletions(-) diff --git a/R/init.R b/R/init.R index 27b6e360f2..4d04adcdc9 100644 --- a/R/init.R +++ b/R/init.R @@ -18,7 +18,8 @@ #' or `MultiAssayExperiment`, `teal_data`, `teal_data_module`)\cr #' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()], #' [teal.data::cdisc_dataset()], [teal.data::dataset()], [teal.data::dataset_connector()] or -#' [teal.data::cdisc_dataset_connector()] or [teal::teal_data_module()] or a single `data.frame` or a `MultiAssayExperiment` +#' [teal.data::cdisc_dataset_connector()] or [teal::teal_data_module()] or a single `data.frame` or +#' a `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 #' do not match the original object names. To ensure reproducibility please use [teal.data::teal_data()] @@ -142,7 +143,8 @@ init <- function(data, if (length(landing) > 1L) stop("Only one `landing_popup_module` can be used.") modules <- drop_module(modules, "teal_module_landing") - # Calculate app hash to ensure snapshot compatibility. See ?snapshot. Raw data must be extracted from environments. + # Calculate app hash to ensure snapshot compatibility. + # See ?snapshot. Raw data must be extracted from environments. hashables <- mget(c("data", "modules")) hashables$data <- if (inherits(hashables$data, "teal_data")) { as.list(hashables$data@env) diff --git a/man/init.Rd b/man/init.Rd index 87f62f05fe..f03437f1b3 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -19,7 +19,8 @@ init( 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 a \code{MultiAssayExperiment} +\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 do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} diff --git a/man/srv_teal_with_splash.Rd b/man/srv_teal_with_splash.Rd index 399dc6d64e..9b1d4312d1 100644 --- a/man/srv_teal_with_splash.Rd +++ b/man/srv_teal_with_splash.Rd @@ -18,7 +18,8 @@ is then preferred to this function.} 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 a \code{MultiAssayExperiment} +\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 do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} diff --git a/man/ui_teal_with_splash.Rd b/man/ui_teal_with_splash.Rd index 85ab99abcd..29396ed74c 100644 --- a/man/ui_teal_with_splash.Rd +++ b/man/ui_teal_with_splash.Rd @@ -20,7 +20,8 @@ module id} 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 a \code{MultiAssayExperiment} +\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 do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} From 0f7accd87e42a3bd6c4e0c041f8448806ac67029 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 9 Nov 2023 13:59:37 +0100 Subject: [PATCH 33/51] edit vignette --- vignettes/data-as-shiny-module.Rmd | 49 +++++++++++++++++++++--------- 1 file changed, 35 insertions(+), 14 deletions(-) diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd index 7b3da971b9..5fb7ce9d30 100644 --- a/vignettes/data-as-shiny-module.Rmd +++ b/vignettes/data-as-shiny-module.Rmd @@ -1,31 +1,42 @@ --- -title: "Data as shiny module" +title: "Data as shiny Module" author: "NEST CoreDev" output: rmarkdown::html_vignette: toc: true vignette: > - %\VignetteIndexEntry{Data as shiny module} + %\VignetteIndexEntry{Data as shiny Module} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ## Introduction -For the proper functioning of any `teal` application, the presence of a `teal_data` object is essential. Usually, application developers provide the `teal_data` object created within the `.GlobalEnv` environment as an argument for the `data` parameter. This `teal_data` object should encompass the required elements necessary for successful execution of the application's modules. In certain scenarios, application developers may opt to defer specific data operations by assigning a shiny module to the data parameter, allowing `teal` to execute the module every time a new session starts. +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: -## Postponed data creation +- a `ui` function; accepts only one argument, `id`; defines user interface elements for the data module +- a `server` function: accepts only one argument, `id`; defines server logic for the data module, including data creation; must return a reactive expression containing a `teal_data` object -In scenarios where certain data must be created anew each time a user opens the app, such as when the data is dynamic and frequently changing, loading the data once in the `.GlobalEnv` is not suitable. Instead, teal can generate the necessary objects each time a new session begins by specifying the `teal_data_module` using the following components: +`teal` will run this module when the application starts and the resulting `teal_data` object that will be used throughout all `teal` (analytic) modules. -- `ui` Function: This function should accept an `id` argument and define the user interface elements for the data module. +## Creating Data In-App -- `server` Function: Similarly, the server function should accept an `id` argument and define the server logic for the data module. `moduleServer` should return a reactive `teal_data` object, which will be used by the application to ensure the availability of up-to-date data upon each session start. +One case for postponing data operations are data sets that are dynamic, frequently updated. +Such data cannot be created once and kept in the global environment. +Using `teal_data_module` allows to create a data set from scratch every time the user starts the application. +This the user will always have access to the most recent version of the data. + +```{r, message = FALSE, warning = FALSE} +library(teal) +``` -By following these requirements, teal can efficiently handle dynamic data updates and create the necessary objects for a seamless user experience. ```{r} -library(teal) data_mod <- teal_data_module( ui = function(id) div(), server = function(id) { @@ -57,11 +68,12 @@ if (interactive()) { ``` -## Postponed data modification +## Modification Data In-App -In certain scenarios, app developers may want to pre-create a `data` object before a `teal` session initializes, allowing app users to interact with this `data` from the session's start. This can be achieved by using the `teal_data_module` function to efficiently modify the existing data object. +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. -The following code snippet illustrates how teal_data_module can be utilized to subset the `dataset1` based on the selected `Species` from the `input$species` variable: +The following example illustrates how `teal_data_module` can be utilized to subset data based on the user inputs: ```{r} data <- within(teal_data(), { @@ -74,7 +86,8 @@ data_mod <- teal_data_module( ui = function(id) { ns <- NS(id) div( - selectInput(ns("species"), "Select species to filter", choices = unique(iris$Species), multiple = TRUE), + selectInput(ns("species"), "Select species to filter", + choices = unique(iris$Species), multiple = TRUE), actionButton(ns("submit"), "Submit") ) }, @@ -102,4 +115,12 @@ if (interactive()) { } ``` -It's important to note that this approach reduces app loading time as `data` creation in the `.GlobalEnv` only involves data transformation. However, it's crucial to ensure that the initial server function is defined in the same environment as the data object to enable this functionality. This requirement ensures that data exists in the same environment as the calling environment of the `server` function, allowing for efficient data modification and interaction. +_See `?within.qenv` for a detailed explanation of how to use the `within` method._ + +Note that running preprocessing code in a module as opposed to the global environment will increase app loading times. +It is recommended to keep the constant code in the global environment and to move only the dynamic parts to a data module. + +###### WARNING + +When using `teal_data_moduel` 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. From e511517d8d0de1ae5d67dae4d8fd172bbb4d2a58 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Thu, 9 Nov 2023 13:02:49 +0000 Subject: [PATCH 34/51] [skip actions] Restyle files --- vignettes/data-as-shiny-module.Rmd | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd index 5fb7ce9d30..5f28ba4666 100644 --- a/vignettes/data-as-shiny-module.Rmd +++ b/vignettes/data-as-shiny-module.Rmd @@ -86,8 +86,9 @@ data_mod <- teal_data_module( ui = function(id) { ns <- NS(id) div( - selectInput(ns("species"), "Select species to filter", - choices = unique(iris$Species), multiple = TRUE), + selectInput(ns("species"), "Select species to filter", + choices = unique(iris$Species), multiple = TRUE + ), actionButton(ns("submit"), "Submit") ) }, From bbaff1f1a476afe0e776edfbec7dffe5beeff4c6 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Thu, 9 Nov 2023 16:00:42 +0100 Subject: [PATCH 35/51] update documentation for teal_data_module --- R/teal_data_module.R | 19 ++++++++++++++----- man/teal_data_module.Rd | 20 +++++++++++++++----- 2 files changed, 29 insertions(+), 10 deletions(-) diff --git a/R/teal_data_module.R b/R/teal_data_module.R index e1e0400803..facd526610 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -1,13 +1,22 @@ -#' Data module +#' Data module for `teal` applications #' -#' Data input for `teal::init` in form of a module +#' Create `shiny` module to supply or modify data in a `teal` application. +#' +#' This function creates a `shiny` module that allows for running data pre-processing code after the app starts. +#' The body of the server function will be run in the app rather than in the global environment. +#' This means it will be run every time the app starts, so use sparingly. +#' +#' Pass this module instead of a `teal_data` object in a call to `init`. +#' +#' See vignette "Data as shiny Module" for more details. #' #' @param ui (`function(id)`)\cr -#' `shiny` `ui` module with `id` argument +#' `shiny` module `ui` function; must only take `id` argument #' @param server (`function(id)`)\cr -#' `shiny` server function with `id` as argument. Module should return reactive `teal_data`. +#' `shiny` module `ui` function; must only take `id` argument; +#' must return reactive expression containing `teal_data` object #' -#' @return object of class `teal_data_module` +#' @return Object of class `teal_data_module`. #' #' @examples #' data <- teal_data_module( diff --git a/man/teal_data_module.Rd b/man/teal_data_module.Rd index d976065943..e2fb4ea89a 100644 --- a/man/teal_data_module.Rd +++ b/man/teal_data_module.Rd @@ -2,22 +2,32 @@ % Please edit documentation in R/teal_data_module.R \name{teal_data_module} \alias{teal_data_module} -\title{Data module} +\title{Data module for \code{teal} applications} \usage{ teal_data_module(ui, server) } \arguments{ \item{ui}{(\verb{function(id)})\cr -\code{shiny} \code{ui} module with \code{id} argument} +\code{shiny} module \code{ui} function; must only take \code{id} argument} \item{server}{(\verb{function(id)})\cr -\code{shiny} server function with \code{id} as argument. Module should return reactive \code{teal_data}.} +\code{shiny} module \code{ui} function; must only take \code{id} argument; +must return reactive expression containing \code{teal_data} object} } \value{ -object of class \code{teal_data_module} +Object of class \code{teal_data_module}. } \description{ -Data input for \code{teal::init} in form of a module +Create \code{shiny} module to supply or modify data in a \code{teal} application. +} +\details{ +This function creates a \code{shiny} module that allows for running data pre-processing code after the app starts. +The body of the server function will be run in the app rather than in the global environment. +This means it will be run every time the app starts, so use sparingly. + +Pass this module instead of a \code{teal_data} object in a call to \code{init}. + +See vignette "Data as shiny Module" for more details. } \examples{ data <- teal_data_module( From 2a38182a2b707aa7b8fcad2942ad15605f1ff4c7 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 9 Nov 2023 17:22:48 +0100 Subject: [PATCH 36/51] WIP review --- R/module_teal.R | 1 + R/module_teal_with_splash.R | 44 +++++++++++++++++++++++-------------- R/utils.R | 4 ++-- 3 files changed, 31 insertions(+), 18 deletions(-) diff --git a/R/module_teal.R b/R/module_teal.R index 0c7720a6f4..2fcadd99f3 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -167,6 +167,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { env <- environment() datasets_reactive <- eventReactive(raw_data(), { + req(raw_data()) env$progress <- shiny::Progress$new(session) env$progress$set(0.25, message = "Setting data") diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 4fd5e581e4..43f12168a2 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -40,8 +40,13 @@ ui_teal_with_splash <- function(id, message("App was initialized with delayed data loading.") data$get_ui(ns("startapp_module")) } - - ui_teal(id = ns("teal"), splash_ui = splash_ui, title = title, header = header, footer = footer) + ui_teal( + id = ns("teal"), + splash_ui = div(splash_ui, uiOutput(ns("error"))), + title = title, + header = header, + footer = footer + ) } #' Server function that loads the data through reactive loading and then delegates @@ -71,14 +76,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { # raw_data contains teal_data object # either passed to teal::init or returned from ddl raw_data <- if (inherits(data, "teal_data_module")) { - do.call( - data$server, - append( - list(id = "teal_data_module"), - attr(data, "server_args") # might be NULL or list() - both are fine - ), - quote = TRUE - ) + data$server(id = "teal_data_module") } else if (inherits(data, "teal_data")) { reactiveVal(data) } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) { @@ -115,19 +113,19 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { raw_data } - raw_data_checked <- reactive({ + output$error <- renderUI({ data <- raw_data() if (inherits(data, "qenv.error")) { # showNotification(sprintf("Error: %s", data$message), type = "error") logger::log_error(data$message) - return(NULL) + stop("Check your inputs or call app developer\n", data$message, call. = FALSE) } if (!inherits(data, "teal_data")) { msg <- "Error: server must return 'teal_data' object" showNotification(msg, type = "error") logger::log_error(msg) - return(NULL) + stop("Check your inputs or call app developer\n", msg, call. = FALSE) } is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) @@ -138,13 +136,27 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { logger::log_error(is_modules_ok) # NULL won't trigger observe which waits for raw_data() # we will need to consider validate process for filtered data and modules! - return(NULL) + stop("Contact app developer.\n", is_modules_ok, call. = FALSE) } if (!isTRUE(is_filter_ok)) { showNotification(is_filter_ok, type = "warning") logger::log_warn(is_filter_ok) - # we allow app to continue if applied filters are outside - # of possible data range + } + + NULL + }) + + raw_data_checked <- reactive({ + data <- req(raw_data()) + if (!inherits(data, "teal_data")) { + return(NULL) + } + + is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) + is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) + + if (!isTRUE(is_modules_ok) || !isTRUE(is_filter_ok)) { + return(NULL) } data diff --git a/R/utils.R b/R/utils.R index 81a6c40fbe..05c5d578b7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -150,7 +150,7 @@ check_modules_datanames <- function(modules, datanames) { extra_datanames <- setdiff(modules$datanames, c("all", datanames)) if (length(extra_datanames)) { sprintf( - "- Module '%s' has a different dataname than available in a 'data': %s not in %s", + "- Module '%s' uses different datanames than available in the 'data': (%s) not in (%s)", modules$label, toString(dQuote(extra_datanames, q = FALSE)), toString(dQuote(datanames, q = FALSE)) @@ -174,7 +174,7 @@ check_filter_datanames <- function(filters, datanames) { dataname <- shiny::isolate(filter$dataname) if (!dataname %in% datanames) { sprintf( - "- Filter '%s' has a different dataname than available in a 'data':\n %s not in %s", + "- Filter '%s' refers to dataname that in unavailable to 'data':\n %s not in (%s)", shiny::isolate(filter$id), dQuote(dataname, q = FALSE), toString(dQuote(datanames, q = FALSE)) From 971c7d51456e7667baaf365120a86e80d7c08a2c Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 10 Nov 2023 08:17:29 +0100 Subject: [PATCH 37/51] protect teal from teal_data_module errors --- R/module_teal.R | 1 - R/module_teal_with_splash.R | 91 +++++++++++-------- tests/testthat/test-init.R | 4 +- tests/testthat/test-module_teal_with_splash.R | 71 ++++++++++++--- 4 files changed, 116 insertions(+), 51 deletions(-) diff --git a/R/module_teal.R b/R/module_teal.R index 2fcadd99f3..0c7720a6f4 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -167,7 +167,6 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { env <- environment() datasets_reactive <- eventReactive(raw_data(), { - req(raw_data()) env$progress <- shiny::Progress$new(session) env$progress$set(0.25, message = "Setting data") diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 43f12168a2..94e747f566 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -106,63 +106,80 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { ) } }) - - if (!is.reactive(raw_data)) { - stop("The delayed loading module has to return a reactive object.") - } raw_data } - output$error <- renderUI({ - data <- raw_data() + if (!is.reactive(raw_data)) { + stop("The delayed loading module has to return a reactive object.") + } + + raw_data_checked <- reactive({ + # custom module can return error + data <- tryCatch(raw_data(), error = function(e) e) + + # there is an empty reactive event on init! + if (inherits(data, "shiny.silent.error") && identical(data$message, "")) { + return(NULL) + } + + # to handle qenv.error if (inherits(data, "qenv.error")) { - # - showNotification(sprintf("Error: %s", data$message), type = "error") - logger::log_error(data$message) - stop("Check your inputs or call app developer\n", data$message, call. = FALSE) + validate( + need( + FALSE, + paste( + "Error when executing `teal_data_module`:\n", + data$message, + "\n Check your inputs or contact app developer if error persist" + ) + ) + ) } - if (!inherits(data, "teal_data")) { - msg <- "Error: server must return 'teal_data' object" - showNotification(msg, type = "error") - logger::log_error(msg) - stop("Check your inputs or call app developer\n", msg, call. = FALSE) + + # to handle module non-qenv errors + if (inherits(data, "error")) { + validate( + need( + FALSE, + paste0( + "Error when executing `teal_data_module`:", + attr(data, "condition")$message, + "\n Check your inputs or contact app developer if error persist" + ) + ) + ) } + validate( + need( + inherits(data, "teal_data"), + paste( + "Error: `teal_data_module` didn't return `teal_data` object", + "\n Check your inputs or contact app developer if error persist" + ) + ) + ) + is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) - if (!isTRUE(is_modules_ok)) { - showNotification(is_modules_ok, type = "error") - logger::log_error(is_modules_ok) - # NULL won't trigger observe which waits for raw_data() - # we will need to consider validate process for filtered data and modules! - stop("Contact app developer.\n", is_modules_ok, call. = FALSE) - } + validate(need(isTRUE(is_modules_ok), is_modules_ok)) + if (!isTRUE(is_filter_ok)) { showNotification(is_filter_ok, type = "warning") logger::log_warn(is_filter_ok) } - NULL + raw_data() }) - raw_data_checked <- reactive({ - data <- req(raw_data()) - if (!inherits(data, "teal_data")) { - return(NULL) - } - - is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) - is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) - - if (!isTRUE(is_modules_ok) || !isTRUE(is_filter_ok)) { - return(NULL) - } - - data + output$error <- renderUI({ + raw_data_checked() + NULL }) + res <- srv_teal(id = "teal", modules = modules, raw_data = raw_data_checked, filter = filter) logger::log_trace("srv_teal_with_splash initialized module with data.") return(res) diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index daec873c16..18aac986ab 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -195,7 +195,7 @@ testthat::test_that("init filter accepts `teal_slices`", { testthat::test_that("init throws when incompatible module's datanames", { testthat::expect_error( init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))), - '"iris" not in "mtcars"' + "Module 'example teal module' uses different datanames than available in the 'data'" ) }) @@ -206,6 +206,6 @@ testthat::test_that("init throws when incompatible filter's datanames", { modules = modules(example_module()), filter = teal_slices(teal_slice(dataname = "iris", varname = "Species")) ), - '"iris" not in "mtcars"' + "Filter 'iris Species' refers to dataname that in unavailable to 'data'" ) }) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 4dbafd18b1..34868a853d 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -4,7 +4,7 @@ testthat::test_that("srv_teal_with_splash data accepts a teal_data_module", { app = srv_teal_with_splash, args = list( id = "id", - data = teal_data_module(ui = function(id) div(), server = function(id) NULL), + data = teal_data_module(ui = function(id) div(), server = function(id) reactive(NULL)), modules = modules(example_module()) ), expr = {} @@ -12,6 +12,21 @@ testthat::test_that("srv_teal_with_splash data accepts a teal_data_module", { ) }) +testthat::test_that("srv_teal_with_splash throws when teal_data_module doesn't return reactive", { + testthat::expect_error( + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "id", + data = teal_data_module(ui = function(id) div(), server = function(id) NULL), + modules = modules(example_module()) + ), + expr = {} + ), + "The delayed loading module has to return a reactive object." + ) +}) + testthat::test_that("srv_teal_with_splash raw_data evaluates the server of teal_data_module", { shiny::testServer( app = srv_teal_with_splash, @@ -42,7 +57,25 @@ testthat::test_that("srv_teal_with_splash passes teal_data to reactiveVal", { ) }) -testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL when qenv.error occurs", { +testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data_module returns error", { + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "test", + data = teal_data_module( + ui = function(id) div(), + server = function(id) reactive(stop()) + ), + modules = modules(example_module()) + ), + expr = { + testthat::expect_is(raw_data_checked, "reactive") + testthat::expect_error(raw_data_checked(), "Error when executing `teal_data_module`") + } + ) +}) + +testthat::test_that("srv_teal_with_splash raw_data_checked throws then qenv.error occurs", { shiny::testServer( app = srv_teal_with_splash, args = list( @@ -55,14 +88,30 @@ testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL when qen ), expr = { testthat::expect_is(raw_data_checked, "reactive") - testthat::expect_output( - testthat::expect_null(raw_data_checked()), - "not good" - ) + testthat::expect_error(raw_data_checked(), "not good") + } + ) +}) + +testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data_module doesn't return teal_data", { + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "test", + data = teal_data_module( + ui = function(id) div(), + server = function(id) reactive(data.frame()) + ), + modules = modules(example_module()) + ), + expr = { + testthat::expect_is(raw_data_checked, "reactive") + testthat::expect_error(raw_data_checked(), "didn't return `teal_data`") } ) }) + testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns NULL before loading", { x <- dataset_connector(dataname = "test_dataset", pull_callable = callable_code("iris")) delayed_data <- teal_data(x) @@ -97,7 +146,7 @@ testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns ) }) -testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL if incompatible module's dataname", { +testthat::test_that("srv_teal_with_splash raw_data_checked throws when incompatible module's datanames", { shiny::testServer( app = srv_teal_with_splash, args = list( @@ -107,15 +156,15 @@ testthat::test_that("srv_teal_with_splash raw_data_checked returns NULL if incom ), expr = { testthat::expect_is(raw_data_checked, "reactive") - testthat::expect_output( - testthat::expect_null(raw_data_checked()), - '"iris" not in "mtcars"' + testthat::expect_error( + raw_data_checked(), + "Module 'example teal module' uses different datanames than available in the 'data'" ) } ) }) -testthat::test_that("srv_teal_with_splash raw_data_checked returns teal_data even if incompatible filter's dataname", { +testthat::test_that("srv_teal_with_splash raw_data_checked returns teal_data if incompatible filter's datanames", { shiny::testServer( app = srv_teal_with_splash, args = list( From 72abf29e25ff9c4bc53e569a1ad215bd544757d6 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 10 Nov 2023 08:28:58 +0100 Subject: [PATCH 38/51] @kartikayakirar --- R/utils.R | 21 ++++++++++++++++++++- man/check_filter_datanames.Rd | 21 +++++++++++++++++++++ man/check_modules_datanames.Rd | 21 +++++++++++++++++++++ 3 files changed, 62 insertions(+), 1 deletion(-) create mode 100644 man/check_filter_datanames.Rd create mode 100644 man/check_modules_datanames.Rd diff --git a/R/utils.R b/R/utils.R index 05c5d578b7..3b5cd9d913 100644 --- a/R/utils.R +++ b/R/utils.R @@ -141,6 +141,16 @@ resolve_modules_datanames <- function(modules, datanames, join_keys) { } } +#' Check `datanames` in modules +#' +#' This function ensures specified `datanames` in modules match those in the data object, +#' returning error messages or `TRUE` for successful validation. +#' +#' @param modules (`teal_modules`) object +#' @param datanames (`character`) names of datasets available in the `data` object +#' +#' @return A `character(1)` containing error message or `TRUE` if validation passes. +#' @keywords internal check_modules_datanames <- function(modules, datanames) { recursive_check_datanames <- function(modules, datanames) { # check teal_modules against datanames @@ -166,7 +176,16 @@ check_modules_datanames <- function(modules, datanames) { } } - +#' Check `datanames` in filters +#' +#' This function check `datanames` in filters correspond to those in `data`, +#' returning character vector with error messages or TRUE if all checks pass. +#' +#' @param filters (`teal_slices`) object +#' @param datanames (`character`) names of datasets available in the `data` object +#' +#' @return A `character(1)` containing error message or TRUE if validation passes. +#' @keywords internal check_filter_datanames <- function(filters, datanames) { # check teal_slices against datanames out <- sapply( diff --git a/man/check_filter_datanames.Rd b/man/check_filter_datanames.Rd new file mode 100644 index 0000000000..e4e46e8c16 --- /dev/null +++ b/man/check_filter_datanames.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{check_filter_datanames} +\alias{check_filter_datanames} +\title{Check \code{datanames} in filters} +\usage{ +check_filter_datanames(filters, datanames) +} +\arguments{ +\item{filters}{(\code{teal_slices}) object} + +\item{datanames}{(\code{character}) names of datasets available in the \code{data} object} +} +\value{ +A \code{character(1)} containing error message or TRUE if validation passes. +} +\description{ +This function check \code{datanames} in filters correspond to those in \code{data}, +returning character vector with error messages or TRUE if all checks pass. +} +\keyword{internal} diff --git a/man/check_modules_datanames.Rd b/man/check_modules_datanames.Rd new file mode 100644 index 0000000000..7fef35aec0 --- /dev/null +++ b/man/check_modules_datanames.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{check_modules_datanames} +\alias{check_modules_datanames} +\title{Check \code{datanames} in modules} +\usage{ +check_modules_datanames(modules, datanames) +} +\arguments{ +\item{modules}{(\code{teal_modules}) object} + +\item{datanames}{(\code{character}) names of datasets available in the \code{data} object} +} +\value{ +A \code{character(1)} containing error message or \code{TRUE} if validation passes. +} +\description{ +This function ensures specified \code{datanames} in modules match those in the data object, +returning error messages or \code{TRUE} for successful validation. +} +\keyword{internal} From 457ae2cafe357f1d7720921ca1b7cb4b797fdcec Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Date: Fri, 10 Nov 2023 09:37:55 +0100 Subject: [PATCH 39/51] fix typo Co-authored-by: kartikeya kirar Signed-off-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> --- vignettes/data-as-shiny-module.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd index 5f28ba4666..85a98878b9 100644 --- a/vignettes/data-as-shiny-module.Rmd +++ b/vignettes/data-as-shiny-module.Rmd @@ -123,5 +123,5 @@ It is recommended to keep the constant code in the global environment and to mov ###### WARNING -When using `teal_data_moduel` 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. +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. From 9d63d408e8dbbf2ca3dcb316028250626c4eaa15 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 10 Nov 2023 09:44:49 +0100 Subject: [PATCH 40/51] add NEWS entry and reorganize in proper sections - remove info about internal functions --- NEWS.md | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6f6a63a350..6a3c7ccce9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,13 +1,19 @@ # teal 0.14.0.9017 +### New features + +* `data` argument in `init` accepts now `teal_data` and `teal_data_module`. +* Added `landing_popup_module` function which creates a module that will display a popup when the app starts. The popup will block access to the app until it is dismissed. +* Filter state snapshots can now be uploaded from file. See `?snapshot`. + ### Miscellaneous * Enhanced a `module` validation checks so that it won't throw messages about `data` argument unnecessarily. -* Removed `Report previewer` module from mapping matrix display in filter manager. -* Added internal functions for storing and restoring of `teal_slices` objects. -* Filter state snapshots can now be uploaded from file. See `?snapshot`. * Added argument to `teal_slices` and made modifications to `init` to enable tagging `teal_slices` with an app id to safely upload snapshots from disk. -* Added `landing_popup_module` function which creates a module that will display a popup when the app starts. The popup will block access to the app until it is dismissed. + +### Bug fixes + +* Removed `Report previewer` module from mapping matrix display in filter manager. # teal 0.14.0 From f84ad0bb52698076e127cc84098d536de55d6162 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 10 Nov 2023 11:32:42 +0100 Subject: [PATCH 41/51] @chlebowa @ruckip review --- NEWS.md | 2 +- R/dummy_functions.R | 7 ++---- R/init.R | 5 ++++- R/module_teal_with_splash.R | 19 +++++++++------- R/utils.R | 14 +++++++----- man/check_filter_datanames.Rd | 2 +- man/example_module.Rd | 4 +--- tests/testthat/test-init.R | 21 +++++++++++++----- tests/testthat/test-module_teal_with_splash.R | 22 +++++++++++++++---- 9 files changed, 62 insertions(+), 34 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6a3c7ccce9..a3910fc9f1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ ### New features -* `data` argument in `init` accepts now `teal_data` and `teal_data_module`. +* `data` argument in `init` now accepts `teal_data` and `teal_data_module`. * Added `landing_popup_module` function which creates a module that will display a popup when the app starts. The popup will block access to the app until it is dismissed. * Filter state snapshots can now be uploaded from file. See `?snapshot`. diff --git a/R/dummy_functions.R b/R/dummy_functions.R index 6d03ad65f1..608c1a3241 100644 --- a/R/dummy_functions.R +++ b/R/dummy_functions.R @@ -75,7 +75,6 @@ example_datasets <- function() { # nolint #' #' @description `r lifecycle::badge("experimental")` #' @inheritParams module -#' @param src (`logical(1)`) whether to display reproducible R code in the module. #' @return A `teal` module which can be included in the `modules` argument to [teal::init()]. #' @examples #' app <- init( @@ -89,7 +88,7 @@ example_datasets <- function() { # nolint #' shinyApp(app$ui, app$server) #' } #' @export -example_module <- function(label = "example teal module", datanames = "all", src = TRUE) { +example_module <- function(label = "example teal module", datanames = "all") { checkmate::assert_string(label) module( label, @@ -110,9 +109,7 @@ example_module <- function(label = "example teal module", datanames = "all", src output = verbatimTextOutput(ns("text")), encoding = div( selectInput(ns("dataname"), "Choose a dataset", choices = names(data)), - if (src) { - teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") - } + teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") ) ) }, diff --git a/R/init.R b/R/init.R index 4d04adcdc9..50e4fe2c0a 100644 --- a/R/init.R +++ b/R/init.R @@ -190,6 +190,10 @@ init <- function(data, } if (inherits(data, "teal_data")) { + if (length(teal.data::datanames(data)) == 0) { + stop("`data` object has no datanames. Specify `datanames(data)` and try again.") + } + # in case of teal_data_module this check is postponed to the srv_teal_with_splash is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) if (!isTRUE(is_modules_ok)) { @@ -200,7 +204,6 @@ init <- function(data, is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) if (!isTRUE(is_filter_ok)) { logger::log_warn(is_filter_ok) - warning(is_filter_ok) # we allow app to continue if applied filters are outside # of possible data range } diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 94e747f566..03e8f5d906 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -110,7 +110,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { } if (!is.reactive(raw_data)) { - stop("The delayed loading module has to return a reactive object.") + stop("The `teal_data_module` has to return a reactive object.", call. = FALSE) } raw_data_checked <- reactive({ @@ -128,9 +128,9 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { need( FALSE, paste( - "Error when executing `teal_data_module`:\n", + "Error when executing `teal_data_module`:\n ", data$message, - "\n Check your inputs or contact app developer if error persist" + "\n Check your inputs or contact app developer if error persists" ) ) ) @@ -142,9 +142,9 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { need( FALSE, paste0( - "Error when executing `teal_data_module`:", + "Error when executing `teal_data_module`:\n ", attr(data, "condition")$message, - "\n Check your inputs or contact app developer if error persist" + "\n Check your inputs or contact app developer if error persists" ) ) ) @@ -154,19 +154,22 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { need( inherits(data, "teal_data"), paste( - "Error: `teal_data_module` didn't return `teal_data` object", - "\n Check your inputs or contact app developer if error persist" + "Error: `teal_data_module` did not return `teal_data` object", + "\n Check your inputs or contact app developer if error persists" ) ) ) + validate(need(teal.data::datanames(data), "Data has no datanames. Contact app developer")) + + is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) validate(need(isTRUE(is_modules_ok), is_modules_ok)) if (!isTRUE(is_filter_ok)) { - showNotification(is_filter_ok, type = "warning") + showNotification(is_filter_ok, type = "warning", duration = 10) logger::log_warn(is_filter_ok) } diff --git a/R/utils.R b/R/utils.R index 3b5cd9d913..7af83979f2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -160,7 +160,7 @@ check_modules_datanames <- function(modules, datanames) { extra_datanames <- setdiff(modules$datanames, c("all", datanames)) if (length(extra_datanames)) { sprintf( - "- Module '%s' uses different datanames than available in the 'data': (%s) not in (%s)", + "- Module '%s' uses datanames not available in the 'data': (%s) not in (%s)", modules$label, toString(dQuote(extra_datanames, q = FALSE)), toString(dQuote(datanames, q = FALSE)) @@ -178,7 +178,7 @@ check_modules_datanames <- function(modules, datanames) { #' Check `datanames` in filters #' -#' This function check `datanames` in filters correspond to those in `data`, +#' This function checks whether `datanames` in filters correspond to those in `data`, #' returning character vector with error messages or TRUE if all checks pass. #' #' @param filters (`teal_slices`) object @@ -188,20 +188,22 @@ check_modules_datanames <- function(modules, datanames) { #' @keywords internal check_filter_datanames <- function(filters, datanames) { # check teal_slices against datanames - out <- sapply( + out <- unlist(sapply( filters, function(filter) { dataname <- shiny::isolate(filter$dataname) if (!dataname %in% datanames) { sprintf( - "- Filter '%s' refers to dataname that in unavailable to 'data':\n %s not in (%s)", + "- Filter '%s' refers to dataname not available in 'data':\n %s not in (%s)", shiny::isolate(filter$id), dQuote(dataname, q = FALSE), toString(dQuote(datanames, q = FALSE)) ) } } - ) - if (length(unlist(out))) { + )) + + + if (length(out)) { paste(out, collapse = "\n") } else { TRUE diff --git a/man/check_filter_datanames.Rd b/man/check_filter_datanames.Rd index e4e46e8c16..2827604a27 100644 --- a/man/check_filter_datanames.Rd +++ b/man/check_filter_datanames.Rd @@ -15,7 +15,7 @@ check_filter_datanames(filters, datanames) A \code{character(1)} containing error message or TRUE if validation passes. } \description{ -This function check \code{datanames} in filters correspond to those in \code{data}, +This function checks whether \code{datanames} in filters correspond to those in \code{data}, returning character vector with error messages or TRUE if all checks pass. } \keyword{internal} diff --git a/man/example_module.Rd b/man/example_module.Rd index c2a58c3dec..9a0c88862b 100644 --- a/man/example_module.Rd +++ b/man/example_module.Rd @@ -4,7 +4,7 @@ \alias{example_module} \title{An example \code{teal} module} \usage{ -example_module(label = "example teal module", datanames = "all", src = TRUE) +example_module(label = "example teal module", datanames = "all") } \arguments{ \item{label}{(\code{character(1)}) Label shown in the navigation item for the module. Any label possible except @@ -15,8 +15,6 @@ filter panel will automatically update the shown filters to include only filters in the listed datasets. \code{NULL} will hide the filter panel, and the keyword \code{'all'} will show filters of all datasets. \code{datanames} also determines a subset of datasets which are appended to the \code{data} argument in \code{server} function.} - -\item{src}{(\code{logical(1)}) whether to display reproducible R code in the module.} } \value{ A \code{teal} module which can be included in the \code{modules} argument to \code{\link[=init]{init()}}. diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 18aac986ab..d1989650fa 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -192,20 +192,31 @@ testthat::test_that("init filter accepts `teal_slices`", { ) }) -testthat::test_that("init throws when incompatible module's datanames", { +testthat::test_that("init throws when data has no datanames", { testthat::expect_error( - init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))), - "Module 'example teal module' uses different datanames than available in the 'data'" + init(data = teal_data(), modules = list(example_module())), + "has no datanames" + ) +}) + +testthat::test_that("init throws when incompatible module's datanames", { + msg <- "Module 'example teal module' uses datanames not available in the 'data'" + testthat::expect_output( + testthat::expect_error( + init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))), + msg + ), + msg ) }) testthat::test_that("init throws when incompatible filter's datanames", { - testthat::expect_warning( + testthat::expect_output( init( data = teal_data(mtcars = mtcars), modules = modules(example_module()), filter = teal_slices(teal_slice(dataname = "iris", varname = "Species")) ), - "Filter 'iris Species' refers to dataname that in unavailable to 'data'" + "Filter 'iris Species' refers to dataname not available in 'data'" ) }) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 34868a853d..acdfff310c 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -23,7 +23,7 @@ testthat::test_that("srv_teal_with_splash throws when teal_data_module doesn't r ), expr = {} ), - "The delayed loading module has to return a reactive object." + "The `teal_data_module` has to return a reactive object." ) }) @@ -47,7 +47,7 @@ testthat::test_that("srv_teal_with_splash passes teal_data to reactiveVal", { app = srv_teal_with_splash, args = list( id = "test", - data = teal_data(), + data = teal_data(iris = iris), modules = modules(example_module()) ), expr = { @@ -57,6 +57,20 @@ testthat::test_that("srv_teal_with_splash passes teal_data to reactiveVal", { ) }) +testthat::test_that("srv_teal_with_splash throws when datanames are empty", { + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "test", + data = teal_data(), + modules = modules(example_module()) + ), + expr = { + testthat::expect_error(raw_data_checked(), "Data has no datanames") + } + ) +}) + testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data_module returns error", { shiny::testServer( app = srv_teal_with_splash, @@ -106,7 +120,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data ), expr = { testthat::expect_is(raw_data_checked, "reactive") - testthat::expect_error(raw_data_checked(), "didn't return `teal_data`") + testthat::expect_error(raw_data_checked(), "did not return `teal_data`") } ) }) @@ -158,7 +172,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when incompati testthat::expect_is(raw_data_checked, "reactive") testthat::expect_error( raw_data_checked(), - "Module 'example teal module' uses different datanames than available in the 'data'" + "Module 'example teal module' uses datanames not available in the 'data'" ) } ) From 7d5ccc35f4bffd17836c9d36c32dc8188579a27c Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 10 Nov 2023 11:59:04 +0100 Subject: [PATCH 42/51] review --- R/module_teal_with_splash.R | 6 +++++- R/utils.R | 2 +- tests/testthat/test-init.R | 2 +- tests/testthat/test-module_teal_with_splash.R | 2 +- 4 files changed, 8 insertions(+), 4 deletions(-) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 03e8f5d906..062ea3353f 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -169,7 +169,11 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { validate(need(isTRUE(is_modules_ok), is_modules_ok)) if (!isTRUE(is_filter_ok)) { - showNotification(is_filter_ok, type = "warning", duration = 10) + showNotification( + "Some filters were not applied because of incompatibility with data. Contact app developer", + type = "warning", + duration = 10 + ) logger::log_warn(is_filter_ok) } diff --git a/R/utils.R b/R/utils.R index 7af83979f2..b10a0d4001 100644 --- a/R/utils.R +++ b/R/utils.R @@ -160,7 +160,7 @@ check_modules_datanames <- function(modules, datanames) { extra_datanames <- setdiff(modules$datanames, c("all", datanames)) if (length(extra_datanames)) { sprintf( - "- Module '%s' uses datanames not available in the 'data': (%s) not in (%s)", + "- Module '%s' uses datanames not available in 'data': (%s) not in (%s)", modules$label, toString(dQuote(extra_datanames, q = FALSE)), toString(dQuote(datanames, q = FALSE)) diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index d1989650fa..01aa0a85dd 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -200,7 +200,7 @@ testthat::test_that("init throws when data has no datanames", { }) testthat::test_that("init throws when incompatible module's datanames", { - msg <- "Module 'example teal module' uses datanames not available in the 'data'" + msg <- "Module 'example teal module' uses datanames not available in 'data'" testthat::expect_output( testthat::expect_error( init(data = teal_data(mtcars = mtcars), modules = list(example_module(datanames = "iris"))), diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index acdfff310c..769f6b3491 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -172,7 +172,7 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when incompati testthat::expect_is(raw_data_checked, "reactive") testthat::expect_error( raw_data_checked(), - "Module 'example teal module' uses datanames not available in the 'data'" + "Module 'example teal module' uses datanames not available in 'data'" ) } ) From 6570474e6a41c83aa70e530276a4c15f9dd9b733 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 10 Nov 2023 12:25:48 +0100 Subject: [PATCH 43/51] fix error handling when simple error in teal_data_module --- R/module_teal_with_splash.R | 2 +- tests/testthat/test-module_teal_with_splash.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 062ea3353f..a5dc279a79 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -143,7 +143,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { FALSE, paste0( "Error when executing `teal_data_module`:\n ", - attr(data, "condition")$message, + data$message, "\n Check your inputs or contact app developer if error persists" ) ) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 769f6b3491..53b56098db 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -78,13 +78,13 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data id = "test", data = teal_data_module( ui = function(id) div(), - server = function(id) reactive(stop()) + server = function(id) reactive(stop("this error")) ), modules = modules(example_module()) ), expr = { testthat::expect_is(raw_data_checked, "reactive") - testthat::expect_error(raw_data_checked(), "Error when executing `teal_data_module`") + testthat::expect_error(raw_data_checked(), "this error") } ) }) From 8a0675f77b972ea2320cccbb2667fccf9432a869 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 10 Nov 2023 12:56:46 +0100 Subject: [PATCH 44/51] change error message when teal_data_module doesn't return reactive --- R/module_teal_with_splash.R | 2 +- tests/testthat/test-module_teal_with_splash.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index a5dc279a79..8fc41faaad 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -110,7 +110,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { } if (!is.reactive(raw_data)) { - stop("The `teal_data_module` has to return a reactive object.", call. = FALSE) + stop("The `teal_data_module` must return a reactive expression containing a `teal_data` object.", call. = FALSE) } raw_data_checked <- reactive({ diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 53b56098db..243a8d782f 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -23,7 +23,7 @@ testthat::test_that("srv_teal_with_splash throws when teal_data_module doesn't r ), expr = {} ), - "The `teal_data_module` has to return a reactive object." + "The `teal_data_module` must return a reactive expression containing a `teal_data` object." ) }) From 422efa6288c33105a6c94ee3681f2f877e5a6344 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 10 Nov 2023 13:38:09 +0100 Subject: [PATCH 45/51] review --- tests/testthat/test-init.R | 17 ---------------- tests/testthat/test-module_nested_tabs.R | 6 +++--- tests/testthat/test-module_teal_with_splash.R | 2 +- tests/testthat/test-teal_data_module.R | 20 +++++++++++++++++++ 4 files changed, 24 insertions(+), 21 deletions(-) create mode 100644 tests/testthat/test-teal_data_module.R diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 01aa0a85dd..b19df7aad7 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -149,23 +149,6 @@ testthat::test_that("init data accepts teal_data_module", { ) }) -testthat::test_that("init teal_data_module doesn't accept ui and server with other formals than id", { - testthat::expect_error( - init( - data = teal_data_module(ui = function(id, x) div(), server = function(id) NULL), - modules = modules(teal:::example_module()) - ), - "Must have exactly 1 formal arguments" - ) - testthat::expect_error( - init( - data = teal_data_module(ui = function(id) div(), server = function(id, x) NULL), - modules = modules(teal:::example_module()) - ), - "Must have exactly 1 formal arguments" - ) -}) - testthat::test_that("init modules accepts a teal_modules object", { mods <- modules(example_module(), example_module()) testthat::expect_no_error(init(data = iris, modules = mods)) diff --git a/tests/testthat/test-module_nested_tabs.R b/tests/testthat/test-module_nested_tabs.R index 858f2cc460..f4479988b9 100644 --- a/tests/testthat/test-module_nested_tabs.R +++ b/tests/testthat/test-module_nested_tabs.R @@ -486,9 +486,9 @@ testthat::test_that("calculate_hashes takes a FilteredData and vector of datanam datasets <- teal.slice::init_filtered_data( list( - ADSL = list(dataset = head(adsl)), - ADAE = list(dataset = head(adae)), - ADTTE = list(dataset = head(adtte)) + ADSL = list(dataset = adsl), + ADAE = list(dataset = adae), + ADTTE = list(dataset = adtte) ) ) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 243a8d782f..24677bc0d8 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -42,7 +42,7 @@ testthat::test_that("srv_teal_with_splash raw_data evaluates the server of teal_ ) }) -testthat::test_that("srv_teal_with_splash passes teal_data to reactiveVal", { +testthat::test_that("srv_teal_with_splash passes teal_data to reactive", { shiny::testServer( app = srv_teal_with_splash, args = list( diff --git a/tests/testthat/test-teal_data_module.R b/tests/testthat/test-teal_data_module.R new file mode 100644 index 0000000000..93d20d203b --- /dev/null +++ b/tests/testthat/test-teal_data_module.R @@ -0,0 +1,20 @@ +testthat::test_that("teal_data_module returns teal_data_module", { + testthat::expect_s3_class( + teal_data_module(ui = function(id) div(), server = function(id) NULL), + "teal_data_module" + ) +}) + +testthat::test_that("teal_data_module throws when ui has other formals than id only", { + testthat::expect_error( + teal_data_module(ui = function(id, x) div(), server = function(id) NULL), + "Must have exactly 1 formal arguments" + ) +}) + +testthat::test_that("teal_data_module throws when server has other formals than id only", { + testthat::expect_error( + teal_data_module(ui = function(id) div(), server = function(id, x) NULL), + "Must have exactly 1 formal arguments" + ) +}) From 8e0cc87588de34031bef5c0d6971c1275bd6e54b Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 13 Nov 2023 12:07:42 +0100 Subject: [PATCH 46/51] @ruckip review --- R/init.R | 3 +- R/landing_popup_module.R | 4 +- R/module_nested_tabs.R | 3 +- R/module_teal.R | 25 ++++++----- R/module_teal_with_splash.R | 25 ++++++----- R/teal_data_module.R | 6 +-- man/landing_popup_module.Rd | 4 +- man/module_teal.Rd | 10 ++--- man/teal_data_module.Rd | 6 +-- tests/testthat/test-module_teal.R | 24 +++++------ tests/testthat/test-module_teal_with_splash.R | 42 +++++++++---------- 11 files changed, 78 insertions(+), 74 deletions(-) diff --git a/R/init.R b/R/init.R index 50e4fe2c0a..5cc722449d 100644 --- a/R/init.R +++ b/R/init.R @@ -198,9 +198,10 @@ init <- function(data, is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) if (!isTRUE(is_modules_ok)) { logger::log_error(is_modules_ok) - stop(is_modules_ok) + checkmate::assert(is_modules_ok, .var.name = "modules") } + is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) if (!isTRUE(is_filter_ok)) { logger::log_warn(is_filter_ok) diff --git a/R/landing_popup_module.R b/R/landing_popup_module.R index cb94e14484..fd2501c329 100644 --- a/R/landing_popup_module.R +++ b/R/landing_popup_module.R @@ -15,7 +15,7 @@ #' #' @examples #' app1 <- teal::init( -#' data = teal.data::dataset("iris", iris), +#' data = teal_data(iris = iris), #' modules = teal::modules( #' teal::landing_popup_module( #' content = "A place for the welcome message or a disclaimer statement.", @@ -29,7 +29,7 @@ #' } #' #' app2 <- teal::init( -#' data = teal.data::dataset("iris", iris), +#' data = teal_data(iris = iris), #' modules = teal::modules( #' teal::landing_popup_module( #' title = "Welcome", diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 14f52dc441..b84fb45277 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -112,7 +112,8 @@ ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L, is_mod checkmate::assert_class(datasets, class = "FilteredData") ns <- NS(id) - args <- c(list(id = ns("module")), modules$ui_args) + args <- isolate(teal.transform::resolve_delayed(modules$ui_args, datasets)) + args <- c(list(id = ns("module")), args) if (is_arg_used(modules$ui, "datasets")) { args <- c(args, datasets = datasets) diff --git a/R/module_teal.R b/R/module_teal.R index 0c7720a6f4..277ccdd198 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -15,7 +15,7 @@ #' for non-delayed data which takes time to load into memory, avoiding #' Shiny session timeouts. #' -#' Server evaluates the `raw_data` (delayed data mechanism) and creates the +#' Server evaluates the `teal_data_rv` (delayed data mechanism) and creates the #' `datasets` object that is shared across modules. #' Once it is ready and non-`NULL`, the splash screen is replaced by the #' main teal UI that depends on the data. @@ -33,7 +33,7 @@ #' can be a splash screen or a Shiny module UI. For the latter, see #' [init()] about how to call the corresponding server function. #' -#' @param raw_data (`reactive`)\cr +#' @param teal_data_rv (`reactive`)\cr #' returns the `teal_data`, only evaluated once, `NULL` value is ignored #' #' @return @@ -44,13 +44,13 @@ #' #' @examples #' mods <- teal:::example_modules() -#' raw_data <- reactive(teal:::example_cdisc_data()) +#' teal_data_rv <- reactive(teal:::example_cdisc_data()) #' app <- shinyApp( #' ui = function() { #' teal:::ui_teal("dummy") #' }, #' server = function(input, output, session) { -#' active_module <- teal:::srv_teal(id = "dummy", modules = mods, raw_data = raw_data) +#' active_module <- teal:::srv_teal(id = "dummy", modules = mods, teal_data_rv = teal_data_rv) #' } #' ) #' if (interactive()) { @@ -130,8 +130,8 @@ ui_teal <- function(id, #' @rdname module_teal -srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { - stopifnot(is.reactive(raw_data)) +srv_teal <- function(id, modules, teal_data_rv, filter = teal_slices()) { + stopifnot(is.reactive(teal_data_rv)) moduleServer(id, function(input, output, session) { logger::log_trace("srv_teal initializing the module.") @@ -166,13 +166,13 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { } env <- environment() - datasets_reactive <- eventReactive(raw_data(), { + datasets_reactive <- eventReactive(teal_data_rv(), { env$progress <- shiny::Progress$new(session) env$progress$set(0.25, message = "Setting data") # create a list of data following structure of the nested modules list structure. # Because it's easier to unpack modules and datasets when they follow the same nested structure. - datasets_singleton <- teal_data_to_filtered_data(raw_data()) + datasets_singleton <- teal_data_to_filtered_data(teal_data_rv()) # Singleton starts with only global filters active. filter_global <- Filter(function(x) x$id %in% attr(filter, "mapping")$global_filters, filter) datasets_singleton$set_filter_state(filter_global) @@ -187,12 +187,15 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { # we should create FilteredData even if modules$datanames is null # null controls a display of filter panel but data should be still passed datanames <- if (is.null(modules$datanames) || modules$datanames == "all") { - include_parent_datanames(raw_data()@datanames, raw_data()@join_keys) # todo: use methods instead + include_parent_datanames( + teal.data::datanames(teal_data_rv()), + teal_data_rv()@join_keys + ) } else { modules$datanames } # todo: subset teal_data to datanames - datasets_module <- teal_data_to_filtered_data(raw_data()) + datasets_module <- teal_data_to_filtered_data(teal_data_rv()) # set initial filters # - filtering filters for this module @@ -219,7 +222,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { # usually not change afterwards # if restored from bookmarked state, `filter` is ignored - observeEvent(datasets_reactive(), { + observeEvent(datasets_reactive(), once = TRUE, { logger::log_trace("srv_teal@5 setting main ui after data was pulled") on.exit(env$progress$close()) env$progress$set(0.5, message = "Setting up main UI") diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 8fc41faaad..934b206e4e 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -73,9 +73,9 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { shinyjs::showLog() } - # raw_data contains teal_data object - # either passed to teal::init or returned from ddl - raw_data <- if (inherits(data, "teal_data_module")) { + # teal_data_rv contains teal_data object + # either passed to teal::init or returned from teal_data_module + teal_data_rv <- if (inherits(data, "teal_data_module")) { data$server(id = "teal_data_module") } else if (inherits(data, "teal_data")) { reactiveVal(data) @@ -109,13 +109,13 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { raw_data } - if (!is.reactive(raw_data)) { + if (!is.reactive(teal_data_rv)) { stop("The `teal_data_module` must return a reactive expression containing a `teal_data` object.", call. = FALSE) } - raw_data_checked <- reactive({ + teal_data_rv_validate <- reactive({ # custom module can return error - data <- tryCatch(raw_data(), error = function(e) e) + data <- tryCatch(teal_data_rv(), error = function(e) e) # there is an empty reactive event on init! if (inherits(data, "shiny.silent.error") && identical(data$message, "")) { @@ -129,7 +129,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { FALSE, paste( "Error when executing `teal_data_module`:\n ", - data$message, + paste(data$message, collapse = "\n"), "\n Check your inputs or contact app developer if error persists" ) ) @@ -143,7 +143,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { FALSE, paste0( "Error when executing `teal_data_module`:\n ", - data$message, + paste(data$message, collpase = "\n"), "\n Check your inputs or contact app developer if error persists" ) ) @@ -164,10 +164,9 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) - is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) - validate(need(isTRUE(is_modules_ok), is_modules_ok)) + is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) if (!isTRUE(is_filter_ok)) { showNotification( "Some filters were not applied because of incompatibility with data. Contact app developer", @@ -177,17 +176,17 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { logger::log_warn(is_filter_ok) } - raw_data() + teal_data_rv() }) output$error <- renderUI({ - raw_data_checked() + teal_data_rv_validate() NULL }) - res <- srv_teal(id = "teal", modules = modules, raw_data = raw_data_checked, filter = filter) + res <- srv_teal(id = "teal", modules = modules, teal_data_rv = teal_data_rv_validate, filter = filter) logger::log_trace("srv_teal_with_splash initialized module with data.") return(res) }) diff --git a/R/teal_data_module.R b/R/teal_data_module.R index facd526610..b769535456 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -1,6 +1,6 @@ #' Data module for `teal` applications #' -#' Create `shiny` module to supply or modify data in a `teal` application. +#' Creates `teal_data_module` object - a `shiny` module to supply or modify data in a `teal` application. #' #' This function creates a `shiny` module that allows for running data pre-processing code after the app starts. #' The body of the server function will be run in the app rather than in the global environment. @@ -28,13 +28,13 @@ #' moduleServer(id, function(input, output, session) { #' eventReactive(input$submit, { #' data <- within( -#' teal.data::teal_data(), +#' teal_data(), #' { #' dataset1 <- iris #' dataset2 <- mtcars #' } #' ) -#' teal.data::datanames(data) <- c("iris", "mtcars") +#' datanames(data) <- c("iris", "mtcars") #' #' data #' }) diff --git a/man/landing_popup_module.Rd b/man/landing_popup_module.Rd index 92531ca334..1c8ead4e86 100644 --- a/man/landing_popup_module.Rd +++ b/man/landing_popup_module.Rd @@ -32,7 +32,7 @@ The dialog blocks the access to the application and must be closed with a button } \examples{ app1 <- teal::init( - data = teal.data::dataset("iris", iris), + data = teal_data(iris = iris), modules = teal::modules( teal::landing_popup_module( content = "A place for the welcome message or a disclaimer statement.", @@ -46,7 +46,7 @@ if (interactive()) { } app2 <- teal::init( - data = teal.data::dataset("iris", iris), + data = teal_data(iris = iris), modules = teal::modules( teal::landing_popup_module( title = "Welcome", diff --git a/man/module_teal.Rd b/man/module_teal.Rd index 10c1c8654c..50524636c4 100644 --- a/man/module_teal.Rd +++ b/man/module_teal.Rd @@ -14,7 +14,7 @@ ui_teal( footer = tags$p("") ) -srv_teal(id, modules, raw_data, filter = teal_slices()) +srv_teal(id, modules, teal_data_rv, filter = teal_slices()) } \arguments{ \item{id}{(\code{character(1)})\cr @@ -35,7 +35,7 @@ argument) will be placed in the app's \code{ui} function so code which needs to \item{footer}{(\code{shiny.tag} or \code{character})\cr the footer of the app} -\item{raw_data}{(\code{reactive})\cr +\item{teal_data_rv}{(\code{reactive})\cr returns the \code{teal_data}, only evaluated once, \code{NULL} value is ignored} } \value{ @@ -57,7 +57,7 @@ The splash screen functionality can also be used for non-delayed data which takes time to load into memory, avoiding Shiny session timeouts. -Server evaluates the \code{raw_data} (delayed data mechanism) and creates the +Server evaluates the \code{teal_data_rv} (delayed data mechanism) and creates the \code{datasets} object that is shared across modules. Once it is ready and non-\code{NULL}, the splash screen is replaced by the main teal UI that depends on the data. @@ -69,13 +69,13 @@ It is written as a Shiny module so it can be added into other apps as well. } \examples{ mods <- teal:::example_modules() -raw_data <- reactive(teal:::example_cdisc_data()) +teal_data_rv <- reactive(teal:::example_cdisc_data()) app <- shinyApp( ui = function() { teal:::ui_teal("dummy") }, server = function(input, output, session) { - active_module <- teal:::srv_teal(id = "dummy", modules = mods, raw_data = raw_data) + active_module <- teal:::srv_teal(id = "dummy", modules = mods, teal_data_rv = teal_data_rv) } ) if (interactive()) { diff --git a/man/teal_data_module.Rd b/man/teal_data_module.Rd index e2fb4ea89a..ff3d6bd315 100644 --- a/man/teal_data_module.Rd +++ b/man/teal_data_module.Rd @@ -18,7 +18,7 @@ must return reactive expression containing \code{teal_data} object} Object of class \code{teal_data_module}. } \description{ -Create \code{shiny} module to supply or modify data in a \code{teal} application. +Creates \code{teal_data_module} object - a \code{shiny} module to supply or modify data in a \code{teal} application. } \details{ This function creates a \code{shiny} module that allows for running data pre-processing code after the app starts. @@ -39,13 +39,13 @@ data <- teal_data_module( moduleServer(id, function(input, output, session) { eventReactive(input$submit, { data <- within( - teal.data::teal_data(), + teal_data(), { dataset1 <- iris dataset2 <- mtcars } ) - teal.data::datanames(data) <- c("iris", "mtcars") + datanames(data) <- c("iris", "mtcars") data }) diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R index 506ebac833..0850a68aac 100644 --- a/tests/testthat/test-module_teal.R +++ b/tests/testthat/test-module_teal.R @@ -1,32 +1,32 @@ -testthat::test_that("srv_teal fails when raw_data is not reactive", { +testthat::test_that("srv_teal fails when teal_data_rv is not reactive", { testthat::expect_error( shiny::testServer( app = srv_teal, args = list( id = "test", - raw_data = teal_data(iris = iris), + teal_data_rv = teal_data(iris = iris), modules = modules(example_module()) ), expr = NULL ), - regexp = "is.reactive\\(raw_data\\)" + regexp = "is.reactive\\(teal_data_rv\\)" ) }) -testthat::test_that("srv_teal when raw_data changes, datasets_reactive is initialized as list of FilteredData", { +testthat::test_that("srv_teal when teal_data_rv changes, datasets_reactive is initialized as list of FilteredData", { data <- teal_data(iris1 = iris, mtcars1 = mtcars) shiny::testServer( app = srv_teal, args = list( id = "test", - raw_data = reactiveVal(NULL), + teal_data_rv = reactiveVal(NULL), modules = modules( example_module(label = "iris_tab"), example_module(label = "mtcars_tab") ) ), expr = { - raw_data(data) + teal_data_rv(data) checkmate::expect_list(datasets_reactive(), types = "FilteredData") } ) @@ -38,14 +38,14 @@ testthat::test_that("srv_teal initialized datasets_reactive (list) reflects modu app = srv_teal, args = list( id = "test", - raw_data = reactiveVal(data), + teal_data_rv = reactiveVal(data), modules = modules( example_module("iris_tab"), modules(label = "tab", example_module("iris_tab"), example_module("mtcars_tab")) ) ), expr = { - raw_data(data) + teal_data_rv(data) testthat::expect_named(datasets_reactive(), c("iris_tab", "tab")) testthat::expect_named(datasets_reactive()$tab, c("iris_tab", "mtcars_tab")) } @@ -58,7 +58,7 @@ testthat::test_that("srv_teal initialized data containing same FilteredData when app = srv_teal, args = list( id = "test", - raw_data = reactiveVal(data), + teal_data_rv = reactiveVal(data), modules = modules( example_module("iris_tab"), modules(label = "tab", example_module("iris_tab"), example_module("mtcars_tab")) @@ -66,7 +66,7 @@ testthat::test_that("srv_teal initialized data containing same FilteredData when filter = teal_slices(module_specific = FALSE) ), expr = { - raw_data(data) + teal_data_rv(data) unlisted_fd <- unlist(datasets_reactive(), use.names = FALSE) testthat::expect_identical(unlisted_fd[[1]], unlisted_fd[[2]]) testthat::expect_identical(unlisted_fd[[2]], unlisted_fd[[3]]) @@ -80,7 +80,7 @@ testthat::test_that("srv_teal initialized data containing different FilteredData app = srv_teal, args = list( id = "test", - raw_data = reactiveVal(data), + teal_data_rv = reactiveVal(data), modules = modules( example_module("iris_tab"), modules(label = "tab", example_module("iris_tab"), example_module("mtcars_tab")) @@ -88,7 +88,7 @@ testthat::test_that("srv_teal initialized data containing different FilteredData filter = teal_slices(module_specific = TRUE) ), expr = { - raw_data(data) + teal_data_rv(data) unlisted_fd <- unlist(datasets_reactive(), use.names = FALSE) testthat::expect_false(identical(unlisted_fd[[1]], unlisted_fd[[2]])) testthat::expect_false(identical(unlisted_fd[[2]], unlisted_fd[[3]])) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 24677bc0d8..f23a82946f 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -27,7 +27,7 @@ testthat::test_that("srv_teal_with_splash throws when teal_data_module doesn't r ) }) -testthat::test_that("srv_teal_with_splash raw_data evaluates the server of teal_data_module", { +testthat::test_that("srv_teal_with_splash teal_data_rv evaluates the server of teal_data_module", { shiny::testServer( app = srv_teal_with_splash, args = list( @@ -36,8 +36,8 @@ testthat::test_that("srv_teal_with_splash raw_data evaluates the server of teal_ modules = modules(example_module()) ), expr = { - testthat::expect_is(raw_data, "reactive") - testthat::expect_identical(raw_data(), "whatever") + testthat::expect_is(teal_data_rv, "reactive") + testthat::expect_identical(teal_data_rv(), "whatever") } ) }) @@ -51,8 +51,8 @@ testthat::test_that("srv_teal_with_splash passes teal_data to reactive", { modules = modules(example_module()) ), expr = { - testthat::expect_is(raw_data_checked, "reactive") - testthat::expect_s4_class(raw_data_checked(), "teal_data") + testthat::expect_is(teal_data_rv_validate, "reactive") + testthat::expect_s4_class(teal_data_rv_validate(), "teal_data") } ) }) @@ -66,12 +66,12 @@ testthat::test_that("srv_teal_with_splash throws when datanames are empty", { modules = modules(example_module()) ), expr = { - testthat::expect_error(raw_data_checked(), "Data has no datanames") + testthat::expect_error(teal_data_rv_validate(), "Data has no datanames") } ) }) -testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data_module returns error", { +testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws when teal_data_module returns error", { shiny::testServer( app = srv_teal_with_splash, args = list( @@ -83,13 +83,13 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data modules = modules(example_module()) ), expr = { - testthat::expect_is(raw_data_checked, "reactive") - testthat::expect_error(raw_data_checked(), "this error") + testthat::expect_is(teal_data_rv_validate, "reactive") + testthat::expect_error(teal_data_rv_validate(), "this error") } ) }) -testthat::test_that("srv_teal_with_splash raw_data_checked throws then qenv.error occurs", { +testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws then qenv.error occurs", { shiny::testServer( app = srv_teal_with_splash, args = list( @@ -101,13 +101,13 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws then qenv.erro modules = modules(example_module()) ), expr = { - testthat::expect_is(raw_data_checked, "reactive") - testthat::expect_error(raw_data_checked(), "not good") + testthat::expect_is(teal_data_rv_validate, "reactive") + testthat::expect_error(teal_data_rv_validate(), "not good") } ) }) -testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data_module doesn't return teal_data", { +testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws when teal_data_module doesn't return teal_data", { shiny::testServer( app = srv_teal_with_splash, args = list( @@ -119,8 +119,8 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when teal_data modules = modules(example_module()) ), expr = { - testthat::expect_is(raw_data_checked, "reactive") - testthat::expect_error(raw_data_checked(), "did not return `teal_data`") + testthat::expect_is(teal_data_rv_validate, "reactive") + testthat::expect_error(teal_data_rv_validate(), "did not return `teal_data`") } ) }) @@ -160,7 +160,7 @@ testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns ) }) -testthat::test_that("srv_teal_with_splash raw_data_checked throws when incompatible module's datanames", { +testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws when incompatible module's datanames", { shiny::testServer( app = srv_teal_with_splash, args = list( @@ -169,16 +169,16 @@ testthat::test_that("srv_teal_with_splash raw_data_checked throws when incompati modules = modules(example_module(datanames = "iris")) ), expr = { - testthat::expect_is(raw_data_checked, "reactive") + testthat::expect_is(teal_data_rv_validate, "reactive") testthat::expect_error( - raw_data_checked(), + teal_data_rv_validate(), "Module 'example teal module' uses datanames not available in 'data'" ) } ) }) -testthat::test_that("srv_teal_with_splash raw_data_checked returns teal_data if incompatible filter's datanames", { +testthat::test_that("srv_teal_with_splash teal_data_rv_validate returns teal_data if incompatible filter's datanames", { shiny::testServer( app = srv_teal_with_splash, args = list( @@ -188,8 +188,8 @@ testthat::test_that("srv_teal_with_splash raw_data_checked returns teal_data if filter = teal_slices(teal_slice(dataname = "iris", varname = "Species")) ), expr = { - testthat::expect_is(raw_data_checked, "reactive") - testthat::expect_s4_class(raw_data_checked(), "teal_data") + testthat::expect_is(teal_data_rv_validate, "reactive") + testthat::expect_s4_class(teal_data_rv_validate(), "teal_data") } ) }) From 2c928b2bd19cc3e28636f706e5f3d7927b442f33 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 13 Nov 2023 12:31:15 +0100 Subject: [PATCH 47/51] @ruckip review --- R/init.R | 7 ++++--- R/module_teal_with_splash.R | 8 ++++---- R/teal_data_module.R | 2 +- R/utils.R | 6 ++++++ man/teal_data_module.Rd | 2 +- vignettes/data-as-shiny-module.Rmd | 11 +++++------ 6 files changed, 21 insertions(+), 15 deletions(-) diff --git a/R/init.R b/R/init.R index 5cc722449d..8035815e7d 100644 --- a/R/init.R +++ b/R/init.R @@ -18,7 +18,7 @@ #' or `MultiAssayExperiment`, `teal_data`, `teal_data_module`)\cr #' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()], #' [teal.data::cdisc_dataset()], [teal.data::dataset()], [teal.data::dataset_connector()] or -#' [teal.data::cdisc_dataset_connector()] or [teal::teal_data_module()] or a single `data.frame` or +#' [teal.data::cdisc_dataset_connector()] or [teal_data_module()] or a single `data.frame` or #' a `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 @@ -143,8 +143,9 @@ init <- function(data, if (length(landing) > 1L) stop("Only one `landing_popup_module` can be used.") modules <- drop_module(modules, "teal_module_landing") - # Calculate app hash to ensure snapshot compatibility. - # See ?snapshot. Raw data must be extracted from environments. + # Calculate app id that will be used to stamp filter state snapshots. + # App id is a hash of the app's data and modules. + # See "transferring snapshots" section in ?snapshot. hashables <- mget(c("data", "modules")) hashables$data <- if (inherits(hashables$data, "teal_data")) { as.list(hashables$data@env) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 934b206e4e..4d0542eba9 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -130,7 +130,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { paste( "Error when executing `teal_data_module`:\n ", paste(data$message, collapse = "\n"), - "\n Check your inputs or contact app developer if error persists" + "\n Check your inputs or contact app developer if error persists." ) ) ) @@ -144,7 +144,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { paste0( "Error when executing `teal_data_module`:\n ", paste(data$message, collpase = "\n"), - "\n Check your inputs or contact app developer if error persists" + "\n Check your inputs or contact app developer if error persists." ) ) ) @@ -160,7 +160,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { ) ) - validate(need(teal.data::datanames(data), "Data has no datanames. Contact app developer")) + validate(need(teal.data::datanames(data), "Data has no datanames. Contact app developer.")) is_modules_ok <- check_modules_datanames(modules, teal.data::datanames(data)) @@ -169,7 +169,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { is_filter_ok <- check_filter_datanames(filter, teal.data::datanames(data)) if (!isTRUE(is_filter_ok)) { showNotification( - "Some filters were not applied because of incompatibility with data. Contact app developer", + "Some filters were not applied because of incompatibility with data. Contact app developer.", type = "warning", duration = 10 ) diff --git a/R/teal_data_module.R b/R/teal_data_module.R index b769535456..bec7d8bc15 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -6,7 +6,7 @@ #' The body of the server function will be run in the app rather than in the global environment. #' This means it will be run every time the app starts, so use sparingly. #' -#' Pass this module instead of a `teal_data` object in a call to `init`. +#' Pass this module instead of a `teal_data` object in a call to [init()]. #' #' See vignette "Data as shiny Module" for more details. #' diff --git a/R/utils.R b/R/utils.R index b10a0d4001..1da63cf8bf 100644 --- a/R/utils.R +++ b/R/utils.R @@ -152,6 +152,9 @@ resolve_modules_datanames <- function(modules, datanames, join_keys) { #' @return A `character(1)` containing error message or `TRUE` if validation passes. #' @keywords internal check_modules_datanames <- function(modules, datanames) { + checkmate::assert_class(modules, "teal_modules") + checkmate::assert_character(datanames) + recursive_check_datanames <- function(modules, datanames) { # check teal_modules against datanames if (inherits(modules, "teal_modules")) { @@ -187,6 +190,9 @@ check_modules_datanames <- function(modules, datanames) { #' @return A `character(1)` containing error message or TRUE if validation passes. #' @keywords internal check_filter_datanames <- function(filters, datanames) { + checkmate::assert_class(filters, "teal_slices") + checkmate::assert_character(datanames) + # check teal_slices against datanames out <- unlist(sapply( filters, function(filter) { diff --git a/man/teal_data_module.Rd b/man/teal_data_module.Rd index ff3d6bd315..ccdd0ddb52 100644 --- a/man/teal_data_module.Rd +++ b/man/teal_data_module.Rd @@ -25,7 +25,7 @@ This function creates a \code{shiny} module that allows for running data pre-pro The body of the server function will be run in the app rather than in the global environment. This means it will be run every time the app starts, so use sparingly. -Pass this module instead of a \code{teal_data} object in a call to \code{init}. +Pass this module instead of a \code{teal_data} object in a call to \code{\link[=init]{init()}}. See vignette "Data as shiny Module" for more details. } diff --git a/vignettes/data-as-shiny-module.Rmd b/vignettes/data-as-shiny-module.Rmd index 85a98878b9..66ae5cb9e1 100644 --- a/vignettes/data-as-shiny-module.Rmd +++ b/vignettes/data-as-shiny-module.Rmd @@ -29,7 +29,6 @@ The `teal_data_module` function is used to build such a module from the followin One case for postponing data operations are data sets that are dynamic, frequently updated. Such data cannot be created once and kept in the global environment. Using `teal_data_module` allows to create a data set from scratch every time the user starts the application. -This the user will always have access to the most recent version of the data. ```{r, message = FALSE, warning = FALSE} library(teal) @@ -43,13 +42,13 @@ data_mod <- teal_data_module( moduleServer(id, function(input, output, session) { reactive({ data <- within( - teal.data::teal_data(), + teal_data(), { dataset1 <- iris dataset2 <- mtcars } ) - teal.data::datanames(data) <- c("dataset1", "dataset2") + datanames(data) <- c("dataset1", "dataset2") data }) }) @@ -59,7 +58,7 @@ data_mod <- teal_data_module( app <- init( data = data_mod, - module = list(example_module()) + module = example_module() ) if (interactive()) { @@ -80,7 +79,7 @@ data <- within(teal_data(), { dataset1 <- iris dataset2 <- mtcars }) -teal.data::datanames(data) <- c("dataset1", "dataset2") +datanames(data) <- c("dataset1", "dataset2") data_mod <- teal_data_module( ui = function(id) { @@ -108,7 +107,7 @@ data_mod <- teal_data_module( app <- init( data = data_mod, - module = list(example_module()) + module = example_module() ) if (interactive()) { From 54f05bae1efa417cd84d29be09caff8f9b04c2dc Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 13 Nov 2023 12:57:16 +0100 Subject: [PATCH 48/51] update snapshot manager documentation --- R/module_snapshot_manager.R | 3 ++- man/snapshot_manager_module.Rd | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index a337e5f5ce..da49dd842e 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -59,7 +59,8 @@ #' which is disassembled for storage and used directly for restoring app state. #' #' @section Transferring snapshots: -#' Snapshots uploaded from disk should only be used in the same application they come from. +#' Snapshots uploaded from disk should only be used in the same application they come from, +#' _i.e._ an application that uses the same data and the same modules. #' To ensure this is the case, `init` stamps `teal_slices` with an app id that is stored in the `app_id` attribute of #' a `teal_slices` object. When a snapshot is restored from file, its `app_id` is compared to that #' of the current app state and only if the match is the snapshot admitted to the session. diff --git a/man/snapshot_manager_module.Rd b/man/snapshot_manager_module.Rd index af51d469be..66e5b8a94d 100644 --- a/man/snapshot_manager_module.Rd +++ b/man/snapshot_manager_module.Rd @@ -93,7 +93,8 @@ which is disassembled for storage and used directly for restoring app state. \section{Transferring snapshots}{ -Snapshots uploaded from disk should only be used in the same application they come from. +Snapshots uploaded from disk should only be used in the same application they come from, +\emph{i.e.} an application that uses the same data and the same modules. To ensure this is the case, \code{init} stamps \code{teal_slices} with an app id that is stored in the \code{app_id} attribute of a \code{teal_slices} object. When a snapshot is restored from file, its \code{app_id} is compared to that of the current app state and only if the match is the snapshot admitted to the session. From 0b12f7b842f7ec068f20840037ebf038fa8c831a Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 13 Nov 2023 13:00:57 +0100 Subject: [PATCH 49/51] link to the vignette --- R/teal_data_module.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/teal_data_module.R b/R/teal_data_module.R index bec7d8bc15..5f63395fca 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -8,7 +8,7 @@ #' #' Pass this module instead of a `teal_data` object in a call to [init()]. #' -#' See vignette "Data as shiny Module" for more details. +#' See vignette \code{vignette("data-as-shiny-module", package = "teal")} for more details. #' #' @param ui (`function(id)`)\cr #' `shiny` module `ui` function; must only take `id` argument From f00e1811a95021e77fd8a7defa5e670824e3a448 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 13 Nov 2023 13:04:36 +0100 Subject: [PATCH 50/51] adding link to vignette and fix error message --- R/module_teal_with_splash.R | 2 +- man/teal_data_module.Rd | 2 +- tests/testthat/test-module_teal_with_splash.R | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 4d0542eba9..f1e933cf19 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -110,7 +110,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { } if (!is.reactive(teal_data_rv)) { - stop("The `teal_data_module` must return a reactive expression containing a `teal_data` object.", call. = FALSE) + stop("The `teal_data_module` must return a reactive expression.", call. = FALSE) } teal_data_rv_validate <- reactive({ diff --git a/man/teal_data_module.Rd b/man/teal_data_module.Rd index ccdd0ddb52..3eb672bcda 100644 --- a/man/teal_data_module.Rd +++ b/man/teal_data_module.Rd @@ -27,7 +27,7 @@ This means it will be run every time the app starts, so use sparingly. Pass this module instead of a \code{teal_data} object in a call to \code{\link[=init]{init()}}. -See vignette "Data as shiny Module" for more details. +See vignette \code{vignette("data-as-shiny-module", package = "teal")} for more details. } \examples{ data <- teal_data_module( diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index f23a82946f..cf8cd1ee23 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -23,7 +23,7 @@ testthat::test_that("srv_teal_with_splash throws when teal_data_module doesn't r ), expr = {} ), - "The `teal_data_module` must return a reactive expression containing a `teal_data` object." + "The `teal_data_module` must return a reactive expression." ) }) From 019f26c7a934b207b3ff0622275029d828969d38 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 13 Nov 2023 13:28:30 +0100 Subject: [PATCH 51/51] lintr --- tests/testthat/test-module_teal_with_splash.R | 35 ++++++++++--------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index cf8cd1ee23..577e997582 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -107,23 +107,26 @@ testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws then qenv ) }) -testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws when teal_data_module doesn't return teal_data", { - shiny::testServer( - app = srv_teal_with_splash, - args = list( - id = "test", - data = teal_data_module( - ui = function(id) div(), - server = function(id) reactive(data.frame()) +testthat::test_that( + "srv_teal_with_splash teal_data_rv_validate throws when teal_data_module doesn't return teal_data", + { + shiny::testServer( + app = srv_teal_with_splash, + args = list( + id = "test", + data = teal_data_module( + ui = function(id) div(), + server = function(id) reactive(data.frame()) + ), + modules = modules(example_module()) ), - modules = modules(example_module()) - ), - expr = { - testthat::expect_is(teal_data_rv_validate, "reactive") - testthat::expect_error(teal_data_rv_validate(), "did not return `teal_data`") - } - ) -}) + expr = { + testthat::expect_is(teal_data_rv_validate, "reactive") + testthat::expect_error(teal_data_rv_validate(), "did not return `teal_data`") + } + ) + } +) testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns NULL before loading", {