diff --git a/DESCRIPTION b/DESCRIPTION index c752098756..5df0002752 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -55,7 +55,7 @@ Imports: stats, teal.code (>= 0.7.0), teal.logger (>= 0.4.0), - teal.reporter (>= 0.5.0), + teal.reporter (>= 0.5.0.9001), teal.widgets (>= 0.5.0), tools, utils @@ -79,6 +79,8 @@ VignetteBuilder: rmarkdown RdMacros: lifecycle +Remotes: + insightsengineering/teal.reporter@main Config/Needs/verdepcheck: rstudio/shiny, insightsengineering/teal.data, insightsengineering/teal.slice, mllg/checkmate, jeroen/jsonlite, r-lib/lifecycle, daroczig/logger, r-lib/mirai, r-lib/cli, @@ -95,9 +97,10 @@ Encoding: UTF-8 Language: en-US LazyData: true Roxygen: list(markdown = TRUE, packages = c("roxy.shinylive")) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 Collate: 'TealAppDriver.R' + 'after.R' 'checkmate.R' 'dummy_functions.R' 'include_css_js.R' diff --git a/NAMESPACE b/NAMESPACE index a9563f1a8d..837845c8bd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,9 +15,11 @@ S3method(print,teal_modules) S3method(within,teal_data_module) export(TealReportCard) export(add_landing_modal) +export(after) export(as.teal_slices) export(as_tdata) export(build_app_title) +export(disable_report) export(example_module) export(get_code_tdata) export(get_metadata) @@ -56,6 +58,7 @@ export(validate_one_row_per_id) import(shiny) import(teal.data) import(teal.slice) +importFrom(methods,as) importFrom(methods,new) importFrom(methods,setMethod) importFrom(shiny,reactiveVal) diff --git a/NEWS.md b/NEWS.md index ca07dd47e0..aca8a2ea9c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # teal 1.0.0.9002 +### New features + +* `init` and `srv_teal` have new `reporter` parameter, that allows to pre-define `teal.reporter::Reporter` object to be +used for storing the content of the report. You can also globally disable reporting by setting `reporter = NULL` +(and `disable = TRUE` in `ui_teal` for cases when `ui_teal` is used as shiny module). + # teal 1.0.0 ### Breaking changes diff --git a/R/after.R b/R/after.R new file mode 100644 index 0000000000..0a9b20d511 --- /dev/null +++ b/R/after.R @@ -0,0 +1,91 @@ +#' Executes modifications to the result of a module +#' +#' Primarily used to modify the output object of module to change the containing +#' report. +#' @param x (`teal_module`) +#' @param ui (`function(id, elem, ...)`) function to receive output (`shiny.tag`) from `x$ui` +#' @param server (`function(input, output, session, data, ...)`) function to receive output data from `x$server` +#' @param ... additional argument passed to `ui` and `server` by matching their formals names. +#' @return A `teal_report` object with the result of the server function. +#' @export +after <- function(x, + ui = function(id, elem) elem, + server = function(input, output, session, data) data, + ...) { + # todo: make a method for teal_app and remove teal_extend_server? + checkmate::assert_multi_class(x, "teal_module") + if (!is.function(ui) || !all(names(formals(ui)) %in% c("id", "elem"))) { + stop("ui should be a function of id and elem") + } + if (!is.function(server) || !all(names(formals(server)) %in% c("input", "output", "session", "data"))) { + stop("server should be a function of `input` and `output`, `session`, `data`") + } + + additional_args <- list(...) + new_x <- x # because overwriting x$ui/server will cause infinite recursion + new_x$ui <- .after_ui(x$ui, ui, additional_args) + new_x$server <- .after_server(x$server, server, additional_args) + new_x +} + +.after_ui <- function(x, y, additional_args) { + # add `_`-prefix to make sure objects are not masked in the wrapper functions + `_x` <- x # nolint: object_name. + `_y` <- y # nolint: object_name. + new_x <- function(id, ...) { + original_args <- as.list(environment()) + if ("..." %in% names(formals(`_x`))) { + original_args <- c(original_args, list(...)) + } + ns <- NS(id) + original_args$id <- ns("wrapped") + original_out <- do.call(`_x`, original_args, quote = TRUE) + + wrapper_args <- c( + additional_args, + list(id = ns("wrapper"), elem = original_out) + ) + do.call(`_y`, args = wrapper_args[names(formals(`_y`))]) + } + formals(new_x) <- formals(x) + new_x +} + +.after_server <- function(x, y, additional_args) { + # add `_`-prefix to make sure objects are not masked in the wrapper functions + `_x` <- x # nolint: object_name. + `_y` <- y # nolint: object_name. + new_x <- function(id, ...) { + original_args <- as.list(environment()) + original_args$id <- "wrapped" + if ("..." %in% names(formals(`_x`))) { + original_args <- c(original_args, list(...)) + } + moduleServer(id, function(input, output, session) { + original_out <- if (all(c("input", "output", "session") %in% names(formals(`_x`)))) { + original_args$module <- `_x` + do.call(shiny::callModule, args = original_args) + } else { + do.call(`_x`, original_args) + } + original_out_r <- reactive( + if (is.reactive(original_out)) { + original_out() + } else { + original_out + } + ) + wrapper_args <- utils::modifyList( + additional_args, + list(id = "wrapper", input = input, output = output, session = session) + ) + reactive({ + req(original_out_r()) + wrapper_args$data <- original_out() + do.call(`_y`, wrapper_args[names(formals(`_y`))], quote = TRUE) + }) + }) + } + formals(new_x) <- formals(x) + new_x +} diff --git a/R/init.R b/R/init.R index 4333532b6e..6a06582ca1 100644 --- a/R/init.R +++ b/R/init.R @@ -34,6 +34,7 @@ #' a string specifying the `shiny` module id in cases it is used as a `shiny` module #' rather than a standalone `shiny` app. #' This parameter is no longer supported. Use [ui_teal()] and [srv_teal()] instead. +#' @param reporter (`Reporter`) object used to store report contents. Set to `NULL` to globally disable reporting. #' #' @return Named list containing server and UI functions. #' @@ -99,7 +100,8 @@ init <- function(data, title = lifecycle::deprecated(), header = lifecycle::deprecated(), footer = lifecycle::deprecated(), - id = lifecycle::deprecated()) { + id = lifecycle::deprecated(), + reporter = teal.reporter::Reporter$new()) { logger::log_debug("init initializing teal app with: data ('{ class(data) }').") # argument checking (independent) @@ -183,7 +185,6 @@ init <- function(data, landing <- extract_module(modules, "teal_module_landing") modules <- drop_module(modules, "teal_module_landing") - if (lifecycle::is_present(id)) { lifecycle::deprecate_soft( when = "0.16.0", @@ -235,7 +236,13 @@ init <- function(data, ) }, server = function(input, output, session) { - srv_teal(id = "teal", data = data, modules = modules, filter = deep_copy_filter(filter)) + srv_teal( + id = "teal", + data = data, + modules = modules, + filter = deep_copy_filter(filter), + reporter = if (!is.null(reporter)) reporter$clone(deep = TRUE) + ) srv_session_info("teal-footer-session_info") } ), diff --git a/R/module_init_data.R b/R/module_init_data.R index 2567bbc981..8808acb9fe 100644 --- a/R/module_init_data.R +++ b/R/module_init_data.R @@ -90,15 +90,31 @@ srv_init_data <- function(id, data) { #' @keywords internal .add_signature_to_data <- function(data) { hashes <- .get_hashes_code(data) + data_teal_report <- as(data, "teal_report") + if (!inherits(data, "teal_report")) { + teal.reporter::teal_card(data_teal_report) <- c( + teal.reporter::teal_card(), + "## Code preparation", + teal.reporter::teal_card(data_teal_report) + ) + } tdata <- do.call( - teal.data::teal_data, + teal.reporter::teal_report, c( - list(code = trimws(c(teal.code::get_code(data), hashes), which = "right")), - list(join_keys = teal.data::join_keys(data)), - as.list(data, all.names = TRUE) + list( + code = trimws(c(teal.code::get_code(data_teal_report), hashes), which = "right"), + join_keys = teal.data::join_keys(data_teal_report), + teal_card = teal.reporter::teal_card(data_teal_report) + ), + sapply( + names(data_teal_report), + base::get, + envir = data_teal_report, + simplify = FALSE + ) ) ) - tdata@verified <- data@verified + tdata@verified <- data_teal_report@verified tdata } diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 9dfaa1adfd..f81d250c49 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -225,6 +225,7 @@ srv_teal_module <- function(id, tab_pane <- div( id = container_id, class = c("tab-pane", "teal_module", if (identical(module_id, active_module_id)) "active"), + ui_add_reporter(ns("add_reporter_wrapper")), tagList( .modules_breadcrumb(modules), if (!is.null(modules$datanames)) { @@ -335,7 +336,7 @@ srv_teal_module <- function(id, checkmate::assert_multi_class(modules, c("teal_modules", "teal_module")) assert_reactive(datasets, null.ok = TRUE) checkmate::assert_class(slices_global, ".slicesGlobal") - checkmate::assert_class(reporter, "Reporter") + checkmate::assert_class(reporter, "Reporter", null.ok = TRUE) assert_reactive(data_load_status) UseMethod(".srv_teal_module", modules) } @@ -489,21 +490,16 @@ srv_teal_module <- function(id, }) # Call modules. - if (!inherits(modules, "teal_module_previewer")) { - obs_module <- .call_once_when( - !is.null(module_teal_data()), - ignoreNULL = TRUE, - handlerExpr = { - module_out(.call_teal_module(modules, datasets, module_teal_data, reporter)) - } - ) - } else { - # Report previewer must be initiated on app start for report cards to be included in bookmarks. - # When previewer is delayed, cards are bookmarked only if previewer has been initiated (visited). - module_out(.call_teal_module(modules, datasets, module_teal_data, reporter)) - } + obs_module <- .call_once_when( + !is.null(module_teal_data()), + ignoreNULL = TRUE, + handlerExpr = { + out <- .call_teal_module(modules, datasets, module_teal_data, reporter) + srv_add_reporter("add_reporter_wrapper", out, reporter) + module_out(out) + } + ) }) - module_out }) } @@ -514,7 +510,7 @@ srv_teal_module <- function(id, # collect arguments to run teal_module args <- c(list(id = "module"), modules$server_args) - if (is_arg_used(modules$server, "reporter")) { + if (is_arg_used(modules$server, "reporter") && !is.null(reporter)) { args <- c(args, list(reporter = reporter)) } diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index 08c8ee0866..340c4fb909 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -183,6 +183,12 @@ srv_snapshot_manager <- function(id, slices_global) { modalDialog( easyClose = TRUE, textInput(ns("snapshot_name"), "Name the snapshot", width = "100%", placeholder = "Meaningful, unique name"), + tags$script( + shiny::HTML( + sprintf("shinyjs.autoFocusModal('%s');", ns("snapshot_name")), + sprintf("shinyjs.enterToSubmit('%s', '%s');", ns("snapshot_name"), ns("snapshot_name_accept")) + ) + ), footer = shiny::div( shiny::tags$button( type = "button", diff --git a/R/module_teal.R b/R/module_teal.R index 57bf19cbb3..90a1b9a0ad 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -53,8 +53,9 @@ ui_teal <- function(id, modules) { mod <- extract_module(modules, class = "teal_module_previewer") reporter_opts <- if (length(mod)) .get_reporter_options(mod[[1]]$server_args) modules <- drop_module(modules, "teal_module_landing") - modules <- drop_module(modules, "teal_module_previewer") + # show busy icon when `shiny` session is busy computing stuff + # based on https://stackoverflow.com/questions/17325521/r-shiny-display-loading-message-while-function-is-running/22475216#22475216 # nolint: line_length. shiny_busy_message_panel <- conditionalPanel( condition = "(($('html').hasClass('shiny-busy')) && (document.getElementById('shiny-notification-panel') == null))", # nolint: line_length. tags$div( @@ -108,6 +109,7 @@ ui_teal <- function(id, modules) { theme = get_teal_bs_theme(), include_teal_css_js(), shinyjs::useShinyjs(), + shiny::includeScript(system.file("js/extendShinyJs.js", package = "teal.reporter")), shiny_busy_message_panel, tags$div(id = ns("tabpanel_wrapper"), class = "teal-body", navbar), tags$hr(style = "margin: 1rem 0 0.5rem 0;") @@ -116,14 +118,13 @@ ui_teal <- function(id, modules) { #' @rdname module_teal #' @export -srv_teal <- function(id, data, modules, filter = teal_slices()) { +srv_teal <- function(id, data, modules, filter = teal_slices(), reporter = teal.reporter::Reporter$new()) { checkmate::assert_character(id, max.len = 1, any.missing = FALSE) checkmate::assert_multi_class(data, c("teal_data", "teal_data_module", "reactive")) checkmate::assert_class(modules, "teal_modules") checkmate::assert_class(filter, "teal_slices") modules <- drop_module(modules, "teal_module_landing") - modules <- drop_module(modules, "teal_module_previewer") moduleServer(id, function(input, output, session) { logger::log_debug("srv_teal initializing.") @@ -159,7 +160,6 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { srv_check_module_datanames("datanames_warning", data_handled, modules) data_validated <- .trigger_on_success(data_handled) - data_signatured <- reactive({ req(inherits(data_validated(), "teal_data")) is_filter_ok <- check_filter_datanames(filter, names(data_validated())) @@ -239,17 +239,16 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { ui = tags$div(validate_ui) ) } - - if (is_arg_used(modules, "reporter")) { + if (!is.null(reporter)) { shinyjs::show("reporter_menu_container") + reporter$set_id(attr(filter, "app_id")) + teal.reporter::preview_report_button_srv("preview_report", reporter) + teal.reporter::report_load_srv("load_report", reporter) + teal.reporter::download_report_button_srv(id = "download_report", reporter = reporter) + teal.reporter::reset_report_button_srv("reset_reports", reporter) } else { removeUI(selector = sprintf("#%s", session$ns("reporter_menu_container"))) } - reporter <- teal.reporter::Reporter$new()$set_id(attr(filter, "app_id")) - teal.reporter::preview_report_button_srv("preview_report", reporter) - teal.reporter::report_load_srv("load_report", reporter) - teal.reporter::download_report_button_srv(id = "download_report", reporter = reporter) - teal.reporter::reset_report_button_srv("reset_reports", reporter) datasets_rv <- if (!isTRUE(attr(filter, "module_specific"))) { eventReactive(data_signatured(), { diff --git a/R/teal_data_module-eval_code.R b/R/teal_data_module-eval_code.R index 1491989b40..335f5525a2 100644 --- a/R/teal_data_module-eval_code.R +++ b/R/teal_data_module-eval_code.R @@ -18,14 +18,13 @@ setOldClass("teal_data_module") #' @include teal_data_module.R #' @name eval_code #' @rdname teal_data_module -#' @aliases eval_code,teal_data_module,character-method -#' @aliases eval_code,teal_data_module,language-method -#' @aliases eval_code,teal_data_module,expression-method +#' @aliases eval_code,teal_data_module +#' @aliases \S4method{eval_code}{teal_data_module} #' #' @importFrom methods setMethod #' @importMethodsFrom teal.code eval_code #' -setMethod("eval_code", signature = c("teal_data_module", "character"), function(object, code) { +setMethod("eval_code", signature = c(object = "teal_data_module"), function(object, code) { teal_data_module( ui = function(id) { ns <- NS(id) @@ -50,11 +49,3 @@ setMethod("eval_code", signature = c("teal_data_module", "character"), function( once = attr(object, "once") ) }) - -setMethod("eval_code", signature = c("teal_data_module", "language"), function(object, code) { - eval_code(object, code = paste(lang2calls(code), collapse = "\n")) -}) - -setMethod("eval_code", signature = c("teal_data_module", "expression"), function(object, code) { - eval_code(object, code = paste(lang2calls(code), collapse = "\n")) -}) diff --git a/R/teal_data_utils.R b/R/teal_data_utils.R index 2b5b51c8b6..eaaecfb071 100644 --- a/R/teal_data_utils.R +++ b/R/teal_data_utils.R @@ -19,8 +19,15 @@ NULL #' @rdname teal_data_utilities .append_evaluated_code <- function(data, code) { checkmate::assert_class(data, "teal_data") - data@code <- c(data@code, code2list(code)) - methods::validObject(data) + if (length(code) && !identical(code, "")) { + data@code <- c(data@code, code2list(code)) + teal.reporter::teal_card(data) <- c( + teal.reporter::teal_card(data), + "## Data filtering", + teal.reporter::code_chunk(code) + ) + methods::validObject(data) + } data } @@ -33,3 +40,31 @@ NULL data@.xData <- new_env data } + +#' @rdname teal_data_utilities +.collapse_subsequent_chunks <- function(report) { + Reduce( + function(x, this) { + l <- length(x) + if ( + l && + inherits(x[[l]], "code_chunk") && + inherits(this, "code_chunk") && + identical(attr(x[[l]], "params"), attr(this, "params")) + ) { + x[[length(x)]] <- do.call( + teal.reporter::code_chunk, + args = c( + list(code = paste(x[[l]], this, sep = "\n")), + attr(x[[l]], "params") + ) + ) + x + } else { + c(x, this) + } + }, + init = teal.reporter::teal_card(), + x = report + ) +} diff --git a/R/teal_reporter.R b/R/teal_reporter.R index 48fd5dd71d..30e18400ce 100644 --- a/R/teal_reporter.R +++ b/R/teal_reporter.R @@ -5,6 +5,7 @@ #' the source code, the encodings panel content and the filter panel content as part of the #' meta data. #' @export +#' @importFrom methods as #' TealReportCard <- R6::R6Class( # nolint: object_name. classname = "TealReportCard", @@ -20,16 +21,9 @@ TealReportCard <- R6::R6Class( # nolint: object_name. #' card <- TealReportCard$new()$append_src( #' "plot(iris)" #' ) - #' card$get_content()[[1]]$get_content() + #' card$get_content()[[1]] append_src = function(src, ...) { - checkmate::assert_character(src, min.len = 0, max.len = 1) - params <- list(...) - params$eval <- FALSE - rblock <- RcodeBlock$new(src) - rblock$set_params(params) - self$append_content(rblock) - self$append_metadata("SRC", src) - invisible(self) + super$append_rcode(text = src, ...) }, #' @description Appends the filter state list to the `content` and `metadata` of this `TealReportCard`. #' If the filter state list has an attribute named `formatted`, it appends it to the card otherwise it uses @@ -40,11 +34,8 @@ TealReportCard <- R6::R6Class( # nolint: object_name. #' @return `self`, invisibly. append_fs = function(fs) { checkmate::assert_class(fs, "teal_slices") - self$append_text("Filter State", "header3") - if (length(fs)) { - self$append_content(TealSlicesBlock$new(fs)) - } else { - self$append_text("No filters specified.") + if (length(fs) > 0) { + self$append_content(teal.reporter::code_chunk(.teal_slice_to_yaml(fs), eval = FALSE, lang = "verbatim")) } invisible(self) }, @@ -54,7 +45,7 @@ TealReportCard <- R6::R6Class( # nolint: object_name. #' @return `self`, invisibly. #' @examples #' card <- TealReportCard$new()$append_encodings(list(variable1 = "X")) - #' card$get_content()[[1]]$get_content() + #' card$get_content()[[1]] #' append_encodings = function(encodings) { checkmate::assert_list(encodings) @@ -71,126 +62,112 @@ TealReportCard <- R6::R6Class( # nolint: object_name. self$append_metadata("Encodings", encodings) invisible(self) } - ), - private = list( - dispatch_block = function(block_class) { - if (exists(block_class, getNamespace("teal"))) { - # for block classes which are in teal (TealSlicesBlock) - get(block_class) - } else { - # other block classes are in teal.reporter so we need to use super (ReporterCard) class - super$dispatch_block(block_class) - } - } ) ) -#' @title `TealSlicesBlock` -#' @docType class -#' @description -#' Specialized `TealSlicesBlock` block for managing filter panel content in reports. -#' @keywords internal -TealSlicesBlock <- R6::R6Class( # nolint: object_name_linter. - classname = "TealSlicesBlock", - inherit = teal.reporter:::TextBlock, - public = list( - #' @description Returns a `TealSlicesBlock` object. - #' - #' @details Returns a `TealSlicesBlock` object with no content and no parameters. - #' - #' @param content (`teal_slices`) object returned from [teal_slices()] function. - #' @param style (`character(1)`) string specifying style to apply. - #' - #' @return Object of class `TealSlicesBlock`, invisibly. - #' - initialize = function(content = teal_slices(), style = "verbatim") { - self$set_content(content) - self$set_style(style) - invisible(self) - }, +.teal_slice_to_yaml <- function(fs) { + checkmate::assert_class(fs, "teal_slices") + states_list <- lapply(fs, function(x) { + x_list <- shiny::isolate(as.list(x)) + if ( + inherits(x_list$choices, c("integer", "numeric", "Date", "POSIXct", "POSIXlt")) && + length(x_list$choices) == 2 && + length(x_list$selected) == 2 + ) { + x_list$range <- paste(x_list$selected, collapse = " - ") + x_list["selected"] <- NULL + } + if (!is.null(x_list$arg)) { + x_list$arg <- if (x_list$arg == "subset") "Genes" else "Samples" + } - #' @description Sets content of this `TealSlicesBlock`. - #' Sets content as `YAML` text which represents a list generated from `teal_slices`. - #' The list displays limited number of fields from `teal_slice` objects, but this list is - #' sufficient to conclude which filters were applied. - #' When `selected` field in `teal_slice` object is a range, then it is displayed as a "min" - #' - #' - #' @param content (`teal_slices`) object returned from [teal_slices()] function. - #' @return `self`, invisibly. - set_content = function(content) { - checkmate::assert_class(content, "teal_slices") - if (length(content) != 0) { - states_list <- lapply(content, function(x) { - x_list <- shiny::isolate(as.list(x)) - if ( - inherits(x_list$choices, c("integer", "numeric", "Date", "POSIXct", "POSIXlt")) && - length(x_list$choices) == 2 && - length(x_list$selected) == 2 - ) { - x_list$range <- paste(x_list$selected, collapse = " - ") - x_list["selected"] <- NULL - } - if (!is.null(x_list$arg)) { - x_list$arg <- if (x_list$arg == "subset") "Genes" else "Samples" - } + x_list <- x_list[ + c("dataname", "varname", "experiment", "arg", "expr", "selected", "range", "keep_na", "keep_inf") + ] + names(x_list) <- c( + "Dataset name", "Variable name", "Experiment", "Filtering by", "Applied expression", + "Selected Values", "Selected range", "Include NA values", "Include Inf values" + ) - x_list <- x_list[ - c("dataname", "varname", "experiment", "arg", "expr", "selected", "range", "keep_na", "keep_inf") - ] - names(x_list) <- c( - "Dataset name", "Variable name", "Experiment", "Filtering by", "Applied expression", - "Selected Values", "Selected range", "Include NA values", "Include Inf values" - ) + Filter(Negate(is.null), x_list) + }) - Filter(Negate(is.null), x_list) - }) + if (requireNamespace("yaml", quietly = TRUE)) { + yaml::as.yaml(states_list) + } else { + stop("yaml package is required to format the filter state list") + } +} - if (requireNamespace("yaml", quietly = TRUE)) { - super$set_content(yaml::as.yaml(states_list)) - } else { - stop("yaml package is required to format the filter state list") - } +#' @noRd +ui_add_reporter <- function(id) uiOutput(NS(id, "reporter_add_container")) + +#' @noRd +srv_add_reporter <- function(id, module_out, reporter) { + if (is.null(reporter)) { + return(FALSE) + } # early exit + moduleServer(id, function(input, output, session) { + mod_out_r <- reactive({ + req(module_out) + if (is.reactive(module_out)) { + module_out() } - private$teal_slices <- content - invisible(self) - }, - #' @description Create the `TealSlicesBlock` from a list. - #' - #' @param x (`named list`) with two fields `text` and `style`. - #' Use the `get_available_styles` method to get all possible styles. - #' - #' @return `self`, invisibly. - #' @examples - #' TealSlicesBlock <- getFromNamespace("TealSlicesBlock", "teal") - #' block <- TealSlicesBlock$new() - #' block$from_list(list(text = "sth", style = "default")) - #' - from_list = function(x) { - checkmate::assert_list(x) - checkmate::assert_names(names(x), must.include = c("text", "style")) - super$set_content(x$text) - super$set_style(x$style) - invisible(self) - }, - #' @description Convert the `TealSlicesBlock` to a list. - #' - #' @return `named list` with a text and style. - #' @examples - #' TealSlicesBlock <- getFromNamespace("TealSlicesBlock", "teal") - #' block <- TealSlicesBlock$new() - #' block$to_list() - #' - to_list = function() { - content <- self$get_content() - list( - text = if (length(content)) content else "", - style = self$get_style() - ) - } - ), - private = list( - style = "verbatim", - teal_slices = NULL # teal_slices - ) -) + }) + + doc_out <- reactive({ + req(mod_out_r()) + teal_data_handled <- tryCatch(mod_out_r(), error = function(e) e) + tcard <- if (inherits(teal_data_handled, "teal_report")) { + teal.reporter::teal_card(teal_data_handled) + } else if (inherits(teal_data_handled, "teal_data")) { + teal.reporter::teal_card(as(teal_data_handled, "teal_report")) + } else if (inherits(teal_data_handled, "teal_card")) { + teal_data_handled + } + + if (length(tcard)) .collapse_subsequent_chunks(tcard) + }) + + .call_once_when(!is.null(doc_out()) && !is.null(reporter), { + output$reporter_add_container <- renderUI({ + tags$div( + class = "teal add-reporter-container", + teal.reporter::add_card_button_ui(session$ns("reporter_add"), label = "Add to Report") + ) + }) + teal.reporter::add_card_button_srv("reporter_add", reporter = reporter, card_fun = doc_out) + }) + + + + observeEvent(doc_out(), ignoreNULL = FALSE, { + shinyjs::toggleState("reporter_add_container", condition = inherits(doc_out(), "teal_card")) + }) + }) +} + +#' Disable the report for a `teal_module` +#' +#' Convenience function that disables the user's ability to add the module +#' to the report previewer. +#' @param x (`teal_module`) a `teal_module` object. +#' @return `NULL` that indicates that it should disable the reporter functionality. +#' @export +#' @examples +#' app <- init( +#' data = within(teal_data(), iris <- iris), +#' modules = modules( +#' example_module(label = "example teal module") |> disable_report() +#' ) +#' ) +#' if (interactive()) { +#' shinyApp(app$ui, app$server) +#' } +disable_report <- function(x) { + checkmate::assert_class(x, "teal_module") + after(x, server = function(data) { + teal.reporter::teal_card(data) <- teal.reporter::teal_card() + NULL + }) +} diff --git a/R/zzz.R b/R/zzz.R index 8fbc9539a8..ba69dc6bac 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -34,8 +34,6 @@ setdiff_teal_slices <- getFromNamespace("setdiff_teal_slices", "teal.slice") # This one is here because it is needed by c.teal_slices but we don't want it exported from teal.slice. coalesce_r <- getFromNamespace("coalesce_r", "teal.slice") -# all *Block objects are private in teal.reporter -RcodeBlock <- getFromNamespace("RcodeBlock", "teal.reporter") # nolint: object_name. # Use non-exported function(s) from teal.code # This one is here because lang2calls should not be exported from teal.code diff --git a/_pkgdown.yml b/_pkgdown.yml index 468399619f..2da82e27d9 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -130,6 +130,8 @@ reference: - reporter_previewer_module - TealReportCard - report_card_template + - disable_report + - after - title: Landing popup contents: - landing_popup_module diff --git a/inst/css/custom.css b/inst/css/custom.css index c292fc7f37..715261faf2 100644 --- a/inst/css/custom.css +++ b/inst/css/custom.css @@ -133,3 +133,9 @@ body > div:has(~ #shiny-modal-wrapper .blur_background) { .teal.primary-button:not(.disabled):hover { background: var(--bs-primary-bg-subtle); } + +.teal.add-reporter-container { + display: flex; + justify-content: flex-end; + padding: 10px; +} diff --git a/inst/js/extendShinyJs.js b/inst/js/extendShinyJs.js new file mode 100644 index 0000000000..0c1f9f91f1 --- /dev/null +++ b/inst/js/extendShinyJs.js @@ -0,0 +1,22 @@ +// This file contains functions that should be executed at the start of each session, +// not included in the original HTML + +shinyjs.autoFocusModal = function(id) { + document.getElementById('shiny-modal').addEventListener( + 'shown.bs.modal', + () => document.getElementById(id).focus(), + { once: true } + ); +} + +shinyjs.enterToSubmit = function(id, submit_id) { + document.getElementById('shiny-modal').addEventListener( + 'shown.bs.modal', + () => document.getElementById(id).addEventListener('keyup', (e) => { + if (e.key === 'Enter') { + e.preventDefault(); // prevent form submission + document.getElementById(submit_id).click(); + } + }) + ); +} diff --git a/man/TealReportCard.Rd b/man/TealReportCard.Rd index 061dbb73ba..888fc3e89a 100644 --- a/man/TealReportCard.Rd +++ b/man/TealReportCard.Rd @@ -19,14 +19,14 @@ meta data. card <- TealReportCard$new()$append_src( "plot(iris)" ) -card$get_content()[[1]]$get_content() +card$get_content()[[1]] ## ------------------------------------------------ ## Method `TealReportCard$append_encodings` ## ------------------------------------------------ card <- TealReportCard$new()$append_encodings(list(variable1 = "X")) -card$get_content()[[1]]$get_content() +card$get_content()[[1]] } \section{Super class}{ @@ -57,6 +57,7 @@ card$get_content()[[1]]$get_content()
  • teal.reporter::ReportCard$get_name()
  • teal.reporter::ReportCard$initialize()
  • teal.reporter::ReportCard$reset()
    • +
  • teal.reporter::ReportCard$set_content_names()
  • teal.reporter::ReportCard$set_name()
  • teal.reporter::ReportCard$to_list()
    • @@ -89,7 +90,7 @@ Object of class \code{TealReportCard}, invisibly. \preformatted{card <- TealReportCard$new()$append_src( "plot(iris)" ) -card$get_content()[[1]]$get_content() +card$get_content()[[1]] } \if{html}{\out{}} @@ -141,7 +142,7 @@ Appends the encodings list to the \code{content} and \code{metadata} of this \co \subsection{Examples}{ \if{html}{\out{
    }} \preformatted{card <- TealReportCard$new()$append_encodings(list(variable1 = "X")) -card$get_content()[[1]]$get_content() +card$get_content()[[1]] } \if{html}{\out{
    }} diff --git a/man/TealSlicesBlock.Rd b/man/TealSlicesBlock.Rd deleted file mode 100644 index a5be9a0446..0000000000 --- a/man/TealSlicesBlock.Rd +++ /dev/null @@ -1,177 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/teal_reporter.R -\docType{class} -\name{TealSlicesBlock} -\alias{TealSlicesBlock} -\title{\code{TealSlicesBlock}} -\description{ -Specialized \code{TealSlicesBlock} block for managing filter panel content in reports. -} -\examples{ - -## ------------------------------------------------ -## Method `TealSlicesBlock$from_list` -## ------------------------------------------------ - -TealSlicesBlock <- getFromNamespace("TealSlicesBlock", "teal") -block <- TealSlicesBlock$new() -block$from_list(list(text = "sth", style = "default")) - - -## ------------------------------------------------ -## Method `TealSlicesBlock$to_list` -## ------------------------------------------------ - -TealSlicesBlock <- getFromNamespace("TealSlicesBlock", "teal") -block <- TealSlicesBlock$new() -block$to_list() - -} -\keyword{internal} -\section{Super classes}{ -\code{\link[teal.reporter:ContentBlock]{teal.reporter::ContentBlock}} -> \code{\link[teal.reporter:TextBlock]{teal.reporter::TextBlock}} -> \code{TealSlicesBlock} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-TealSlicesBlock-new}{\code{TealSlicesBlock$new()}} -\item \href{#method-TealSlicesBlock-set_content}{\code{TealSlicesBlock$set_content()}} -\item \href{#method-TealSlicesBlock-from_list}{\code{TealSlicesBlock$from_list()}} -\item \href{#method-TealSlicesBlock-to_list}{\code{TealSlicesBlock$to_list()}} -\item \href{#method-TealSlicesBlock-clone}{\code{TealSlicesBlock$clone()}} -} -} -\if{html}{\out{ -
    Inherited methods - -
    -}} -\if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealSlicesBlock-new}{}}} -\subsection{Method \code{new()}}{ -Returns a \code{TealSlicesBlock} object. -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealSlicesBlock$new(content = teal_slices(), style = "verbatim")}\if{html}{\out{
    }} -} - -\subsection{Arguments}{ -\if{html}{\out{
    }} -\describe{ -\item{\code{content}}{(\code{teal_slices}) object returned from \code{\link[=teal_slices]{teal_slices()}} function.} - -\item{\code{style}}{(\code{character(1)}) string specifying style to apply.} -} -\if{html}{\out{
    }} -} -\subsection{Details}{ -Returns a \code{TealSlicesBlock} object with no content and no parameters. -} - -\subsection{Returns}{ -Object of class \code{TealSlicesBlock}, invisibly. -} -} -\if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealSlicesBlock-set_content}{}}} -\subsection{Method \code{set_content()}}{ -Sets content of this \code{TealSlicesBlock}. -Sets content as \code{YAML} text which represents a list generated from \code{teal_slices}. -The list displays limited number of fields from \code{teal_slice} objects, but this list is -sufficient to conclude which filters were applied. -When \code{selected} field in \code{teal_slice} object is a range, then it is displayed as a "min" -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealSlicesBlock$set_content(content)}\if{html}{\out{
    }} -} - -\subsection{Arguments}{ -\if{html}{\out{
    }} -\describe{ -\item{\code{content}}{(\code{teal_slices}) object returned from \code{\link[=teal_slices]{teal_slices()}} function.} -} -\if{html}{\out{
    }} -} -\subsection{Returns}{ -\code{self}, invisibly. -} -} -\if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealSlicesBlock-from_list}{}}} -\subsection{Method \code{from_list()}}{ -Create the \code{TealSlicesBlock} from a list. -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealSlicesBlock$from_list(x)}\if{html}{\out{
    }} -} - -\subsection{Arguments}{ -\if{html}{\out{
    }} -\describe{ -\item{\code{x}}{(\verb{named list}) with two fields \code{text} and \code{style}. -Use the \code{get_available_styles} method to get all possible styles.} -} -\if{html}{\out{
    }} -} -\subsection{Returns}{ -\code{self}, invisibly. -} -\subsection{Examples}{ -\if{html}{\out{
    }} -\preformatted{TealSlicesBlock <- getFromNamespace("TealSlicesBlock", "teal") -block <- TealSlicesBlock$new() -block$from_list(list(text = "sth", style = "default")) - -} -\if{html}{\out{
    }} - -} - -} -\if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealSlicesBlock-to_list}{}}} -\subsection{Method \code{to_list()}}{ -Convert the \code{TealSlicesBlock} to a list. -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealSlicesBlock$to_list()}\if{html}{\out{
    }} -} - -\subsection{Returns}{ -\verb{named list} with a text and style. -} -\subsection{Examples}{ -\if{html}{\out{
    }} -\preformatted{TealSlicesBlock <- getFromNamespace("TealSlicesBlock", "teal") -block <- TealSlicesBlock$new() -block$to_list() - -} -\if{html}{\out{
    }} - -} - -} -\if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealSlicesBlock-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealSlicesBlock$clone(deep = FALSE)}\if{html}{\out{
    }} -} - -\subsection{Arguments}{ -\if{html}{\out{
    }} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
    }} -} -} -} diff --git a/man/after.Rd b/man/after.Rd new file mode 100644 index 0000000000..de88dd59b4 --- /dev/null +++ b/man/after.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/after.R +\name{after} +\alias{after} +\title{Executes modifications to the result of a module} +\usage{ +after( + x, + ui = function(id, elem) elem, + server = function(input, output, session, data) data, + ... +) +} +\arguments{ +\item{x}{(\code{teal_module})} + +\item{ui}{(\verb{function(id, elem, ...)}) function to receive output (\code{shiny.tag}) from \code{x$ui}} + +\item{server}{(\verb{function(input, output, session, data, ...)}) function to receive output data from \code{x$server}} + +\item{...}{additional argument passed to \code{ui} and \code{server} by matching their formals names.} +} +\value{ +A \code{teal_report} object with the result of the server function. +} +\description{ +Primarily used to modify the output object of module to change the containing +report. +} diff --git a/man/disable_report.Rd b/man/disable_report.Rd new file mode 100644 index 0000000000..b735ae4ac7 --- /dev/null +++ b/man/disable_report.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/teal_reporter.R +\name{disable_report} +\alias{disable_report} +\title{Disable the report for a \code{teal_module}} +\usage{ +disable_report(x) +} +\arguments{ +\item{x}{(\code{teal_module}) a \code{teal_module} object.} +} +\value{ +\code{NULL} that indicates that it should disable the reporter functionality. +} +\description{ +Convenience function that disables the user's ability to add the module +to the report previewer. +} +\examples{ +app <- init( + data = within(teal_data(), iris <- iris), + modules = modules( + example_module(label = "example teal module") |> disable_report() + ) +) +if (interactive()) { + shinyApp(app$ui, app$server) +} +} diff --git a/man/init.Rd b/man/init.Rd index acc677e499..3023d725ca 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -11,7 +11,8 @@ init( title = lifecycle::deprecated(), header = lifecycle::deprecated(), footer = lifecycle::deprecated(), - id = lifecycle::deprecated() + id = lifecycle::deprecated(), + reporter = teal.reporter::Reporter$new() ) } \arguments{ @@ -45,6 +46,8 @@ This parameter is no longer supported. Use \code{modify_footer()} on the teal ap a string specifying the \code{shiny} module id in cases it is used as a \code{shiny} module rather than a standalone \code{shiny} app. This parameter is no longer supported. Use \code{\link[=ui_teal]{ui_teal()}} and \code{\link[=srv_teal]{srv_teal()}} instead.} + +\item{reporter}{(\code{Reporter}) object used to store report contents. Set to \code{NULL} to globally disable reporting.} } \value{ Named list containing server and UI functions. diff --git a/man/module_teal.Rd b/man/module_teal.Rd index d9fc306526..47a12b4be7 100644 --- a/man/module_teal.Rd +++ b/man/module_teal.Rd @@ -8,7 +8,13 @@ \usage{ ui_teal(id, modules) -srv_teal(id, data, modules, filter = teal_slices()) +srv_teal( + id, + data, + modules, + filter = teal_slices(), + reporter = teal.reporter::Reporter$new() +) } \arguments{ \item{id}{(\code{character(1)}) \code{shiny} module instance id.} @@ -23,6 +29,8 @@ The data which application will depend on.} \item{filter}{(\code{teal_slices}) Optionally, specifies the initial filter using \code{\link[=teal_slices]{teal_slices()}}.} + +\item{reporter}{(\code{Reporter}) object used to store report contents. Set to \code{NULL} to globally disable reporting.} } \value{ \code{NULL} invisibly diff --git a/man/teal_data_module.Rd b/man/teal_data_module.Rd index 683c6d9ef9..cd96531899 100644 --- a/man/teal_data_module.Rd +++ b/man/teal_data_module.Rd @@ -4,16 +4,15 @@ \name{teal_data_module} \alias{teal_data_module} \alias{eval_code} -\alias{eval_code,teal_data_module,character-method} -\alias{eval_code,teal_data_module,language-method} -\alias{eval_code,teal_data_module,expression-method} +\alias{eval_code,teal_data_module} +\alias{\S4method{eval_code}{teal_data_module}} \alias{within} \alias{within.teal_data_module} \title{Data module for \code{teal} applications} \usage{ teal_data_module(ui, server, label = "data module", once = TRUE) -\S4method{eval_code}{teal_data_module,character}(object, code) +\S4method{eval_code}{teal_data_module}(object, code) \method{within}{teal_data_module}(data, expr, ...) } diff --git a/man/teal_data_utilities.Rd b/man/teal_data_utilities.Rd index 0fdcaa6653..72bec71171 100644 --- a/man/teal_data_utilities.Rd +++ b/man/teal_data_utilities.Rd @@ -4,11 +4,14 @@ \alias{teal_data_utilities} \alias{.append_evaluated_code} \alias{.append_modified_data} +\alias{.collapse_subsequent_chunks} \title{\code{teal_data} utils} \usage{ .append_evaluated_code(data, code) .append_modified_data(data, objects) + +.collapse_subsequent_chunks(report) } \arguments{ \item{data}{(\code{teal_data})} diff --git a/man/validate_inputs.Rd b/man/validate_inputs.Rd index fb72ab0df7..efbe2043b9 100644 --- a/man/validate_inputs.Rd +++ b/man/validate_inputs.Rd @@ -40,7 +40,7 @@ for their respective message groups. If neither of the nested list elements is named, a header message is taken from \code{header}. } \examples{ -\dontshow{if (require("shinyvalidate")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (require("shinyvalidate")) withAutoprint(\{ # examplesIf} library(shiny) library(shinyvalidate) diff --git a/tests/testthat/helper-shinytest2.R b/tests/testthat/helper-shinytest2.R index 0656e6db5f..705b87c853 100644 --- a/tests/testthat/helper-shinytest2.R +++ b/tests/testthat/helper-shinytest2.R @@ -5,33 +5,3 @@ simple_teal_data <- function() { }) data } - -report_module <- function(label = "example teal module") { - module( - label = label, - server = function(id, data, reporter) { - moduleServer(id, function(input, output, session) { - teal.reporter::simple_reporter_srv( - id = "reporter", - reporter = reporter, - card_fun = function(card) card - ) - updateSelectInput(session, "dataname", choices = isolate(names(data()))) - output$dataset <- renderPrint({ - req(input$dataname) - data()[[input$dataname]] - }) - }) - }, - ui = function(id) { - ns <- NS(id) - sidebarLayout( - sidebarPanel( - teal.reporter::simple_reporter_ui(ns("reporter")), - selectInput(ns("dataname"), "Choose a dataset", choices = NULL) - ), - mainPanel(verbatimTextOutput(ns("dataset"))) - ) - } - ) -} diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R index f0801765d8..4211f4bbd0 100644 --- a/tests/testthat/test-module_teal.R +++ b/tests/testthat/test-module_teal.R @@ -1043,7 +1043,7 @@ testthat::describe("srv_teal teal_modules", { ) }) - testthat::it("does not receive report_previewer when none of the modules contain reporter argument", { + testthat::it("does not receive report_previewer when reporter is NULL", { shiny::testServer( app = srv_teal, args = list( @@ -1052,7 +1052,8 @@ testthat::describe("srv_teal teal_modules", { modules = modules( module("module_1", server = function(id) {}), module("module_2", server = function(id) {}) - ) + ), + reporter = NULL ), expr = { session$setInputs(`teal_modules-active_module_id` = "report_previewer") diff --git a/tests/testthat/test-shinytest2-reporter.R b/tests/testthat/test-shinytest2-reporter.R index 3b221b2a5b..60b42618ac 100644 --- a/tests/testthat/test-shinytest2-reporter.R +++ b/tests/testthat/test-shinytest2-reporter.R @@ -5,12 +5,16 @@ testthat::test_that("e2e: reporter tab is created when a module has reporter", { skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), - modules = report_module(label = "Module with Reporter") + modules = example_module(label = "Module with Reporter") ) testthat::expect_true(length(app$get_html("#teal-reporter_menu_container")) > 0) app$stop() }) +testthat::test_that("e2e: reporter card can be customized", { + skip("TODO") +}) + testthat::test_that("e2e: reporter tab is not created when a module has no reporter", { skip_if_too_deep(5) app <- TealAppDriver$new( @@ -25,13 +29,13 @@ testthat::test_that("e2e: adding a report card in a module adds it in the report skip_if_too_deep(5) app <- TealAppDriver$new( data = simple_teal_data(), - modules = report_module(label = "Module with Reporter") + modules = example_module(label = "Module with Reporter") ) # Add new card with label and comment app$click(NS(app$active_module_ns(), "reporter-add_report_card_simple-add_report_card_button")) app$set_input( - NS(app$active_module_ns(), "reporter-add_report_card_simple-label"), + NS(app$active_module_ns(), "reporter_add-label"), "Card name" ) app$set_input( diff --git a/tests/testthat/test-teal_reporter.R b/tests/testthat/test-teal_reporter.R index b599dcabc1..a1e4109f37 100644 --- a/tests/testthat/test-teal_reporter.R +++ b/tests/testthat/test-teal_reporter.R @@ -13,13 +13,13 @@ testthat::test_that("TealReportCard$new returns an object of type TealReportCard testthat::test_that("TealReportCard$get_content returns content with metadata", { card <- TealReportCard$new()$append_text("test")$append_src("test_src")$append_encodings(list(data = "test")) testthat::expect_equal(length(card$get_content()), 4) - testthat::expect_equal(length(card$get_metadata()), 2) - testthat::expect_identical(card$get_content()[[1]]$get_content(), "test") + testthat::expect_equal(length(card$get_metadata()), 1) + testthat::expect_identical(card$get_content()[[1]], "test") testthat::expect_identical( - card$get_content()[[2]]$get_content(), + as.character(card$get_content()[[2]]), "test_src" ) - testthat::expect_identical(card$get_content()[[4]]$get_content(), "data: test\n") + testthat::expect_identical(card$get_content()[[4]], "\n```\ndata: test\n\n```\n") }) testthat::test_that("TealReportCard$append_src accepts a character", { @@ -35,7 +35,7 @@ testthat::test_that("TealReportCard$append_src returns self", { testthat::test_that("TealReportCard$append_src returns title and content", { card <- TealReportCard$new() card$append_src("test") - testthat::expect_identical(card$get_content()[[1]]$get_content(), "test") + testthat::expect_identical(as.character(card$get_content()[[1]]), "test") }) testthat::test_that("TealReportCard$append_encodings accepts list of character", { @@ -51,8 +51,8 @@ testthat::test_that("TealReportCard$append_encodings returns self", { testthat::test_that("TealReportCard$append_encodings returns title and content", { card <- TealReportCard$new() card$append_encodings(list(a = "test")) - testthat::expect_identical(card$get_content()[[1]]$get_content(), "Selected Options") - testthat::expect_identical(card$get_content()[[2]]$get_content(), "a: test\n") + testthat::expect_identical(card$get_content()[[1]], "### Selected Options") + testthat::expect_identical(card$get_content()[[2]], "\n```\na: test\n\n```\n") }) testthat::test_that("TealReportCard$append_fs accepts only a teal_slices", { @@ -78,35 +78,5 @@ testthat::test_that("TealReportCard$append_fs returns self", { testthat::test_that("TealReportCard$append_fs returns title and content", { card <- TealReportCard$new() card$append_fs(teal.slice::teal_slices(teal.slice::teal_slice(dataname = "a", varname = "b"))) - testthat::expect_identical(card$get_content()[[1]]$get_content(), "Filter State") - testthat::expect_true(inherits(card$get_content()[[2]], "TealSlicesBlock")) -}) - -testthat::test_that("TealSlicesBlock$new accepts teal_slices only", { - testthat::expect_no_error(TealSlicesBlock$new(teal_slices())) - testthat::expect_error(TealSlicesBlock$new(list()), "Assertion on 'content'") -}) - -testthat::test_that("TealSlicesBlock$get_content returns yaml character", { - block <- TealSlicesBlock$new( - teal.slice::teal_slices(teal.slice::teal_slice(dataname = "a", varname = "b")) - ) - testthat::expect_identical(block$get_content(), "- Dataset name: a\n Variable name: b\n") -}) - -testthat::test_that("TealSlicesBlock$to_list returns list containing teal_slices", { - tss <- teal.slice::teal_slices(teal.slice::teal_slice(dataname = "a", varname = "b")) - block <- TealSlicesBlock$new(tss) - testthat::expect_identical( - block$to_list(), - list(text = "- Dataset name: a\n Variable name: b\n", style = "verbatim") - ) -}) - -testthat::test_that("TealSlicesBlock$from_list retains states from a list", { - tss <- teal.slice::teal_slices(teal.slice::teal_slice(dataname = "a", varname = "b")) - block1 <- TealSlicesBlock$new(tss) - block2 <- TealSlicesBlock$new() - block2$from_list(block1$to_list()) - testthat::expect_identical(block1$get_content(), block2$get_content()) + testthat::expect_identical(as.character(card$get_content()[[1]]), "- Dataset name: a\n Variable name: b\n") }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index abdbc8a2b5..0e297fc184 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -25,7 +25,7 @@ testthat::test_that("report_card_template function returns TealReportCard object )) testthat::expect_s3_class(card, c("TealReportCard")) testthat::expect_equal(card$get_name(), "Card label") - testthat::expect_length(card$get_content(), 4) + testthat::expect_length(card$get_content(), 2) card <- shiny::isolate(report_card_template( title = "Card title", diff --git a/vignettes/adding-support-for-reporting.Rmd b/vignettes/adding-support-for-reporting.Rmd index 3ebb13138a..4e04e3fb8f 100644 --- a/vignettes/adding-support-for-reporting.Rmd +++ b/vignettes/adding-support-for-reporting.Rmd @@ -226,7 +226,7 @@ To explore the content, we can use the `$get_content` method. For further details, refer to the documentation of `TealReportCard` and `teal.reporter::ReportCard`. We will add simple text to the card by modifying the `card_fun` argument passed to `teal.reporter::simple_reporter_srv`. -The function must return the `card` object, otherwise errors may occur in `teal`. +The function must return the `teal_card` object, otherwise errors may occur in `teal`. ```{r module_4} custom_function <- function(card = teal.reporter::ReportCard$new()) {