From df1cade14a95f3dd138133402016145bd2eb2b41 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Wed, 24 Apr 2024 09:51:46 +0200 Subject: [PATCH] Simple - Load Reporter - Inbuild (#251) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit closes #81 continuation of https://github.com/insightsengineering/teal.reporter/pull/177 linked to https://github.com/insightsengineering/teal/pull/1120 Please install this teal branch when testing the code I created a new PR from the fork as I am no longer part of the insightengineering group. My work is done as a collaboration of UCB company with Roche. insightengineering developers can edit this PR. I followed a simple design, which was evaluated positively in [the discussion](#81). DONE: - New modules `report_load_srv` and `report_load_ui`; similar direct update for Previewer. - REMOVE the `Archiver` Class as we not need it for this simplified scenario. - Improve `to_list` and `from_list` `Reporter` methods - Add `set_id` and `get_id` `Reporter` methods. Optionally add id to a Report which will be compared when it is rebuilt from a list. To test it in the teal example app please download a report and then add a new module or dataset to the app and try to load it back. The report can be loaded back to teal app only with the same datasets and modules. The id is added to the downloaded file name if exists. - Improve `to_list` and `from_list` `ReportCard` methods (linked with https://github.com/insightsengineering/teal/pull/1120) - Both already existing vignette apps are updated automatically. - `warning(cond)` everywhere to be consistent. We should send the error/warning to the R console when STH fails. - Add `testServer` tests for report_load_srv/report_load_ui modules. - UI tested with all 3 bootstrap versions. Points to consider: - The JSON format Report representation seems to be enough, so an Archiver is unnecessary. The DB solution to save/load seems overcomplex for the project. - No update will be required to introduce it into teal modules. Simple reporter is updated automatically and can be customized with a new teal.reporter option. - When reloading, the Report is validated by the "report_" file name prefix later by the slot name "teal Report" and optionally by ID if it is non-empty. Example Teal App (play with bootstrap versions, simple reporter modules, and add new data/module to confirm the report can not be then reloaded): ```r library(teal.modules.general) # one of c("3", "4", "5") options("teal.bs_theme" = bslib::bs_theme(version = "4")) data <- teal_data() data <- within(data, { library(nestcolor) ADSL <- teal.modules.general::rADSL }) datanames <- c("ADSL") datanames(data) <- datanames join_keys(data) <- default_cdisc_join_keys[datanames] app <- teal::init( data = data, modules = teal::modules( teal.modules.general::tm_a_regression( label = "Regression", response = teal.transform::data_extract_spec( dataname = "ADSL", select = teal.transform::select_spec( label = "Select variable:", choices = "BMRKR1", selected = "BMRKR1", multiple = FALSE, fixed = TRUE ) ), regressor = teal.transform::data_extract_spec( dataname = "ADSL", select = teal.transform::select_spec( label = "Select variables:", choices = teal.transform::variable_choices(data[["ADSL"]], c("AGE", "SEX", "RACE")), selected = "AGE", multiple = TRUE, fixed = FALSE ) ), ggplot2_args = teal.widgets::ggplot2_args( labs = list(subtitle = "Plot generated by Regression Module") ) ) ) ) runApp(app, launch.browser = TRUE) ``` Example general shiny app (play with bootstrap versions, simple reporter modules): ```r library(shiny) library(teal.reporter) library(ggplot2) library(rtables) library(DT) library(bslib) ui <- fluidPage( # please, specify specific bootstrap version and theme theme = bs_theme(version = "4"), titlePanel(""), tabsetPanel( tabPanel( "main App", tags$br(), sidebarLayout( sidebarPanel( uiOutput("encoding") ), mainPanel( tabsetPanel( id = "tabs", tabPanel("Plot", plotOutput("dist_plot")), tabPanel("Table", verbatimTextOutput("table")), tabPanel("Table DataFrame", verbatimTextOutput("table2")), tabPanel("Table DataTable", dataTableOutput("table3")) ) ) ) ), ### REPORTER tabPanel( "Previewer", reporter_previewer_ui("prev") ) ### ) ) server <- function(input, output, session) { output$encoding <- renderUI({ tagList( ### REPORTER teal.reporter::simple_reporter_ui("simple_reporter"), ### if (input$tabs == "Plot") { sliderInput( "binwidth", "binwidth", min = 2, max = 10, value = 8 ) } else if (input$tabs %in% c("Table", "Table DataFrame", "Table DataTable")) { selectInput( "stat", label = "Statistic", choices = c("mean", "median", "sd"), "mean" ) } else { NULL } ) }) plot <- reactive({ req(input$binwidth) x <- mtcars$mpg ggplot(data = mtcars, aes(x = mpg)) + geom_histogram(binwidth = input$binwidth) }) output$dist_plot <- renderPlot(plot()) table <- reactive({ req(input$stat) lyt <- basic_table() %>% split_rows_by("Month", label_pos = "visible") %>% analyze("Ozone", afun = eval(str2expression(input$stat))) build_table(lyt, airquality) }) output$table <- renderPrint(table()) table2 <- reactive({ req(input$stat) data <- aggregate( airquality[, c("Ozone"), drop = FALSE], list(Month = airquality$Month), get(input$stat), na.rm = TRUE ) colnames(data) <- c("Month", input$stat) data }) output$table2 <- renderPrint(print.data.frame(table2())) output$table3 <- renderDataTable(table2()) ### REPORTER reporter <- Reporter$new() card_fun <- function(card = ReportCard$new(), comment) { if (input$tabs == "Plot") { card$set_name("Plot Module") card$append_text("My plot", "header2") card$append_plot(plot()) card$append_rcode( paste( c( "x <- mtcars$mpg", "ggplot2::ggplot(data = mtcars, ggplot2::aes(x = mpg)) +", paste0("ggplot2::geom_histogram(binwidth = ", input$binwidth, ")") ), collapse = "\n" ), echo = TRUE, eval = FALSE ) } else if (input$tabs == "Table") { card$set_name("Table Module rtables") card$append_text("My rtables", "header2") card$append_table(table()) card$append_rcode( paste( c( "lyt <- rtables::basic_table() %>%", 'rtables::split_rows_by("Month", label_pos = "visible") %>%', paste0('rtables::analyze("Ozone", afun = ', input$stat, ")"), "rtables::build_table(lyt, airquality)" ), collapse = "\n" ), echo = TRUE, eval = FALSE ) } else if (input$tabs %in% c("Table DataFrame", "Table DataTable")) { card$set_name("Table Module DF") card$append_text("My Table DF", "header2") card$append_table(table2()) # Here r code added as a regular verbatim text card$append_text( paste0( c( 'data <- aggregate(airquality[, c("Ozone"), drop = FALSE], list(Month = airquality$Month), ', input$stat, ", na.rm = TRUE)\n", 'colnames(data) <- c("Month", ', paste0('"', input$stat, '"'), ")\n", "data" ), collapse = "" ), "verbatim" ) } if (!comment == "") { card$append_text("Comment", "header3") card$append_text(comment) } card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) teal.reporter::reporter_previewer_srv("prev", reporter) ### } if (interactive()) shinyApp(ui = ui, server = server) ``` --------- Signed-off-by: Maciej Nasinski Co-authored-by: Dawid Kałędkowski <6959016+gogonzo@users.noreply.github.com> Co-authored-by: Dawid Kałędkowski --- NAMESPACE | 2 + NEWS.md | 1 + R/Archiver.R | 181 ------------------ R/DownloadModule.R | 37 +++- R/LoadReporterModule.R | 139 ++++++++++++++ R/Previewer.R | 118 ++++++++++-- R/ReportCard.R | 29 +-- R/Reporter.R | 46 ++++- R/SimpleReporter.R | 34 ++-- _pkgdown.yml | 2 + inst/WORDLIST | 1 + inst/css/Previewer.css | 5 + inst/css/custom.css | 4 + man/Archiver.Rd | 101 ---------- man/FileArchiver.Rd | 120 ------------ man/JSONArchiver.Rd | 208 --------------------- man/Reporter.Rd | 43 ++++- man/report_load_srv.Rd | 22 +++ man/report_load_ui.Rd | 20 ++ man/reporter_previewer.Rd | 7 +- tests/testthat/test-Archiver.R | 152 --------------- tests/testthat/test-DownloadReportModule.R | 2 + tests/testthat/test-LoadReporterModule.R | 83 ++++++++ tests/testthat/test-ReportCard.R | 2 +- tests/testthat/test-Reporter.R | 18 +- vignettes/previewerReporter.Rmd | 11 +- vignettes/simpleReporter.Rmd | 5 + 27 files changed, 564 insertions(+), 829 deletions(-) delete mode 100644 R/Archiver.R create mode 100644 R/LoadReporterModule.R delete mode 100644 man/Archiver.Rd delete mode 100644 man/FileArchiver.Rd delete mode 100644 man/JSONArchiver.Rd create mode 100644 man/report_load_srv.Rd create mode 100644 man/report_load_ui.Rd delete mode 100644 tests/testthat/test-Archiver.R create mode 100644 tests/testthat/test-LoadReporterModule.R diff --git a/NAMESPACE b/NAMESPACE index 347f3e4f..23f0e3b5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,8 @@ export(add_card_button_ui) export(as_yaml_auto) export(download_report_button_srv) export(download_report_button_ui) +export(report_load_srv) +export(report_load_ui) export(reporter_previewer_srv) export(reporter_previewer_ui) export(reset_report_button_srv) diff --git a/NEWS.md b/NEWS.md index 6e482934..048a6e83 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ ### Enhancements * Report cards are now included in bookmarks. When using the `shiny` bookmarking mechanism, present report cards will be available in the restored application. +* Report can be loaded back now. The zip file with the report can be loaded back which will restore Previewer state. # teal.reporter 0.3.1 diff --git a/R/Archiver.R b/R/Archiver.R deleted file mode 100644 index 9230b4cc..00000000 --- a/R/Archiver.R +++ /dev/null @@ -1,181 +0,0 @@ -#' @title `Archiver`: Base class for data archiving -#' @docType class -#' @description -#' A base `R6` class for implementing data archiving functionality. -#' -#' @keywords internal -Archiver <- R6::R6Class( # nolint: object_name_linter. - classname = "Archiver", - public = list( - #' @description Initialize an `Archiver` object. - #' - #' @return Object of class `Archiver`, invisibly. - #' @examples - #' Archiver <- getFromNamespace("Archiver", "teal.reporter") - #' Archiver$new() - initialize = function() { - invisible(self) - }, - #' @description Finalizes an `Archiver` object. - finalize = function() { - # destructor - }, - #' @description Reads data from the `Archiver`. - #' Pure virtual method that should be implemented by inherited classes. - read = function() { - # returns Reporter instance - stop("Pure virtual method.") - }, - #' @description Writes data to the `Archiver`. - #' Pure virtual method that should be implemented by inherited classes. - write = function() { - stop("Pure virtual method.") - } - ), - lock_objects = TRUE, - lock_class = TRUE -) - -#' @title `FileArchiver`: A File-based `Archiver` -#' @docType class -#' @description -#' Inherits from `Archiver` to provide file-based archiving functionality. -#' Manages an output directory for storing archived data. -#' -#' @keywords internal -FileArchiver <- R6::R6Class( # nolint: object_name_linter. - classname = "FileArchiver", - inherit = Archiver, - public = list( - #' @description Initialize a `FileArchiver` object with a unique output directory. - #' - #' @return Object of class `FileArchiver`, invisibly. - #' @examples - #' FileArchiver <- getFromNamespace("FileArchiver", "teal.reporter") - #' FileArchiver$new() - initialize = function() { - tmp_dir <- tempdir() - output_dir <- file.path(tmp_dir, sprintf("archive_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) - dir.create(path = output_dir) - private$output_dir <- output_dir - invisible(self) - }, - #' @description Finalizes a `FileArchiver` object. - #' Cleans up by removing the output directory and its contents. - finalize = function() { - unlink(private$output_dir, recursive = TRUE) - }, - #' @description Get `output_dir` field. - #' - #' @return `character` a `output_dir` field path. - #' @examples - #' FileArchiver <- getFromNamespace("FileArchiver", "teal.reporter") - #' FileArchiver$new()$get_output_dir() - get_output_dir = function() { - private$output_dir - } - ), - private = list( - output_dir = character(0) - ) -) - -#' @title `JSONArchiver`: A `JSON`-based `Archiver` -#' @docType class -#' @description -#' Inherits from `FileArchiver` to implement `JSON`-based archiving functionality. -#' Convert `Reporter` instances to and from `JSON` format. -#' -#' @keywords internal -JSONArchiver <- R6::R6Class( # nolint: object_name_linter. - classname = "JSONArchiver", - inherit = FileArchiver, - public = list( - #' @description Write a `Reporter` instance in `JSON` file. - #' Serializes a given `Reporter` instance and saves it in the `Archiver`'s output directory, - #' to this `JSONArchiver` object. - #' - #' @param reporter (`Reporter`) instance. - #' - #' @return `self`. - #' @examples - #' library(ggplot2) - #' - #' ReportCard <- getFromNamespace("ReportCard", "teal.reporter") - #' card1 <- ReportCard$new() - #' - #' card1$append_text("Header 2 text", "header2") - #' card1$append_text("A paragraph of default text", "header2") - #' card1$append_plot( - #' ggplot(iris, aes(x = Petal.Length)) + geom_histogram() - #' ) - #' - #' Reporter <- getFromNamespace("Reporter", "teal.reporter") - #' reporter <- Reporter$new() - #' reporter$append_cards(list(card1)) - #' - #' JSONArchiver <- getFromNamespace("JSONArchiver", "teal.reporter") - #' archiver <- JSONArchiver$new() - #' archiver$write(reporter) - #' archiver$get_output_dir() - write = function(reporter) { - checkmate::assert_class(reporter, "Reporter") - unlink(list.files(private$output_dir, recursive = TRUE, full.names = TRUE)) - reporter$to_jsondir(private$output_dir) - self - }, - #' @description Read a `Reporter` instance from a `JSON` file. - #' Converts a `Reporter` instance from the `JSON` file in the `JSONArchiver`'s output directory. - #' - #' @param path (`character(1)`) a path to the directory with all proper files. - #' - #' @return `Reporter` instance. - #' @examples - #' library(ggplot2) - #' - #' ReportCard <- getFromNamespace("ReportCard", "teal.reporter") - #' card1 <- ReportCard$new() - #' - #' card1$append_text("Header 2 text", "header2") - #' card1$append_text("A paragraph of default text", "header2") - #' card1$append_plot( - #' ggplot(iris, aes(x = Petal.Length)) + geom_histogram() - #' ) - #' - #' Reporter <- getFromNamespace("Reporter", "teal.reporter") - #' reporter <- Reporter$new() - #' reporter$append_cards(list(card1)) - #' - #' JSONArchiver <- getFromNamespace("JSONArchiver", "teal.reporter") - #' archiver <- JSONArchiver$new() - #' archiver$write(reporter) - #' archiver$get_output_dir() - #' - #' archiver$read()$get_cards()[[1]]$get_content() - #' Reporter <- getFromNamespace("Reporter", "teal.reporter") - #' blocks <- Reporter$new() - #' blocks <- blocks$from_reporter(archiver$read())$get_blocks() - #' Renderer <- getFromNamespace("Renderer", "teal.reporter") - #' doc <- Renderer$new()$render(blocks) - read = function(path = NULL) { - checkmate::assert( - checkmate::check_null(path), - checkmate::check_directory_exists(path) - ) - - if (!is.null(path) && !identical(path, private$output_dir)) { - unlink(list.files(private$output_dir, recursive = TRUE, full.names = TRUE)) - file.copy(list.files(path, full.names = TRUE), private$output_dir) - } - - if (length(list.files(private$output_dir))) { - Reporter$new()$from_jsondir(private$output_dir) - } else { - warning("The directory provided to the Archiver is empty.") - Reporter$new() - } - } - ), - lock_objects = TRUE, - lock_class = TRUE -) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 578fc777..9548b8dd 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -137,7 +137,12 @@ download_report_button_srv <- function(id, output$download_data <- shiny::downloadHandler( filename = function() { - paste("report_", format(Sys.time(), "%y%m%d%H%M%S"), ".zip", sep = "") + paste0( + "report_", + if (reporter$get_id() == "") NULL else paste0(reporter$get_id(), "_"), + format(Sys.time(), "%y%m%d%H%M%S"), + ".zip" + ) }, content = function(file) { shiny::showNotification("Rendering and Downloading the document.") @@ -189,6 +194,7 @@ report_render_and_compress <- function(reporter, input_list, global_knitr, file tryCatch( renderer$render(reporter$get_blocks(), yaml_header, global_knitr), warning = function(cond) { + print(cond) shiny::showNotification( ui = "Render document warning!", action = "Please contact app developer", @@ -196,6 +202,7 @@ report_render_and_compress <- function(reporter, input_list, global_knitr, file ) }, error = function(cond) { + print(cond) shiny::showNotification( ui = "Render document error!", action = "Please contact app developer", @@ -204,10 +211,33 @@ report_render_and_compress <- function(reporter, input_list, global_knitr, file } ) + output_dir <- renderer$get_output_dir() + + tryCatch( + archiver_dir <- reporter$to_jsondir(output_dir), + warning = function(cond) { + print(cond) + shiny::showNotification( + ui = "Archive document warning!", + action = "Please contact app developer", + type = "warning" + ) + }, + error = function(cond) { + print(cond) + shiny::showNotification( + ui = "Archive document error!", + action = "Please contact app developer", + type = "error" + ) + } + ) + temp_zip_file <- tempfile(fileext = ".zip") tryCatch( - expr = zip::zipr(temp_zip_file, renderer$get_output_dir()), + expr = zip::zipr(temp_zip_file, output_dir), warning = function(cond) { + print(cond) shiny::showNotification( ui = "Zipping folder warning!", action = "Please contact app developer", @@ -215,6 +245,7 @@ report_render_and_compress <- function(reporter, input_list, global_knitr, file ) }, error = function(cond) { + print(cond) shiny::showNotification( ui = "Zipping folder error!", action = "Please contact app developer", @@ -226,6 +257,7 @@ report_render_and_compress <- function(reporter, input_list, global_knitr, file tryCatch( expr = file.copy(temp_zip_file, file), warning = function(cond) { + print(cond) shiny::showNotification( ui = "Copying file warning!", action = "Please contact app developer", @@ -233,6 +265,7 @@ report_render_and_compress <- function(reporter, input_list, global_knitr, file ) }, error = function(cond) { + print(cond) shiny::showNotification( ui = "Copying file error!", action = "Please contact app developer", diff --git a/R/LoadReporterModule.R b/R/LoadReporterModule.R new file mode 100644 index 00000000..2e8a1ff7 --- /dev/null +++ b/R/LoadReporterModule.R @@ -0,0 +1,139 @@ +#' User Interface to Load `Reporter` +#' @description `r lifecycle::badge("experimental")` +#' Button to upload `ReporterCard`(s) to the `Reporter`. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. +#' @param id `character(1)` this `shiny` module's id. +#' @return `shiny::tagList` +#' @export +report_load_ui <- function(id) { + ns <- shiny::NS(id) + + shiny::tagList( + shiny::singleton( + shiny::tags$head(shiny::includeCSS(system.file("css/custom.css", package = "teal.reporter"))) + ), + shiny::tags$button( + id = ns("reporter_load"), + type = "button", + class = "simple_report_button btn btn-primary action-button", + title = "Load", + NULL, + shiny::tags$span( + shiny::icon("upload") + ) + ) + ) +} + +#' Server to Load `Reporter` +#' @description `r lifecycle::badge("experimental")` +#' Server to load `ReporterCard`(s) to the `Reporter` +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. +#' +#' @param id `character(1)` this `shiny` module's id. +#' @param reporter [`Reporter`] instance. +#' +#' @return `shiny::moduleServer` +#' @export +report_load_srv <- function(id, reporter) { + checkmate::assert_class(reporter, "Reporter") + + shiny::moduleServer( + id, + function(input, output, session) { + shiny::setBookmarkExclude(c("reporter_load_main", "reporter_load")) + ns <- session$ns + + archiver_modal <- function() { + nr_cards <- length(reporter$get_cards()) + shiny::modalDialog( + easyClose = TRUE, + shiny::tags$h3("Load the Report"), + shiny::tags$hr(), + shiny::fileInput(ns("archiver_zip"), "Choose saved Reporter file to Load (a zip file)", + multiple = FALSE, + accept = c(".zip") + ), + footer = shiny::div( + shiny::tags$button( + type = "button", + class = "btn btn-danger", + `data-dismiss` = "modal", + `data-bs-dismiss` = "modal", + NULL, + "Cancel" + ), + shiny::tags$button( + id = ns("reporter_load_main"), + type = "button", + class = "btn btn-primary action-button", + NULL, + "Load" + ) + ) + ) + } + + shiny::observeEvent(input$reporter_load, { + shiny::showModal(archiver_modal()) + }) + + shiny::observeEvent(input$reporter_load_main, { + load_json_report(reporter, input$archiver_zip[["datapath"]], input$archiver_zip[["name"]]) + shiny::removeModal() + }) + } + ) +} + +#' @keywords internal +load_json_report <- function(reporter, zip_path, filename) { + tmp_dir <- tempdir() + output_dir <- file.path(tmp_dir, sprintf("report_load_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) + dir.create(path = output_dir) + if (!is.null(zip_path) && grepl("report_", filename)) { + tryCatch( + expr = zip::unzip(zip_path, exdir = output_dir, junkpaths = TRUE), + warning = function(cond) { + print(cond) + shiny::showNotification( + ui = "Unzipping folder warning!", + action = "Please contact app developer", + type = "warning" + ) + }, + error = function(cond) { + print(cond) + shiny::showNotification( + ui = "Unzipping folder error!", + action = "Please contact app developer", + type = "error" + ) + } + ) + tryCatch( + reporter$from_jsondir(output_dir), + warning = function(cond) { + print(cond) + shiny::showNotification( + ui = "Loading reporter warning!", + action = "Please contact app developer", + type = "warning" + ) + }, + error = function(cond) { + print(cond) + shiny::showNotification( + ui = "Loading reporter error!", + action = "Please contact app developer", + type = "error" + ) + } + ) + + } else { + shiny::showNotification("Failed to load the Reporter file.", type = "error") + } +} diff --git a/R/Previewer.R b/R/Previewer.R index 45fce4c7..ab3b4e33 100644 --- a/R/Previewer.R +++ b/R/Previewer.R @@ -18,6 +18,9 @@ #' @param reporter (`Reporter`) instance. #' @param global_knitr (`list`) of `knitr` parameters (passed to `knitr::opts_chunk$set`) #' for customizing the rendering process. +#' @param previewer_buttons (`character`) set of modules to include with `c("download", "load", "reset")` possible +#' values and `"download"` is required. +#' Default `c("download", "load", "reset")` #' @inheritParams reporter_download_inputs #' #' @return `NULL`. @@ -56,11 +59,15 @@ reporter_previewer_srv <- function(id, "html" = "html_document", "pdf" = "pdf_document", "powerpoint" = "powerpoint_presentation", "word" = "word_document" - ), rmd_yaml_args = list( + ), + rmd_yaml_args = list( author = "NEST", title = "Report", date = as.character(Sys.Date()), output = "html_document", toc = FALSE - )) { + ), + previewer_buttons = c("download", "load", "reset")) { + checkmate::assert_subset(previewer_buttons, c("download", "load", "reset"), empty.ok = FALSE) + checkmate::assert_true("download" %in% previewer_buttons) checkmate::assert_class(reporter, "Reporter") checkmate::assert_subset(names(global_knitr), names(knitr::opts_chunk$get())) checkmate::assert_subset( @@ -81,13 +88,18 @@ reporter_previewer_srv <- function(id, shiny::moduleServer(id, function(input, output, session) { shiny::setBookmarkExclude(c( - "card_remove_id", "card_down_id", "card_up_id", "remove_card_ok", "showrcode", "download_data_prev" + "card_remove_id", "card_down_id", "card_up_id", "remove_card_ok", "showrcode", "download_data_prev", + "load_reporter_previewer", "load_reporter" )) + session$onBookmark(function(state) { - state$values$report_cards <- reporter$get_cards() + reporterdir <- file.path(state$dir, "reporter") + dir.create(reporterdir) + reporter$to_jsondir(reporterdir) }) session$onRestored(function(state) { - reporter$append_cards(state$values$report_cards) + reporterdir <- file.path(state$dir, "reporter") + reporter$from_jsondir(reporterdir) }) ns <- session$ns @@ -96,27 +108,48 @@ reporter_previewer_srv <- function(id, output$encoding <- shiny::renderUI({ reporter$get_reactive_add_card() - shiny::tagList( - shiny::tags$h3("Download the Report"), - shiny::tags$hr(), - reporter_download_inputs( - rmd_yaml_args = rmd_yaml_args, - rmd_output = rmd_output, - showrcode = any_rcode_block(reporter), - session = session - ), - htmltools::tagAppendAttributes( + nr_cards <- length(reporter$get_cards()) + + previewer_buttons_list <- list( + download = htmltools::tagAppendAttributes( shiny::tags$a( id = ns("download_data_prev"), - class = "btn btn-primary shiny-download-link", + class = "btn btn-primary shiny-download-link simple_report_button", href = "", target = "_blank", download = NA, shiny::tags$span("Download Report", shiny::icon("download")) ), - class = if (length(reporter$get_cards())) "" else "disabled" + class = if (nr_cards) "" else "disabled" ), - reset_report_button_ui(ns("resetButtonPreviewer"), label = "Reset Report") + load = shiny::tags$button( + id = ns("load_reporter_previewer"), + type = "button", + class = "btn btn-primary action-button simple_report_button", + `data-val` = shiny::restoreInput(id = ns("load_reporter_previewer"), default = NULL), + NULL, + shiny::tags$span( + "Load Report", shiny::icon("upload") + ) + ), + reset = reset_report_button_ui(ns("resetButtonPreviewer"), label = "Reset Report") + ) + + shiny::tags$div( + id = "previewer_reporter_encoding", + shiny::tags$h3("Download the Report"), + shiny::tags$hr(), + reporter_download_inputs( + rmd_yaml_args = rmd_yaml_args, + rmd_output = rmd_output, + showrcode = any_rcode_block(reporter), + session = session + ), + shiny::tags$div( + id = "previewer_reporter_buttons", + class = "previewer_buttons_line", + previewer_buttons_list[previewer_buttons] + ) ) }) @@ -147,6 +180,48 @@ reporter_previewer_srv <- function(id, } }) + shiny::observeEvent(input$load_reporter_previewer, { + nr_cards <- length(reporter$get_cards()) + shiny::showModal( + shiny::modalDialog( + easyClose = TRUE, + shiny::tags$h3("Load the Reporter"), + shiny::tags$hr(), + shiny::fileInput(ns("archiver_zip"), "Choose Reporter File to Load (a zip file)", + multiple = FALSE, + accept = c(".zip") + ), + footer = shiny::div( + shiny::tags$button( + type = "button", + class = "btn btn-danger", + `data-dismiss` = "modal", + `data-bs-dismiss` = "modal", + NULL, + "Cancel" + ), + shiny::tags$button( + id = ns("load_reporter"), + type = "button", + class = "btn btn-primary action-button", + `data-val` = shiny::restoreInput(id = ns("load_reporter"), default = NULL), + NULL, + "Load" + ) + ) + ) + ) + }) + + shiny::observeEvent(input$load_reporter, { + switch("JSON", + JSON = load_json_report(reporter, input$archiver_zip[["datapath"]], input$archiver_zip[["name"]]), + stop("The provided Reporter file format is not supported") + ) + + shiny::removeModal() + }) + shiny::observeEvent(input$card_remove_id, { shiny::showModal( shiny::modalDialog( @@ -199,7 +274,12 @@ reporter_previewer_srv <- function(id, output$download_data_prev <- shiny::downloadHandler( filename = function() { - paste("report_", format(Sys.time(), "%y%m%d%H%M%S"), ".zip", sep = "") + paste0( + "report_", + if (reporter$get_id() == "") NULL else paste0(reporter$get_id(), "_"), + format(Sys.time(), "%y%m%d%H%M%S"), + ".zip" + ) }, content = function(file) { shiny::showNotification("Rendering and Downloading the document.") diff --git a/R/ReportCard.R b/R/ReportCard.R index d906f739..b8f08a21 100644 --- a/R/ReportCard.R +++ b/R/ReportCard.R @@ -162,7 +162,7 @@ ReportCard <- R6::R6Class( # nolint: object_name_linter. #' @examples #' ReportCard$new()$set_name("NAME")$get_name() set_name = function(name) { - checkmate::assert_string(name) + checkmate::assert_character(name) private$name <- name invisible(self) }, @@ -184,12 +184,11 @@ ReportCard <- R6::R6Class( # nolint: object_name_linter. new_blocks <- list() for (block in self$get_content()) { block_class <- class(block)[1] - cblock <- if (inherits(block, "FileBlock")) { + formal_args <- formalArgs(block$to_list) + cblock <- if ("output_dir" %in% formal_args) { block$to_list(output_dir) - } else if (inherits(block, "ContentBlock")) { - block$to_list() } else { - list() + block$to_list() } new_block <- list() new_block[[block_class]] <- cblock @@ -198,6 +197,7 @@ ReportCard <- R6::R6Class( # nolint: object_name_linter. new_card <- list() new_card[["blocks"]] <- new_blocks new_card[["metadata"]] <- self$get_metadata() + new_card[["name"]] <- self$get_name() new_card }, #' @description Reconstructs the `ReportCard` from a list representation. @@ -219,24 +219,28 @@ ReportCard <- R6::R6Class( # nolint: object_name_linter. self$reset() blocks <- card$blocks metadata <- card$metadata + name <- card$name + if (length(name) == 0) name <- character(0) blocks_names <- names(blocks) blocks_names <- gsub("[.][0-9]*$", "", blocks_names) for (iter_b in seq_along(blocks)) { block_class <- blocks_names[iter_b] block <- blocks[[iter_b]] - cblock <- eval(str2lang(sprintf("%s$new()", block_class))) - if (inherits(cblock, "FileBlock")) { - cblock$from_list(block, output_dir) - } else if (inherits(cblock, "ContentBlock")) { - cblock$from_list(block) + instance <- private$dispatch_block(block_class) + formal_args <- formalArgs(instance$new()$from_list) + cblock <- if (all(c("x", "output_dir") %in% formal_args)) { + instance$new()$from_list(block, output_dir) + } else if ("x" %in% formal_args) { + instance$new()$from_list(block) } else { - NULL + instance$new()$from_list() } self$append_content(cblock) } for (meta in names(metadata)) { self$append_metadata(meta, metadata[[meta]]) } + self$set_name(name) invisible(self) } ), @@ -244,6 +248,9 @@ ReportCard <- R6::R6Class( # nolint: object_name_linter. content = list(), metadata = list(), name = character(0), + dispatch_block = function(block_class) { + eval(str2lang(block_class)) + }, # @description The copy constructor. # # @param name the name of the field diff --git a/R/Reporter.R b/R/Reporter.R index 118ec180..394531c9 100644 --- a/R/Reporter.R +++ b/R/Reporter.R @@ -208,7 +208,7 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. #' @description #' Reinitializes a `Reporter` instance by copying the report cards and metadata from another `Reporter`. #' @param reporter (`Reporter`) instance to copy from. - #' @return `self`, invisibly. + #' @return invisibly self #' @examples #' reporter <- Reporter$new() #' reporter$from_reporter(reporter) @@ -223,7 +223,6 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. #' @param output_dir (`character(1)`) a path to the directory where files will be copied. #' @return `named list` representing the `Reporter` instance, including version information, #' metadata, and report cards. - #' #' @examples #' reporter <- Reporter$new() #' tmp_dir <- file.path(tempdir(), "testdir") @@ -231,7 +230,7 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. #' reporter$to_list(tmp_dir) to_list = function(output_dir) { checkmate::assert_directory_exists(output_dir) - rlist <- list(version = "1", cards = list()) + rlist <- list(name = "teal Reporter", version = "1", id = self$get_id(), cards = list()) rlist[["metadata"]] <- self$get_metadata() for (card in self$get_cards()) { # we want to have list names being a class names to indicate the class for $from_list @@ -246,6 +245,7 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. #' @param rlist (`named list`) representing a `Reporter` instance. #' @param output_dir (`character(1)`) a path to the directory from which files will be copied. #' @return `self`, invisibly. + #' @note if Report has an id when converting to JSON then It will be compared to the currently available one. #' @examples #' reporter <- Reporter$new() #' tmp_dir <- file.path(tempdir(), "testdir") @@ -253,23 +253,32 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. #' dir.create(tmp_dir) #' reporter$from_list(reporter$to_list(tmp_dir), tmp_dir) from_list = function(rlist, output_dir) { + id <- self$get_id() checkmate::assert_list(rlist) checkmate::assert_directory_exists(output_dir) - if (rlist$version == "1") { + stopifnot("Report JSON has to have name slot equal to teal Reporter" = rlist$name == "teal Reporter") + stopifnot("Loaded Report id has to match the current instance one" = rlist$id == id) + if (rlist$version %in% c("1")) { new_cards <- list() cards_names <- names(rlist$cards) cards_names <- gsub("[.][0-9]*$", "", cards_names) for (iter_c in seq_along(rlist$cards)) { card_class <- cards_names[iter_c] card <- rlist$cards[[iter_c]] - new_card <- eval(str2lang(sprintf("%s$new()", card_class))) + new_card <- eval(str2lang(card_class))$new() new_card$from_list(card, output_dir) new_cards <- c(new_cards, new_card) } } else { - stop("The provided version is not supported") + stop( + sprintf( + "The provided %s reporter version is not supported.", + rlist$version + ) + ) } self$reset() + self$set_id(rlist$id) self$append_cards(new_cards) self$append_metadata(rlist$metadata) invisible(self) @@ -285,7 +294,8 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. to_jsondir = function(output_dir) { checkmate::assert_directory_exists(output_dir) json <- self$to_list(output_dir) - cat(jsonlite::toJSON(json, auto_unbox = TRUE, force = TRUE), + cat( + jsonlite::toJSON(json, auto_unbox = TRUE, force = TRUE), file = file.path(output_dir, "Report.json") ) output_dir @@ -293,6 +303,7 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. #' @description Reinitializes a `Reporter` from a `JSON ` file and files in a specified directory. #' @param output_dir (`character(1)`) a path to the directory with files, `JSON` and statics. #' @return `self`, invisibly. + #' @note if Report has an id when converting to JSON then It will be compared to the currently available one. #' @examples #' reporter <- Reporter$new() #' tmp_dir <- file.path(tempdir(), "jsondir") @@ -302,16 +313,31 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. #' reporter$from_jsondir(tmp_dir) from_jsondir = function(output_dir) { checkmate::assert_directory_exists(output_dir) - checkmate::assert_true(length(list.files(output_dir)) > 0) dir_files <- list.files(output_dir) - which_json <- grep("json$", dir_files) - json <- jsonlite::read_json(file.path(output_dir, dir_files[which_json])) + stopifnot("There has to be at least one file in the loaded directory" = length(dir_files) > 0) + stopifnot("Report.json file has to be in the loaded directory" = "Report.json" %in% basename(dir_files)) + json <- jsonlite::read_json(file.path(output_dir, "Report.json")) self$reset() self$from_list(json, output_dir) invisible(self) + }, + #' @description Set the `Reporter` id + #' Optionally add id to a `Reporter` which will be compared when it is rebuilt from a list. + #' The id is added to the downloaded file name. + #' @param id (`character(1)`) a Report id. + #' @return `self`, invisibly. + set_id = function(id) { + private$id <- id + invisible(self) + }, + #' @description Get the `Reporter` id + #' @return `character(1)` the `Reporter` id. + get_id = function() { + private$id } ), private = list( + id = "", cards = list(), metadata = list(), reactive_add_card = NULL, diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index ce11071e..c912da38 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -36,7 +36,9 @@ NULL #' @rdname simple_reporter #' @export -simple_reporter_ui <- function(id) { +simple_reporter_ui <- function( + id +) { ns <- shiny::NS(id) shiny::tagList( shiny::singleton( @@ -49,6 +51,7 @@ simple_reporter_ui <- function(id) { class = "simple_reporter_container", add_card_button_ui(ns("add_report_card_simple")), download_report_button_ui(ns("download_button_simple")), + report_load_ui(ns("archive_load_simple")), reset_report_button_ui(ns("reset_button_simple")) ) ) @@ -57,19 +60,21 @@ simple_reporter_ui <- function(id) { #' @rdname simple_reporter #' @export -simple_reporter_srv <- function(id, - reporter, - card_fun, - global_knitr = getOption("teal.reporter.global_knitr"), - rmd_output = c( - "html" = "html_document", "pdf" = "pdf_document", - "powerpoint" = "powerpoint_presentation", "word" = "word_document" - ), - rmd_yaml_args = list( - author = "NEST", title = "Report", - date = as.character(Sys.Date()), output = "html_document", - toc = FALSE - )) { +simple_reporter_srv <- function( + id, + reporter, + card_fun, + global_knitr = getOption("teal.reporter.global_knitr"), + rmd_output = c( + "html" = "html_document", "pdf" = "pdf_document", + "powerpoint" = "powerpoint_presentation", "word" = "word_document" + ), + rmd_yaml_args = list( + author = "NEST", title = "Report", + date = as.character(Sys.Date()), output = "html_document", + toc = FALSE + ) +) { shiny::moduleServer( id, function(input, output, session) { @@ -81,6 +86,7 @@ simple_reporter_srv <- function(id, rmd_output = rmd_output, rmd_yaml_args = rmd_yaml_args ) + report_load_srv("archive_load_simple", reporter = reporter) reset_report_button_srv("reset_button_simple", reporter = reporter) } ) diff --git a/_pkgdown.yml b/_pkgdown.yml index a842a830..f52a8f87 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -37,6 +37,8 @@ reference: - download_report_button_ui - reset_report_button_srv - reset_report_button_ui + - report_load_srv + - report_load_ui - title: "`yaml` and rmd utility functions" contents: - as_yaml_auto diff --git a/inst/WORDLIST b/inst/WORDLIST index 52b6a5b1..15c5a3b6 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -10,3 +10,4 @@ cloneable funder repo rmarkdown +JSON diff --git a/inst/css/Previewer.css b/inst/css/Previewer.css index dc491249..c5df266a 100644 --- a/inst/css/Previewer.css +++ b/inst/css/Previewer.css @@ -5,6 +5,11 @@ span.preview_card_control i:hover { color: blue; } +.previewer_buttons_line { + display: flex; + justify-content: end; + margin-right: 10px; +} /* Disable any anchor with disabled class */ a.disabled { diff --git a/inst/css/custom.css b/inst/css/custom.css index 826a7957..481596e5 100644 --- a/inst/css/custom.css +++ b/inst/css/custom.css @@ -16,6 +16,10 @@ display: flex; } +.float-right { + float: right; +} + .justify-start { justify-content: flex-start; } diff --git a/man/Archiver.Rd b/man/Archiver.Rd deleted file mode 100644 index d5231ea9..00000000 --- a/man/Archiver.Rd +++ /dev/null @@ -1,101 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Archiver.R -\docType{class} -\name{Archiver} -\alias{Archiver} -\title{\code{Archiver}: Base class for data archiving} -\description{ -A base \code{R6} class for implementing data archiving functionality. -} -\examples{ - -## ------------------------------------------------ -## Method `Archiver$new` -## ------------------------------------------------ - -Archiver <- getFromNamespace("Archiver", "teal.reporter") -Archiver$new() -} -\keyword{internal} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-Archiver-new}{\code{Archiver$new()}} -\item \href{#method-Archiver-finalize}{\code{Archiver$finalize()}} -\item \href{#method-Archiver-read}{\code{Archiver$read()}} -\item \href{#method-Archiver-write}{\code{Archiver$write()}} -\item \href{#method-Archiver-clone}{\code{Archiver$clone()}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Archiver-new}{}}} -\subsection{Method \code{new()}}{ -Initialize an \code{Archiver} object. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Archiver$new()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -Object of class \code{Archiver}, invisibly. -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{Archiver <- getFromNamespace("Archiver", "teal.reporter") -Archiver$new() -} -\if{html}{\out{
}} - -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Archiver-finalize}{}}} -\subsection{Method \code{finalize()}}{ -Finalizes an \code{Archiver} object. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Archiver$finalize()}\if{html}{\out{
}} -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Archiver-read}{}}} -\subsection{Method \code{read()}}{ -Reads data from the \code{Archiver}. -Pure virtual method that should be implemented by inherited classes. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Archiver$read()}\if{html}{\out{
}} -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Archiver-write}{}}} -\subsection{Method \code{write()}}{ -Writes data to the \code{Archiver}. -Pure virtual method that should be implemented by inherited classes. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Archiver$write()}\if{html}{\out{
}} -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Archiver-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Archiver$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/FileArchiver.Rd b/man/FileArchiver.Rd deleted file mode 100644 index 2a705ba3..00000000 --- a/man/FileArchiver.Rd +++ /dev/null @@ -1,120 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Archiver.R -\docType{class} -\name{FileArchiver} -\alias{FileArchiver} -\title{\code{FileArchiver}: A File-based \code{Archiver}} -\description{ -Inherits from \code{Archiver} to provide file-based archiving functionality. -Manages an output directory for storing archived data. -} -\examples{ - -## ------------------------------------------------ -## Method `FileArchiver$new` -## ------------------------------------------------ - -FileArchiver <- getFromNamespace("FileArchiver", "teal.reporter") -FileArchiver$new() - -## ------------------------------------------------ -## Method `FileArchiver$get_output_dir` -## ------------------------------------------------ - -FileArchiver <- getFromNamespace("FileArchiver", "teal.reporter") -FileArchiver$new()$get_output_dir() -} -\keyword{internal} -\section{Super class}{ -\code{\link[teal.reporter:Archiver]{teal.reporter::Archiver}} -> \code{FileArchiver} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-FileArchiver-new}{\code{FileArchiver$new()}} -\item \href{#method-FileArchiver-finalize}{\code{FileArchiver$finalize()}} -\item \href{#method-FileArchiver-get_output_dir}{\code{FileArchiver$get_output_dir()}} -\item \href{#method-FileArchiver-clone}{\code{FileArchiver$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-FileArchiver-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{FileArchiver} object with a unique output directory. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{FileArchiver$new()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -Object of class \code{FileArchiver}, invisibly. -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{FileArchiver <- getFromNamespace("FileArchiver", "teal.reporter") -FileArchiver$new() -} -\if{html}{\out{
}} - -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-FileArchiver-finalize}{}}} -\subsection{Method \code{finalize()}}{ -Finalizes a \code{FileArchiver} object. -Cleans up by removing the output directory and its contents. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{FileArchiver$finalize()}\if{html}{\out{
}} -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-FileArchiver-get_output_dir}{}}} -\subsection{Method \code{get_output_dir()}}{ -Get \code{output_dir} field. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{FileArchiver$get_output_dir()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} a \code{output_dir} field path. -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{FileArchiver <- getFromNamespace("FileArchiver", "teal.reporter") -FileArchiver$new()$get_output_dir() -} -\if{html}{\out{
}} - -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-FileArchiver-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{FileArchiver$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/JSONArchiver.Rd b/man/JSONArchiver.Rd deleted file mode 100644 index 59cab635..00000000 --- a/man/JSONArchiver.Rd +++ /dev/null @@ -1,208 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Archiver.R -\docType{class} -\name{JSONArchiver} -\alias{JSONArchiver} -\title{\code{JSONArchiver}: A \code{JSON}-based \code{Archiver}} -\description{ -Inherits from \code{FileArchiver} to implement \code{JSON}-based archiving functionality. -Convert \code{Reporter} instances to and from \code{JSON} format. -} -\examples{ - -## ------------------------------------------------ -## Method `JSONArchiver$write` -## ------------------------------------------------ - -library(ggplot2) - -ReportCard <- getFromNamespace("ReportCard", "teal.reporter") -card1 <- ReportCard$new() - -card1$append_text("Header 2 text", "header2") -card1$append_text("A paragraph of default text", "header2") -card1$append_plot( - ggplot(iris, aes(x = Petal.Length)) + geom_histogram() -) - -Reporter <- getFromNamespace("Reporter", "teal.reporter") -reporter <- Reporter$new() -reporter$append_cards(list(card1)) - -JSONArchiver <- getFromNamespace("JSONArchiver", "teal.reporter") -archiver <- JSONArchiver$new() -archiver$write(reporter) -archiver$get_output_dir() - -## ------------------------------------------------ -## Method `JSONArchiver$read` -## ------------------------------------------------ - -library(ggplot2) - -ReportCard <- getFromNamespace("ReportCard", "teal.reporter") -card1 <- ReportCard$new() - -card1$append_text("Header 2 text", "header2") -card1$append_text("A paragraph of default text", "header2") -card1$append_plot( - ggplot(iris, aes(x = Petal.Length)) + geom_histogram() -) - -Reporter <- getFromNamespace("Reporter", "teal.reporter") -reporter <- Reporter$new() -reporter$append_cards(list(card1)) - -JSONArchiver <- getFromNamespace("JSONArchiver", "teal.reporter") -archiver <- JSONArchiver$new() -archiver$write(reporter) -archiver$get_output_dir() - -archiver$read()$get_cards()[[1]]$get_content() -Reporter <- getFromNamespace("Reporter", "teal.reporter") -blocks <- Reporter$new() -blocks <- blocks$from_reporter(archiver$read())$get_blocks() -Renderer <- getFromNamespace("Renderer", "teal.reporter") -doc <- Renderer$new()$render(blocks) -} -\keyword{internal} -\section{Super classes}{ -\code{\link[teal.reporter:Archiver]{teal.reporter::Archiver}} -> \code{\link[teal.reporter:FileArchiver]{teal.reporter::FileArchiver}} -> \code{JSONArchiver} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-JSONArchiver-write}{\code{JSONArchiver$write()}} -\item \href{#method-JSONArchiver-read}{\code{JSONArchiver$read()}} -\item \href{#method-JSONArchiver-clone}{\code{JSONArchiver$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-JSONArchiver-write}{}}} -\subsection{Method \code{write()}}{ -Write a \code{Reporter} instance in \code{JSON} file. -Serializes a given \code{Reporter} instance and saves it in the \code{Archiver}'s output directory, -to this \code{JSONArchiver} object. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{JSONArchiver$write(reporter)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{reporter}}{(\code{Reporter}) instance.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{self}. -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{library(ggplot2) - -ReportCard <- getFromNamespace("ReportCard", "teal.reporter") -card1 <- ReportCard$new() - -card1$append_text("Header 2 text", "header2") -card1$append_text("A paragraph of default text", "header2") -card1$append_plot( - ggplot(iris, aes(x = Petal.Length)) + geom_histogram() -) - -Reporter <- getFromNamespace("Reporter", "teal.reporter") -reporter <- Reporter$new() -reporter$append_cards(list(card1)) - -JSONArchiver <- getFromNamespace("JSONArchiver", "teal.reporter") -archiver <- JSONArchiver$new() -archiver$write(reporter) -archiver$get_output_dir() -} -\if{html}{\out{
}} - -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-JSONArchiver-read}{}}} -\subsection{Method \code{read()}}{ -Read a \code{Reporter} instance from a \code{JSON} file. -Converts a \code{Reporter} instance from the \code{JSON} file in the \code{JSONArchiver}'s output directory. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{JSONArchiver$read(path = NULL)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{path}}{(\code{character(1)}) a path to the directory with all proper files.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{Reporter} instance. -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{library(ggplot2) - -ReportCard <- getFromNamespace("ReportCard", "teal.reporter") -card1 <- ReportCard$new() - -card1$append_text("Header 2 text", "header2") -card1$append_text("A paragraph of default text", "header2") -card1$append_plot( - ggplot(iris, aes(x = Petal.Length)) + geom_histogram() -) - -Reporter <- getFromNamespace("Reporter", "teal.reporter") -reporter <- Reporter$new() -reporter$append_cards(list(card1)) - -JSONArchiver <- getFromNamespace("JSONArchiver", "teal.reporter") -archiver <- JSONArchiver$new() -archiver$write(reporter) -archiver$get_output_dir() - -archiver$read()$get_cards()[[1]]$get_content() -Reporter <- getFromNamespace("Reporter", "teal.reporter") -blocks <- Reporter$new() -blocks <- blocks$from_reporter(archiver$read())$get_blocks() -Renderer <- getFromNamespace("Renderer", "teal.reporter") -doc <- Renderer$new()$render(blocks) -} -\if{html}{\out{
}} - -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-JSONArchiver-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{JSONArchiver$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/Reporter.Rd b/man/Reporter.Rd index dddbb92b..d36b4463 100644 --- a/man/Reporter.Rd +++ b/man/Reporter.Rd @@ -12,6 +12,10 @@ facilitating the creation, manipulation, and serialization of report-related dat } \note{ The function has to be used in the shiny reactive context. + +if Report has an id when converting to JSON then It will be compared to the currently available one. + +if Report has an id when converting to JSON then It will be compared to the currently available one. } \examples{ @@ -194,6 +198,8 @@ reporter$from_jsondir(tmp_dir) \item \href{#method-Reporter-from_list}{\code{Reporter$from_list()}} \item \href{#method-Reporter-to_jsondir}{\code{Reporter$to_jsondir()}} \item \href{#method-Reporter-from_jsondir}{\code{Reporter$from_jsondir()}} +\item \href{#method-Reporter-set_id}{\code{Reporter$set_id()}} +\item \href{#method-Reporter-get_id}{\code{Reporter$get_id()}} \item \href{#method-Reporter-clone}{\code{Reporter$clone()}} } } @@ -511,7 +517,7 @@ Reinitializes a \code{Reporter} instance by copying the report cards and metadat \if{html}{\out{}} } \subsection{Returns}{ -\code{self}, invisibly. +invisibly self } \subsection{Examples}{ \if{html}{\out{
}} @@ -652,6 +658,41 @@ reporter$from_jsondir(tmp_dir) } +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Reporter-set_id}{}}} +\subsection{Method \code{set_id()}}{ +Set the \code{Reporter} id +Optionally add id to a \code{Reporter} which will be compared when it is rebuilt from a list. +The id is added to the downloaded file name. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Reporter$set_id(id)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{id}}{(\code{character(1)}) a Report id.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +\code{self}, invisibly. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Reporter-get_id}{}}} +\subsection{Method \code{get_id()}}{ +Get the \code{Reporter} id +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Reporter$get_id()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +\code{character(1)} the \code{Reporter} id. +} } \if{html}{\out{
}} \if{html}{\out{}} diff --git a/man/report_load_srv.Rd b/man/report_load_srv.Rd new file mode 100644 index 00000000..ae823e9b --- /dev/null +++ b/man/report_load_srv.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LoadReporterModule.R +\name{report_load_srv} +\alias{report_load_srv} +\title{Server to Load \code{Reporter}} +\usage{ +report_load_srv(id, reporter) +} +\arguments{ +\item{id}{\code{character(1)} this \code{shiny} module's id.} + +\item{reporter}{\code{\link{Reporter}} instance.} +} +\value{ +\code{shiny::moduleServer} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +Server to load \code{ReporterCard}(s) to the \code{Reporter} + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. +} diff --git a/man/report_load_ui.Rd b/man/report_load_ui.Rd new file mode 100644 index 00000000..f4267306 --- /dev/null +++ b/man/report_load_ui.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LoadReporterModule.R +\name{report_load_ui} +\alias{report_load_ui} +\title{User Interface to Load \code{Reporter}} +\usage{ +report_load_ui(id) +} +\arguments{ +\item{id}{\code{character(1)} this \code{shiny} module's id.} +} +\value{ +\code{shiny::tagList} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +Button to upload \code{ReporterCard}(s) to the \code{Reporter}. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. +} diff --git a/man/reporter_previewer.Rd b/man/reporter_previewer.Rd index c4667414..40912870 100644 --- a/man/reporter_previewer.Rd +++ b/man/reporter_previewer.Rd @@ -15,7 +15,8 @@ reporter_previewer_srv( rmd_output = c(html = "html_document", pdf = "pdf_document", powerpoint = "powerpoint_presentation", word = "word_document"), rmd_yaml_args = list(author = "NEST", title = "Report", date = - as.character(Sys.Date()), output = "html_document", toc = FALSE) + as.character(Sys.Date()), output = "html_document", toc = FALSE), + previewer_buttons = c("download", "load", "reset") ) } \arguments{ @@ -35,6 +36,10 @@ This \code{list} will result in the custom subset of UI inputs for the download Default \code{list(author = "NEST", title = "Report", date = Sys.Date(), output = "html_document", toc = FALSE)}. The \code{list} must include at least \code{"output"} field. The default value for \code{"output"} has to be in the \code{rmd_output} argument.} + +\item{previewer_buttons}{(\code{character}) set of modules to include with \code{c("download", "load", "reset")} possible +values and \code{"download"} is required. +Default \code{c("download", "load", "reset")}} } \value{ \code{NULL}. diff --git a/tests/testthat/test-Archiver.R b/tests/testthat/test-Archiver.R deleted file mode 100644 index 9cf88f94..00000000 --- a/tests/testthat/test-Archiver.R +++ /dev/null @@ -1,152 +0,0 @@ -card1 <- ReportCard$new() - -card1$append_text("Header 2 text", "header2") -card1$append_text("A paragraph of default text", "header2") -card1$append_plot( - ggplot2::ggplot(iris, ggplot2::aes(x = Petal.Length)) + - ggplot2::geom_histogram() -) - -card2 <- ReportCard$new() - -card2$append_text("Header 2 text", "header2") -card2$append_text("A paragraph of default text", "header2") -lyt <- rtables::analyze(rtables::split_rows_by(rtables::basic_table(), "Day"), "Ozone", afun = mean) -table_res2 <- rtables::build_table(lyt, airquality) -# https://github.com/davidgohel/flextable/issues/600 -withr::with_options( - opts_partial_match_old, - { - card2$append_table(table_res2) - card2$append_table(iris) - } -) - -reporter <- Reporter$new() -reporter$append_cards(list(card1, card2)) - -testthat::test_that("intialize Archiver", { - testthat::expect_no_error(Archiver$new()) -}) - -testthat::test_that("new returns an object of type Archiver", { - testthat::expect_true(inherits(Archiver$new(), "Archiver")) -}) - -testthat::test_that("Archiver errors with the abstract methods", { - archiver <- Archiver$new() - testthat::expect_error(archiver$read(), "Pure virtual method") - testthat::expect_error(archiver$write(), "Pure virtual method") -}) - -testthat::test_that("intialize FileArchiver", { - testthat::expect_no_error(FileArchiver$new()) -}) - -testthat::test_that("FileArchiver creates a temp directory when initialized", { - archiver <- FileArchiver$new() - testthat::expect_true(dir.exists(archiver$get_output_dir())) -}) - -testthat::test_that("FileArchiver creates a temp directory when initialized, with a proper name", { - archiver <- FileArchiver$new() - testthat::expect_true(grepl("archive_[0-9]{18,18}$", archiver$get_output_dir())) -}) - -testthat::test_that("FileArchiver dectructor removes the temp dir", { - archiver <- FileArchiver$new() - temp_dir <- archiver$get_output_dir() - testthat::expect_true(dir.exists(temp_dir)) - rm(archiver) - # we need a garbage collector - gc() - testthat::expect_false(dir.exists(temp_dir)) -}) - -testthat::test_that("intialize JSONArchiver", { - testthat::expect_no_error(JSONArchiver$new()) -}) - -testthat::test_that("JSONArchiver creates a temp directory when initialized", { - archiver <- JSONArchiver$new() - testthat::expect_true(dir.exists(archiver$get_output_dir())) -}) - -testthat::test_that("JSONArchiver dectructor removes the temp dir", { - archiver <- JSONArchiver$new() - temp_dir <- archiver$get_output_dir() - testthat::expect_true(dir.exists(temp_dir)) - rm(archiver) - # we need a garbage collector - gc() - testthat::expect_false(dir.exists(temp_dir)) -}) - -archiver <- JSONArchiver$new() - -testthat::test_that("JSONArchiver write a reporter", { - testthat::expect_no_error(archiver$write(reporter)) -}) - -path_with_files <- archiver$get_output_dir() - -testthat::test_that("JSONArchiver write a reporter with a json file and static files", { - testthat::expect_true(dir.exists(archiver$get_output_dir())) - files <- list.files(archiver$get_output_dir()) - testthat::expect_true(length(files) == 4) - testthat::expect_true("Report.json" %in% files) -}) - -testthat::test_that("JSONArchiver read back the Reporter instance", { - testthat::expect_s3_class(archiver$read(), "Reporter") - testthat::expect_length(archiver$read()$get_cards(), 2L) - testthat::expect_length(archiver$read()$get_blocks(), 8L) -}) - -testthat::test_that("JSONArchiver read back and all table/picture statics exists", { - gc() - file_blocks <- Filter( - function(x) inherits(x, "PictureBlock") || inherits(x, "TableBlock"), - archiver$read()$get_blocks() - ) - testthat::expect_true(all(vapply(file_blocks, function(f) file.exists(f$get_content()), logical(1)))) -}) - -archiver2 <- JSONArchiver$new() -testthat::test_that("JSONArchiver read back the Reporter instance, from a path", { - reporter_temp <- archiver2$read(path_with_files) - testthat::expect_s3_class(reporter_temp, "Reporter") - testthat::expect_length(reporter_temp$get_cards(), 2L) - testthat::expect_length(reporter_temp$get_blocks(), 8L) -}) - -testthat::test_that("JSONArchiver read back and all table/picture statics exists, from a path", { - gc() - file_blocks <- Filter( - function(x) inherits(x, "PictureBlock") || inherits(x, "TableBlock"), - archiver2$read(path_with_files)$get_blocks() - ) - testthat::expect_true(all(vapply(file_blocks, function(f) file.exists(f$get_content()), logical(1)))) -}) - -testthat::test_that("JSONArchiver with an empty dir", { - temp_dir <- file.path(tempdir(), "test") - dir.create(temp_dir) - - testthat::expect_warning( - archiver2$read(temp_dir), - "The directory provided to the Archiver is empty." - ) - - unlink(temp_dir, recursive = TRUE) -}) - - -testthat::test_that("JSONArchiver destructor remove its output_dir", { - archiver <- JSONArchiver$new() - archiver_path <- archiver$get_output_dir() - testthat::expect_true(dir.exists(archiver_path)) - rm(archiver) - gc() - testthat::expect_false(dir.exists(archiver_path)) -}) diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index 5c343b30..2cd3186d 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -30,6 +30,7 @@ testthat::test_that("download_report_button_srv - render and downlaod a document files <- list.files(output_dir, recursive = TRUE) testthat::expect_true(any(grepl("[.]Rmd", files))) testthat::expect_true(any(grepl("[.]html", files))) + testthat::expect_true(any(grepl("Report[.]json", files))) unlink(output_dir, recursive = TRUE) } ) @@ -129,6 +130,7 @@ testthat::test_that("report_render_and_compress - render an html document", { files <- list.files(temp_dir, recursive = TRUE) testthat::expect_true(any(grepl("[.]Rmd", files))) testthat::expect_true(any(grepl("[.]html", files))) + testthat::expect_true(any(grepl("Report[.]json", files))) }) testthat::test_that("any_rcode_block", { diff --git a/tests/testthat/test-LoadReporterModule.R b/tests/testthat/test-LoadReporterModule.R new file mode 100644 index 00000000..6723529e --- /dev/null +++ b/tests/testthat/test-LoadReporterModule.R @@ -0,0 +1,83 @@ +testthat::test_that("report_load_srv - loading reporter restores saved content", { + reporter <- Reporter$new() + reporter$set_id("xyz") + card <- teal.reporter::ReportCard$new() + + card$append_text("Header 2 text", "header2") + card$append_text("A paragraph of default text", "header2") + card$append_plot( + ggplot2::ggplot(iris, ggplot2::aes(x = Petal.Length)) + + ggplot2::geom_histogram() + ) + reporter$append_cards(list(card)) + + temp_dir <- file.path(tempdir(), "tempdir") + suppressWarnings(dir.create(temp_dir)) + unlink(list.files(temp_dir, recursive = TRUE, full.names = TRUE)) + + reporter_path <- reporter$to_jsondir(temp_dir) + + temp_zip_file <- tempfile(pattern = "report_", fileext = ".zip") + zip::zipr(temp_zip_file, reporter_path) + + shiny::testServer( + report_load_srv, + args = list(reporter = reporter), + expr = { + reporter$reset() + session$setInputs(`reporter_load` = 0) + session$setInputs( + archiver_zip = list( + datapath = temp_zip_file, + name = basename(temp_zip_file) + ) + ) + session$setInputs(`reporter_load_main` = 0) + testthat::expect_length(reporter$get_cards(), 1) + testthat::expect_length(reporter$get_blocks(), 3) + testthat::expect_s3_class(reporter$get_blocks()[[1]], "TextBlock") + testthat::expect_identical(reporter$get_blocks()[[1]]$get_content(), "Header 2 text") + testthat::expect_s3_class(reporter$get_blocks()[[2]], "TextBlock") + testthat::expect_identical(reporter$get_blocks()[[2]]$get_content(), "A paragraph of default text") + testthat::expect_s3_class(reporter$get_blocks()[[3]], "PictureBlock") + } + ) +}) + +testthat::test_that("report_load_srv - fail to load a reporter because of different id", { + reporter <- Reporter$new() + reporter$set_id("xyz") + + temp_dir <- file.path(tempdir(), "tempdir") + suppressWarnings(dir.create(temp_dir)) + unlink(list.files(temp_dir, recursive = TRUE, full.names = TRUE)) + + reporter_path <- reporter$to_jsondir(temp_dir) + + temp_zip_file <- tempfile(pattern = "report_", fileext = ".zip") + zip::zipr(temp_zip_file, reporter_path) + + reporter <- Reporter$new()$set_id("different") + + oo <- capture_output(shiny::testServer( + report_load_srv, + args = list(reporter = reporter), + expr = { + reporter$reset() + session$setInputs(`reporter_load` = 0) + session$setInputs( + archiver_zip = list( + datapath = temp_zip_file, + name = basename(temp_zip_file) + ) + ) + session$setInputs(`reporter_load_main` = 0) + } + )) + testthat::expect_true(grepl("Loaded Report id has to match the current instance one", oo)) +}) + + +testthat::test_that("report_load_ui - returns a tagList", { + testthat::expect_s3_class(report_load_ui("sth"), c("shiny.tag.list", "list")) +}) diff --git a/tests/testthat/test-ReportCard.R b/tests/testthat/test-ReportCard.R index 85bf3480..3c341468 100644 --- a/tests/testthat/test-ReportCard.R +++ b/tests/testthat/test-ReportCard.R @@ -172,7 +172,7 @@ testthat::test_that("to_list internally triggers to_list on each Block", { TextBlock = list(text = "A paragraph of default text", style = "header2"), RcodeBlock = list(text = rcode, params = list()), PictureBlock = list(basename = picture_filename) - ), metadata = list()) + ), metadata = list(), name = character(0)) ) testthat::expect_true(picture_filename %in% list.files(temp_dir)) }) diff --git a/tests/testthat/test-Reporter.R b/tests/testthat/test-Reporter.R index 6e59db1c..b5b25782 100644 --- a/tests/testthat/test-Reporter.R +++ b/tests/testthat/test-Reporter.R @@ -33,6 +33,15 @@ withr::with_options( reporter <- Reporter$new() reporter$append_cards(list(card1, card2)) +testthat::test_that("default reporter id", { + testthat::expect_identical(reporter$get_id(), "") +}) + +testthat::test_that("set_id sets the reporter id and returns reporter", { + testthat::expect_s3_class(reporter$set_id("xyz"), "Reporter") + testthat::expect_identical(reporter$set_id("xyz")$get_id(), "xyz") +}) + testthat::test_that("get_cards returns the same cards which was added to reporter", { testthat::expect_identical(reporter$get_cards(), list(card1, card2)) }) @@ -108,7 +117,6 @@ testthat::test_that("from_reporter returns identical/equal object from the same reporter1 <- Reporter$new() reporter1$append_cards(list(card1, card2)) -reporter2 <- Reporter$new() testthat::test_that("from_reporter does not return identical/equal object form other reporter", { testthat::expect_false(identical(reporter1, reporter2$from_reporter(reporter1))) @@ -125,7 +133,7 @@ testthat::test_that("from_reporter persists the reactive_add_card count", { ) }) -testthat::test_that("to_jsondir require the existing directory path", { +testthat::test_that("to_list require the existing directory path", { testthat::expect_error(reporter1$to_list(), 'argument "output_dir" is missing, with no default') testthat::expect_error(reporter1$to_list("/path/WRONG"), "Directory '/path/WRONG' does not exist.") }) @@ -134,14 +142,14 @@ temp_dir <- file.path(tempdir(), "test") unlink(temp_dir, recursive = TRUE) dir.create(temp_dir) -testthat::test_that("to_jsondir returns a list.", { +testthat::test_that("to_list returns a list.", { testthat::expect_equal( - list(version = "1", cards = list(), metadata = list()), + list(name = "teal Reporter", version = "1", id = "", cards = list(), metadata = list()), Reporter$new()$to_list(temp_dir) ) }) -testthat::test_that("to_jsondir and from_jsondir could be used to save and retrive a Reporter ", { +testthat::test_that("to_list and from_list could be used to save and retrive a Reporter ", { testthat::expect_identical( length(reporter1$get_cards()), length(Reporter$new()$from_list(reporter1$to_list(temp_dir), temp_dir)$get_cards()) diff --git a/vignettes/previewerReporter.Rmd b/vignettes/previewerReporter.Rmd index c315758a..475f66fe 100644 --- a/vignettes/previewerReporter.Rmd +++ b/vignettes/previewerReporter.Rmd @@ -77,7 +77,7 @@ server <- function(input, output, session) { output$encoding <- renderUI({ tagList( ### REPORTER - simple_reporter_ui("simple_reporter"), + teal.reporter::simple_reporter_ui("simple_reporter"), ### if (input$tabs == "Plot") { sliderInput( @@ -130,6 +130,11 @@ server <- function(input, output, session) { ### REPORTER reporter <- Reporter$new() + + # Optionally set reporter id to e.g. secure report reload only for the same app + # The id is added to the downloaded file name. + reporter$set_id("myappid") + card_fun <- function(card = ReportCard$new(), comment) { if (input$tabs == "Plot") { card$set_name("Plot Module") @@ -188,8 +193,8 @@ server <- function(input, output, session) { } card } - simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) - reporter_previewer_srv("prev", reporter) + teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) + teal.reporter::reporter_previewer_srv("prev", reporter) ### } diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index 3fe51e1e..e308ad56 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -213,6 +213,11 @@ server <- function(input, output, session) { ### REPORTER reporter <- Reporter$new() + + # Optionally set reporter id to e.g. secure report reload only for the same app + # The id is added to the downloaded file name. + reporter$set_id("myappid") + card_fun <- function(card = ReportCard$new(), comment) { if (input$tabs == "Plot") { card$append_text("My plot", "header2")