From deb145ad3c0802eca6c3bd85fe401faf6432a050 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Wed, 20 Apr 2022 15:51:05 +0200 Subject: [PATCH 01/49] init simple report --- DESCRIPTION | 5 +- NAMESPACE | 7 + R/AddCardModule.R | 83 ++++++++++++ R/DownloadModule.R | 146 +++++++++++++++++++++ R/Reporter.R | 8 ++ R/SimpleReporter.R | 30 +++++ R/utils.R | 16 +++ man/Reporter.Rd | 14 ++ man/add_card_button_srv.Rd | 21 +++ man/add_card_button_ui.Rd | 17 +++ man/download_report_button_srv.Rd | 21 +++ man/download_report_button_ui.Rd | 17 +++ man/extract_addcard_id.Rd | 18 +++ man/simple_reporter.Rd | 23 ++++ man/simple_reporter_ui.Rd | 17 +++ vignettes/.gitignore | 2 + vignettes/simpleReporter.Rmd | 204 ++++++++++++++++++++++++++++++ 17 files changed, 648 insertions(+), 1 deletion(-) create mode 100644 R/AddCardModule.R create mode 100644 R/DownloadModule.R create mode 100644 R/SimpleReporter.R create mode 100644 R/utils.R create mode 100644 man/add_card_button_srv.Rd create mode 100644 man/add_card_button_ui.Rd create mode 100644 man/download_report_button_srv.Rd create mode 100644 man/download_report_button_ui.Rd create mode 100644 man/extract_addcard_id.Rd create mode 100644 man/simple_reporter.Rd create mode 100644 man/simple_reporter_ui.Rd create mode 100644 vignettes/.gitignore create mode 100644 vignettes/simpleReporter.Rmd diff --git a/DESCRIPTION b/DESCRIPTION index e55fe4cb..114f7501 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -11,7 +11,10 @@ BugReports: https://github.com/insightsengineering/teal.reporter/issues Imports: checkmate, R6, - yaml + yaml, + shiny, + shinyWidgets, + zip Suggests: ggplot2, knitr, diff --git a/NAMESPACE b/NAMESPACE index be42705c..154adb46 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,13 @@ export(ReportCard) export(Reporter) +export(add_card_button_srv) +export(add_card_button_ui) +export(download_report_button_srv) +export(download_report_button_ui) +export(extract_addcard_id) +export(simple_reporter) +export(simple_reporter_ui) importFrom(R6,R6Class) importFrom(checkmate,assert_string) importFrom(yaml,as.yaml) diff --git a/R/AddCardModule.R b/R/AddCardModule.R new file mode 100644 index 00000000..53b4bfd1 --- /dev/null +++ b/R/AddCardModule.R @@ -0,0 +1,83 @@ +#' Add Card Reporter UI +#' @description button for adding views/cards to the Report. Part of the simple Reporter UI. +#' @param id character +#' @return shiny `tagList` +#' @export +add_card_button_ui <- function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::tags$button( + id = ns("addReportCard"), + type = "button", + class = "btn btn-primary action-button", + `data-val` = shiny::restoreInput(id = ns("addReportCard"), default = NULL), + NULL, + "Add Card" + ) + ) +} + +#' Add Card Button Server +#' @description server for adding views/cards the Report. Part of the simple Reporter. +#' @param id character +#' @param reporter `Reporter` instance. +#' @param card `ReportCard` instance +#' @return shiny `moduleServer` +#' @export +#' @export +add_card_button_srv <- function(id, reporter, card) { + shiny::moduleServer( + id, + function(input, output, session) { + ns <- session$ns + add_modal <- function(failed = FALSE) { + shiny::modalDialog( + easyClose = TRUE, + shiny::tags$h3("Add the Card to the Report"), + shiny::tags$hr(), + shiny::textInput( + ns("comment"), + "Comment", + value = "The idea behind", + width = "100%" + ), + if (failed) { + shiny::tags$div( + shiny::tags$b("Invalid", style = "color: red;") + ) + }, + footer = shiny::tagList( + shiny::tags$button( + type = "button", + class = "btn btn-primary", + `data-dismiss` = "modal", + `data-bs-dismiss` = "modal", + NULL, + "Cancel" + ), + shiny::tags$button( + id = ns("addCardOk"), + type = "button", + class = "btn btn-primary action-button", + `data-val` = shiny::restoreInput(id = ns("addCardOk"), default = NULL), + NULL, + "Add Card" + ) + ) + ) + } + + shiny::observeEvent(input$addReportCard, { + shiny::showModal(add_modal()) + }) + + shiny::observeEvent(input$addCardOk, { + stopifnot(inherits(card(), "ReportCard")) + card()$append_text("Comment", "header3") + card()$append_text(input$comment) + reporter$append_cards(list(card())) + shiny::removeModal() + }) + } + ) +} diff --git a/R/DownloadModule.R b/R/DownloadModule.R new file mode 100644 index 00000000..eeead9df --- /dev/null +++ b/R/DownloadModule.R @@ -0,0 +1,146 @@ +#' Download Button Reporter UI +#' @description button for downloading the Report. Part of the simple Reporter UI. +#' @param id character +#' @return shiny `tagList` +#' @export +download_report_button_ui <- function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::tags$button( + id = ns("download_button"), + type = "button", + class = "btn btn-primary action-button", + `data-val` = shiny::restoreInput(id = ns("download_button"), default = NULL), + NULL, + "Download Report" + ) + ) +} + +#' Download Button Server +#' @description server for downloading the Report. Part of the simple Reporter. +#' @param id character +#' @param reporter `Reporter` instance. +#' @param notification logical if to add shiny notification about the download process. +#' @return shiny `moduleServer` +#' @export +download_report_button_srv <- function(id, reporter, notification = TRUE) { + shiny::moduleServer( + id, + function(input, output, session) { + ns <- session$ns + download_modal <- function(failed = FALSE) { + nr_cards <- length(reporter$get_cards()) + downb <- shiny::tags$a( + id = ns("download_data"), + class = paste("btn btn-primary shiny-download-link", if (nr_cards) NULL else "disabled"), + style = if (nr_cards) NULL else "pointer-events: none;", + href = "", + target = "_blank", + download = NA, + shiny::icon("download"), + "Download Report" + ) + shiny::modalDialog( + easyClose = TRUE, + shiny::tags$h3("Download the Report"), + shiny::tags$hr(), + if (length(reporter$get_cards()) == 0) { + shiny::tags$div( + shiny::tags$p(shiny::tags$strong("No Cards Added"), style = "color: red; margin-bottom:15px;") + ) + } else { + shiny::tags$div( + style = "color: green; margin-bottom:15px;", + shiny::tags$p( + shiny::tags$strong(paste("Number of cards: ", nr_cards)) + ), + ) + }, + shiny::textInput(ns("docAuthor"), label = "Author:", value = "NEST"), + shiny::textInput(ns("docTitle"), label = "Title:", value = "NEST Report"), + shiny::tags$div( + shinyWidgets::pickerInput( + inputId = ns("docType"), + label = "Choose a document type: ", + choices = c("pdf document", "html document", "powerpoint presentation", "word document") + ) + ), + if (failed) { + shiny::tags$div(shiny::tags$b("Invalid", style = "color: red;")) + }, + footer = shiny::tagList( + shiny::tags$button( + id = ns("reset_reporter"), + type = "button", + style = "float: left;", + class = "btn btn-danger action-button", + `data-val` = shiny::restoreInput(id = ns("reset_reporter"), default = NULL), + NULL, + "Reset Reporter" + ), + shiny::tags$button( + type = "button", + class = "btn btn-primary", + `data-dismiss` = "modal", + `data-bs-dismiss` = "modal", + NULL, + "Cancel" + ), + downb + ) + ) + } + + shiny::observeEvent(input$download_button, { + shiny::showModal(download_modal()) + }) + + shiny::observeEvent(input$reset_reporter, { + shiny::showModal( + shiny::modalDialog( + shiny::tags$h3("Reset the Report"), + shiny::tags$hr(), + shiny::tags$strong(shiny::tags$p("Are you sure you want to reset the report?")), + footer = shiny::tagList( + shiny::modalButton("Cancel"), + shiny::actionButton(ns("reset_reporter_ok"), "Reset") + ) + ) + ) + }) + + shiny::observeEvent(input$reset_reporter_ok, { + reporter$reset() + shiny::removeModal() + }) + + output$download_data <- shiny::downloadHandler( + filename = function() { + paste("Report_", format(Sys.time(), "%y%m%d%H%M%S"), ".zip", sep = "") + }, + content = function(file) { + renderer <- Renderer$new() + + yaml <- list( + author = yaml_quoted(input$docAuthor), + title = yaml_quoted(input$docTitle), + date = yaml_quoted(as.character(Sys.Date())) + ) + + yaml[["output"]] <- gsub(" ", "_", input$docType) + + yaml_header <- md_header(yaml::as.yaml(yaml)) + + if (notification) shiny::showNotification(sprintf("Rendering and Downloading\n%s.", input$docType)) + + renderer$render(reporter$get_blocks(), yaml_header) + temp_zip_file <- tempfile(fileext = ".zip") + zip::zipr(temp_zip_file, renderer$get_output_dir()) + file.copy(temp_zip_file, file) + }, + contentType = "application/zip" + ) + } + ) +} diff --git a/R/Reporter.R b/R/Reporter.R index 627a3126..b2dad153 100644 --- a/R/Reporter.R +++ b/R/Reporter.R @@ -107,6 +107,14 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. } blocks }, + #' @description Reset the instance, remove already added cards. + #' + #' @return a `Reporter` object + #' + reset = function() { + private$cards <- list() + invisible(self) + }, #' @description The copy constructor. #' #' @param name the name of the field diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R new file mode 100644 index 00000000..c7acab66 --- /dev/null +++ b/R/SimpleReporter.R @@ -0,0 +1,30 @@ +#' Simple Reporter UI +#' @description two buttons for adding views and downloading the Report +#' @param id character +#' @return shiny `tagList` +#' @export +simple_reporter_ui <- function(id) { + ns <- shiny::NS(id) + shiny::tagList( + add_card_button_ui(ns("addReportCard")), + download_report_button_ui(ns("downloadButton")), + ) +} + +#' Simple Reporter Server +#' @description two buttons for adding views and downloading the Report +#' @param id character +#' @param reporter `Reporter` instance. +#' @param card `ReportCard` instance +#' @param notification logical if to add shiny notification about the download process. +#' @return shiny `moduleServer` +#' @export +simple_reporter <- function(id, reporter, card, notification = TRUE) { + shiny::moduleServer( + id, + function(input, output, session) { + add_card_button_srv("addReportCard", reporter = reporter, card = card) + download_report_button_srv("downloadButton", reporter = reporter, notification = notification) + } + ) +} diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 00000000..5b9a42b7 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,16 @@ +#' Extract Add Card Button id +#' @description extract Add Card Button id. +#' It is needed to know when trigger the reactivity cycle for the `ReportCard`. +#' @param input shiny input +#' @note has to be invoked inside the reactive call. +#' @export +extract_addcard_id <- function(input) { + nams <- names(input) + which_addcard <- grep("addReportCard-addReportCard$", nams) + res <- nams[which_addcard] + if (length(res) == 1) { + res + } else { + "NULL" + } +} diff --git a/man/Reporter.Rd b/man/Reporter.Rd index f603db89..9764bb3c 100644 --- a/man/Reporter.Rd +++ b/man/Reporter.Rd @@ -100,6 +100,7 @@ reporter$get_blocks() \item \href{#method-append_cards}{\code{Reporter$append_cards()}} \item \href{#method-get_cards}{\code{Reporter$get_cards()}} \item \href{#method-get_blocks}{\code{Reporter$get_blocks()}} +\item \href{#method-reset}{\code{Reporter$reset()}} \item \href{#method-deep_clone}{\code{Reporter$deep_clone()}} \item \href{#method-clone}{\code{Reporter$clone()}} } @@ -260,6 +261,19 @@ reporter$get_blocks() } +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-reset}{}}} +\subsection{Method \code{reset()}}{ +Reset the instance, remove already added cards. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Reporter$reset()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +a \code{Reporter} object +} } \if{html}{\out{
}} \if{html}{\out{}} diff --git a/man/add_card_button_srv.Rd b/man/add_card_button_srv.Rd new file mode 100644 index 00000000..bbb79aa2 --- /dev/null +++ b/man/add_card_button_srv.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AddCardModule.R +\name{add_card_button_srv} +\alias{add_card_button_srv} +\title{Add Card Button Server} +\usage{ +add_card_button_srv(id, reporter, card) +} +\arguments{ +\item{id}{character} + +\item{reporter}{\code{Reporter} instance.} + +\item{card}{\code{ReportCard} instance} +} +\value{ +shiny \code{moduleServer} +} +\description{ +server for adding views/cards the Report. Part of the simple Reporter. +} diff --git a/man/add_card_button_ui.Rd b/man/add_card_button_ui.Rd new file mode 100644 index 00000000..5c8dcfc6 --- /dev/null +++ b/man/add_card_button_ui.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AddCardModule.R +\name{add_card_button_ui} +\alias{add_card_button_ui} +\title{Add Card Reporter UI} +\usage{ +add_card_button_ui(id) +} +\arguments{ +\item{id}{character} +} +\value{ +shiny \code{tagList} +} +\description{ +button for adding views/cards to the Report. Part of the simple Reporter UI. +} diff --git a/man/download_report_button_srv.Rd b/man/download_report_button_srv.Rd new file mode 100644 index 00000000..5eed3a15 --- /dev/null +++ b/man/download_report_button_srv.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DownloadModule.R +\name{download_report_button_srv} +\alias{download_report_button_srv} +\title{Download Button Server} +\usage{ +download_report_button_srv(id, reporter, notification = TRUE) +} +\arguments{ +\item{id}{character} + +\item{reporter}{\code{Reporter} instance.} + +\item{notification}{logical if to add shiny notification about the download process.} +} +\value{ +shiny \code{moduleServer} +} +\description{ +server for downloading the Report. Part of the simple Reporter. +} diff --git a/man/download_report_button_ui.Rd b/man/download_report_button_ui.Rd new file mode 100644 index 00000000..246a2a88 --- /dev/null +++ b/man/download_report_button_ui.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DownloadModule.R +\name{download_report_button_ui} +\alias{download_report_button_ui} +\title{Download Button Reporter UI} +\usage{ +download_report_button_ui(id) +} +\arguments{ +\item{id}{character} +} +\value{ +shiny \code{tagList} +} +\description{ +button for downloading the Report. Part of the simple Reporter UI. +} diff --git a/man/extract_addcard_id.Rd b/man/extract_addcard_id.Rd new file mode 100644 index 00000000..3e3bc16c --- /dev/null +++ b/man/extract_addcard_id.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{extract_addcard_id} +\alias{extract_addcard_id} +\title{Extract Add Card Button id} +\usage{ +extract_addcard_id(input) +} +\arguments{ +\item{input}{shiny input} +} +\description{ +extract Add Card Button id. +It is needed to know when trigger the reactivity cycle for the \code{ReportCard}. +} +\note{ +has to be invoked inside the reactive call. +} diff --git a/man/simple_reporter.Rd b/man/simple_reporter.Rd new file mode 100644 index 00000000..bc878f91 --- /dev/null +++ b/man/simple_reporter.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/SimpleReporter.R +\name{simple_reporter} +\alias{simple_reporter} +\title{Simple Reporter Server} +\usage{ +simple_reporter(id, reporter, card, notification = TRUE) +} +\arguments{ +\item{id}{character} + +\item{reporter}{\code{Reporter} instance.} + +\item{card}{\code{ReportCard} instance} + +\item{notification}{logical if to add shiny notification about the download process.} +} +\value{ +shiny \code{moduleServer} +} +\description{ +two buttons for adding views and downloading the Report +} diff --git a/man/simple_reporter_ui.Rd b/man/simple_reporter_ui.Rd new file mode 100644 index 00000000..4f8e448a --- /dev/null +++ b/man/simple_reporter_ui.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/SimpleReporter.R +\name{simple_reporter_ui} +\alias{simple_reporter_ui} +\title{Simple Reporter UI} +\usage{ +simple_reporter_ui(id) +} +\arguments{ +\item{id}{character} +} +\value{ +shiny \code{tagList} +} +\description{ +two buttons for adding views and downloading the Report +} diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 00000000..097b2416 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd new file mode 100644 index 00000000..a3931bf6 --- /dev/null +++ b/vignettes/simpleReporter.Rmd @@ -0,0 +1,204 @@ +--- +title: "Simple Reporter" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Simple Reporter} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(shiny) +library(teal.reporter) +library(ggplot2) +library(rtables) +``` + +AddCardButton and downloadReportButton modules: + +```{r} +ui <- fluidPage( + titlePanel(""), + sidebarLayout( + sidebarPanel( + uiOutput("encoding") + ), + mainPanel( + ### REPORTER + teal.reporter::add_card_button_ui("addReportCard"), + teal.reporter::download_report_button_ui("downloadButton"), + ### + tags$br(), + tags$br(), + tabsetPanel( + id = "tabs", + tabPanel("Plot", plotOutput("distPlot")), + tabPanel("Table", verbatimTextOutput("table")) + ) + ) + ) +) + +server <- function(input, output, session) { + output$encoding <- renderUI({ + if (input$tabs == "Plot") { + sliderInput( + "binwidth", + "binwidth", + min = 2, + max = 10, + value = 8 + ) + } else { + selectInput( + "stat", + label = "Statistic", + choices = c("mean", "median", "sd"), + "mean" + ) + } + }) + + plot <- reactive({ + req(input$binwidth) + x <- mtcars$mpg + ggplot2::ggplot(data = mtcars, ggplot2::aes(x = mpg)) + + ggplot2::geom_histogram(binwidth = input$binwidth) + }) + + output$distPlot <- 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() + }) + + ### REPORTER + reporter <- teal.reporter::Reporter$new() + card_r <- eventReactive( + input[[teal.reporter::extract_addcard_id(input)]], { + card <- teal.reporter::ReportCard$new() + if (input$tabs == "Plot") { + card$append_text("My plot", "header2") + card$append_plot(plot()) + } else if (input$tabs == "Table") { + card$append_text("My Table", "header2") + card$append_table(table()) + } + card + }) + + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card = card_r) + teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) +} + +shinyApp(ui = ui, server = server) +``` + +Simple Reporter: + +```{r} +ui <- fluidPage( + titlePanel(""), + sidebarLayout( + sidebarPanel( + uiOutput("encoding") + ), + mainPanel( + ### REPORTER + teal.reporter::simple_reporter_ui("simpleReporter"), + ### + tags$br(), + tags$br(), + tabsetPanel( + id = "tabs", + tabPanel("Plot", plotOutput("distPlot")), + tabPanel("Table", verbatimTextOutput("table")) + ) + ) + ) +) + +server <- function(input, output, session) { + output$encoding <- renderUI({ + if (input$tabs == "Plot") { + sliderInput( + "binwidth", + "binwidth", + min = 2, + max = 10, + value = 8 + ) + } else { + selectInput( + "stat", + label = "Statistic", + choices = c("mean", "median", "sd"), + "mean" + ) + } + }) + + plot <- reactive({ + req(input$binwidth) + x <- mtcars$mpg + ggplot2::ggplot(data = mtcars, ggplot2::aes(x = mpg)) + + ggplot2::geom_histogram(binwidth = input$binwidth) + }) + + output$distPlot <- 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() + }) + + ### REPORTER + reporter <- teal.reporter::Reporter$new() + card_r <- eventReactive( + input[[teal.reporter::extract_addcard_id(input)]], { + card <- teal.reporter::ReportCard$new() + if (input$tabs == "Plot") { + card$append_text("My plot", "header2") + card$append_plot(plot()) + } else if (input$tabs == "Table") { + card$append_text("My Table", "header2") + card$append_table(table()) + } + card + }) + + teal.reporter::simple_reporter("simpleReporter", reporter = reporter, card = card_r) + ### +} + +shinyApp(ui = ui, server = server) +``` + From d81155ceeb7d1136160ed9d1febb51345c2f2379 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 21 Apr 2022 11:50:16 +0200 Subject: [PATCH 02/49] add first testServer --- tests/testthat/test-addCardModule.R | 33 +++++++++++++++++++++++++++++ vignettes/simpleReporter.Rmd | 7 ++++-- 2 files changed, 38 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/test-addCardModule.R diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R new file mode 100644 index 00000000..8a35c12a --- /dev/null +++ b/tests/testthat/test-addCardModule.R @@ -0,0 +1,33 @@ +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() +) + +reporter <- Reporter$new() + +testthat::test_that("Adding comment header and comment body", { + shiny::testServer(add_card_button_srv, + args = list(reporter = reporter, card = reactive(card1)), { + card_len <- length(card()$get_content()) + session$setInputs(comment = "Comment Body") + session$setInputs(`addCardOk` = 0) + + testthat::expect_identical( + length(reporter$get_blocks()), + card_len + 2L + ) + + testthat::expect_identical( + tail(reporter$get_blocks(), 1)[[1]]$get_content(), + "Comment Body" + ) + + testthat::expect_identical( + tail(reporter$get_blocks(), 2)[[1]]$get_content(), + "Comment" + ) + }) +}) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index a3931bf6..bc1bee13 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -21,7 +21,10 @@ library(ggplot2) library(rtables) ``` -AddCardButton and downloadReportButton modules: +Simple Reporter is a shiny module for capturing app views during the session, and eventually downloading a report document. +The Simple Reporter module consists of two separate modules one for each of two buttons, Add Card and Download Report buttons modules. + +Simple Reporter shiny app with separate modules for each button: ```{r} ui <- fluidPage( @@ -112,7 +115,7 @@ server <- function(input, output, session) { shinyApp(ui = ui, server = server) ``` -Simple Reporter: +Simple Reporter shiny app with combined buttons modules: ```{r} ui <- fluidPage( From b6068c8161b6a1f110e4987f61a522382202c107 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 21 Apr 2022 12:29:25 +0200 Subject: [PATCH 03/49] testServer --- R/DownloadModule.R | 4 +-- tests/testthat/test-DownloadReportModule.R | 31 ++++++++++++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/test-DownloadReportModule.R diff --git a/R/DownloadModule.R b/R/DownloadModule.R index eeead9df..c60c007d 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -117,11 +117,10 @@ download_report_button_srv <- function(id, reporter, notification = TRUE) { output$download_data <- shiny::downloadHandler( filename = function() { - paste("Report_", format(Sys.time(), "%y%m%d%H%M%S"), ".zip", sep = "") + paste("report_", format(Sys.time(), "%y%m%d%H%M%S"), ".zip", sep = "") }, content = function(file) { renderer <- Renderer$new() - yaml <- list( author = yaml_quoted(input$docAuthor), title = yaml_quoted(input$docTitle), @@ -138,6 +137,7 @@ download_report_button_srv <- function(id, reporter, notification = TRUE) { temp_zip_file <- tempfile(fileext = ".zip") zip::zipr(temp_zip_file, renderer$get_output_dir()) file.copy(temp_zip_file, file) + rm(renderer) }, contentType = "application/zip" ) diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R new file mode 100644 index 00000000..781276c8 --- /dev/null +++ b/tests/testthat/test-DownloadReportModule.R @@ -0,0 +1,31 @@ +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() +) + +reporter <- Reporter$new() +reporter$append_cards(list(card1)) + +testthat::test_that("", { + shiny::testServer(download_report_button_srv, + args = list(reporter = reporter), { + + session$setInputs(`docType` = "html_document") + session$setInputs(`docTitle` = "TITLE") + session$setInputs(`docAuthor` = "AUTHOR") + session$setInputs(`download_data` = 0) + + f <- output$download_data + testthat::expect_true(file.exists(f)) + tmp_dir <- tempdir() + output_dir <- file.path(tmp_dir, sprintf("report_test_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) + dir.create(path = output_dir) + zip::unzip(f, exdir = output_dir) + files <- list.files(output_dir, recursive = T) + testthat::expect_true(any(grepl("[.]Rmd", files))) + testthat::expect_true(any(grepl("[.]html", files))) + }) +}) From 6f7c05f79b7a96f9fd4030f12112cc1eb31ead9c Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 21 Apr 2022 13:10:19 +0200 Subject: [PATCH 04/49] styler + lintr --- tests/testthat/test-DownloadReportModule.R | 33 +++++++++++----------- tests/testthat/test-addCardModule.R | 32 +++++++++++---------- vignettes/simpleReporter.Rmd | 28 +++++++++--------- 3 files changed, 48 insertions(+), 45 deletions(-) diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index 781276c8..05f729d1 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -11,21 +11,22 @@ reporter$append_cards(list(card1)) testthat::test_that("", { shiny::testServer(download_report_button_srv, - args = list(reporter = reporter), { + args = list(reporter = reporter), + { + session$setInputs(`docType` = "html_document") + session$setInputs(`docTitle` = "TITLE") + session$setInputs(`docAuthor` = "AUTHOR") + session$setInputs(`download_data` = 0) - session$setInputs(`docType` = "html_document") - session$setInputs(`docTitle` = "TITLE") - session$setInputs(`docAuthor` = "AUTHOR") - session$setInputs(`download_data` = 0) - - f <- output$download_data - testthat::expect_true(file.exists(f)) - tmp_dir <- tempdir() - output_dir <- file.path(tmp_dir, sprintf("report_test_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) - dir.create(path = output_dir) - zip::unzip(f, exdir = output_dir) - files <- list.files(output_dir, recursive = T) - testthat::expect_true(any(grepl("[.]Rmd", files))) - testthat::expect_true(any(grepl("[.]html", files))) - }) + f <- output$download_data + testthat::expect_true(file.exists(f)) + tmp_dir <- tempdir() + output_dir <- file.path(tmp_dir, sprintf("report_test_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) + dir.create(path = output_dir) + zip::unzip(f, exdir = output_dir) + files <- list.files(output_dir, recursive = TRUE) + testthat::expect_true(any(grepl("[.]Rmd", files))) + testthat::expect_true(any(grepl("[.]html", files))) + } + ) }) diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R index 8a35c12a..b87d7981 100644 --- a/tests/testthat/test-addCardModule.R +++ b/tests/testthat/test-addCardModule.R @@ -10,24 +10,26 @@ reporter <- Reporter$new() testthat::test_that("Adding comment header and comment body", { shiny::testServer(add_card_button_srv, - args = list(reporter = reporter, card = reactive(card1)), { - card_len <- length(card()$get_content()) - session$setInputs(comment = "Comment Body") - session$setInputs(`addCardOk` = 0) + args = list(reporter = reporter, card = reactive(card1)), + { + card_len <- length(card()$get_content()) + session$setInputs(comment = "Comment Body") + session$setInputs(`addCardOk` = 0) - testthat::expect_identical( - length(reporter$get_blocks()), - card_len + 2L - ) + testthat::expect_identical( + length(reporter$get_blocks()), + card_len + 2L + ) - testthat::expect_identical( + testthat::expect_identical( tail(reporter$get_blocks(), 1)[[1]]$get_content(), "Comment Body" - ) + ) - testthat::expect_identical( - tail(reporter$get_blocks(), 2)[[1]]$get_content(), - "Comment" - ) - }) + testthat::expect_identical( + tail(reporter$get_blocks(), 2)[[1]]$get_content(), + "Comment" + ) + } + ) }) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index bc1bee13..68c1a054 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -68,31 +68,31 @@ server <- function(input, output, session) { ) } }) - + plot <- reactive({ req(input$binwidth) x <- mtcars$mpg ggplot2::ggplot(data = mtcars, ggplot2::aes(x = mpg)) + ggplot2::geom_histogram(binwidth = input$binwidth) }) - + output$distPlot <- 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() }) - + ### REPORTER reporter <- teal.reporter::Reporter$new() card_r <- eventReactive( @@ -107,7 +107,7 @@ server <- function(input, output, session) { } card }) - + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card = card_r) teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) } @@ -158,31 +158,31 @@ server <- function(input, output, session) { ) } }) - + plot <- reactive({ req(input$binwidth) x <- mtcars$mpg ggplot2::ggplot(data = mtcars, ggplot2::aes(x = mpg)) + ggplot2::geom_histogram(binwidth = input$binwidth) }) - + output$distPlot <- 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() }) - + ### REPORTER reporter <- teal.reporter::Reporter$new() card_r <- eventReactive( @@ -197,7 +197,7 @@ server <- function(input, output, session) { } card }) - + teal.reporter::simple_reporter("simpleReporter", reporter = reporter, card = card_r) ### } From 65a4a50793662f2b8be90193ba4017839fc1438a Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 21 Apr 2022 14:08:11 +0200 Subject: [PATCH 05/49] utils --- R/AddCardModule.R | 6 ++-- R/utils.R | 9 ++--- man/extract_addcard_id.Rd | 2 +- tests/testthat/test-DownloadReportModule.R | 7 ++-- tests/testthat/test-TextBlock.R | 2 +- tests/testthat/test-addCardModule.R | 7 ++-- tests/testthat/test-utils.R | 41 ++++++++++++++++++++++ vignettes/simpleReporter.Rmd | 1 + 8 files changed, 60 insertions(+), 15 deletions(-) create mode 100644 tests/testthat/test-utils.R diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 53b4bfd1..3b809593 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -7,10 +7,10 @@ add_card_button_ui <- function(id) { ns <- shiny::NS(id) shiny::tagList( shiny::tags$button( - id = ns("addReportCard"), + id = ns("addReportCardButton"), type = "button", class = "btn btn-primary action-button", - `data-val` = shiny::restoreInput(id = ns("addReportCard"), default = NULL), + `data-val` = shiny::restoreInput(id = ns("addReportCardButton"), default = NULL), NULL, "Add Card" ) @@ -67,7 +67,7 @@ add_card_button_srv <- function(id, reporter, card) { ) } - shiny::observeEvent(input$addReportCard, { + shiny::observeEvent(input$addReportCardButton, { shiny::showModal(add_modal()) }) diff --git a/R/utils.R b/R/utils.R index 5b9a42b7..5019273c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,16 +1,17 @@ #' Extract Add Card Button id #' @description extract Add Card Button id. #' It is needed to know when trigger the reactivity cycle for the `ReportCard`. -#' @param input shiny input +#' @param input shiny input, `reactivevalues`. #' @note has to be invoked inside the reactive call. #' @export extract_addcard_id <- function(input) { + checkmate::assert_class(input, "reactivevalues") nams <- names(input) - which_addcard <- grep("addReportCard-addReportCard$", nams) + which_addcard <- grep("addReportCardButton$", nams) res <- nams[which_addcard] - if (length(res) == 1) { + val <- if (length(res) == 1) { res } else { - "NULL" + "not_exists_id" } } diff --git a/man/extract_addcard_id.Rd b/man/extract_addcard_id.Rd index 3e3bc16c..7cf4d870 100644 --- a/man/extract_addcard_id.Rd +++ b/man/extract_addcard_id.Rd @@ -7,7 +7,7 @@ extract_addcard_id(input) } \arguments{ -\item{input}{shiny input} +\item{input}{shiny input, \code{reactivevalues}.} } \description{ extract Add Card Button id. diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index 05f729d1..1c6a880a 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -9,10 +9,11 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("", { - shiny::testServer(download_report_button_srv, +testthat::test_that("download_report_button_srv", { + shiny::testServer( + download_report_button_srv, args = list(reporter = reporter), - { + expr = { session$setInputs(`docType` = "html_document") session$setInputs(`docTitle` = "TITLE") session$setInputs(`docAuthor` = "AUTHOR") diff --git a/tests/testthat/test-TextBlock.R b/tests/testthat/test-TextBlock.R index 832b7fe9..2d60b48b 100644 --- a/tests/testthat/test-TextBlock.R +++ b/tests/testthat/test-TextBlock.R @@ -42,7 +42,7 @@ testthat::test_that("set_style accepts one of the styles returned by get_availab testthat::test_that("set_style asserts the argument is one of styles in get_available_styles", { testthat::expect_error( TextBlock$new()$set_style("test"), - regexp = "'arg' should be one of \"default\", \"header2\", \"header3\", \"verbatim\"" + regexp = "'arg' should be one of " ) }) diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R index b87d7981..56d4162f 100644 --- a/tests/testthat/test-addCardModule.R +++ b/tests/testthat/test-addCardModule.R @@ -8,10 +8,11 @@ card1$append_plot( reporter <- Reporter$new() -testthat::test_that("Adding comment header and comment body", { - shiny::testServer(add_card_button_srv, +testthat::test_that("add_card_button_srv", { + shiny::testServer( + add_card_button_srv, args = list(reporter = reporter, card = reactive(card1)), - { + expr = { card_len <- length(card()$get_content()) session$setInputs(comment = "Comment Body") session$setInputs(`addCardOk` = 0) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R new file mode 100644 index 00000000..6fd219b8 --- /dev/null +++ b/tests/testthat/test-utils.R @@ -0,0 +1,41 @@ +testthat::test_that("error if use not a reactivevalues", { + vals <- list() + testthat::expect_error(isolate(extract_addcard_id(vals))) +}) + +testthat::test_that("empty id if there is no match", { + vals <- shiny::reactiveValues(a = 1, b = 2) + testthat::expect_identical( + isolate(extract_addcard_id(vals)), + "not_exists_id" + ) +}) + +testthat::test_that("correct match", { + vals <- shiny::reactiveValues(a = 1, b = 2, `addReportCardButton` = 0) + testthat::expect_identical( + isolate(extract_addcard_id(vals)), + "addReportCardButton" + ) +}) + +testthat::test_that("correct match 2", { + vals <- shiny::reactiveValues(a = 1, b = 2, `teal-addReportCard-addReportCardButton` = 0) + testthat::expect_identical( + isolate(extract_addcard_id(vals)), + "teal-addReportCard-addReportCardButton" + ) +}) + +testthat::test_that("return empty id if there is double match", { + vals <- shiny::reactiveValues( + a = 1, + b = 2, + `addReportCard-addReportCard` = 0, + `addReportCard2-addReportCard` = 0 + ) + testthat::expect_identical( + isolate(extract_addcard_id(vals)), + "not_exists_id" + ) +}) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index 68c1a054..ffd24d3e 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -50,6 +50,7 @@ ui <- fluidPage( ) server <- function(input, output, session) { + browser() output$encoding <- renderUI({ if (input$tabs == "Plot") { sliderInput( From 88747e3d8c14d97ef516e5348ca32fe5d925c9f7 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 21 Apr 2022 14:13:32 +0200 Subject: [PATCH 06/49] docs --- man/Reporter.Rd | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/man/Reporter.Rd b/man/Reporter.Rd index 325ed9a7..76d05c1b 100644 --- a/man/Reporter.Rd +++ b/man/Reporter.Rd @@ -100,6 +100,7 @@ reporter$get_blocks() \item \href{#method-append_cards}{\code{Reporter$append_cards()}} \item \href{#method-get_cards}{\code{Reporter$get_cards()}} \item \href{#method-get_blocks}{\code{Reporter$get_blocks()}} +\item \href{#method-reset}{\code{Reporter$reset()}} \item \href{#method-clone}{\code{Reporter$clone()}} } } @@ -260,6 +261,19 @@ reporter$get_blocks() } +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-reset}{}}} +\subsection{Method \code{reset()}}{ +Reset the instance, remove already added cards. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Reporter$reset()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +a \code{Reporter} object +} } \if{html}{\out{
}} \if{html}{\out{}} From 29739232be62d48d07c644aea80b86e65351184b Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 21 Apr 2022 14:54:40 +0200 Subject: [PATCH 07/49] docs and tests --- NAMESPACE | 2 +- R/ContentBlock.R | 14 +-- R/ReportCard.R | 12 +-- R/Reporter.R | 12 +-- R/SimpleReporter.R | 2 +- ...ple_reporter.Rd => simple_reporter_srv.Rd} | 6 +- tests/testthat/test-DownloadReportModule.R | 25 +++++ tests/testthat/test-SimpleReporter.R | 96 +++++++++++++++++++ tests/testthat/test-addCardModule.R | 1 + vignettes/simpleReporter.Rmd | 2 +- 10 files changed, 147 insertions(+), 25 deletions(-) rename man/{simple_reporter.Rd => simple_reporter_srv.Rd} (79%) create mode 100644 tests/testthat/test-SimpleReporter.R diff --git a/NAMESPACE b/NAMESPACE index ba066a8c..686895ed 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,7 +7,7 @@ export(add_card_button_ui) export(download_report_button_srv) export(download_report_button_ui) export(extract_addcard_id) -export(simple_reporter) +export(simple_reporter_srv) export(simple_reporter_ui) importFrom(R6,R6Class) importFrom(checkmate,assert_string) diff --git a/R/ContentBlock.R b/R/ContentBlock.R index 0b515f77..c8a07710 100644 --- a/R/ContentBlock.R +++ b/R/ContentBlock.R @@ -42,13 +42,13 @@ ContentBlock <- R6::R6Class( # nolint: object_name_linter. private = list( content = character(0), - #' @description The copy constructor. - #' - #' @param name `character(1)` the name of the field - #' @param value the value assigned to the field - #' - #' @return the value of the copied field - #' + # @description The copy constructor. + # + # @param name `character(1)` the name of the field + # @param value the value assigned to the field + # + # @return the value of the copied field + # deep_clone = function(name, value) { if (name == "content" && checkmate::test_file_exists(value)) { extension <- "" diff --git a/R/ReportCard.R b/R/ReportCard.R index 7aab573f..ecca0d8f 100644 --- a/R/ReportCard.R +++ b/R/ReportCard.R @@ -65,12 +65,12 @@ ReportCard <- R6::R6Class( # nolint: object_name_linter. ), private = list( content = list(), - #' @description The copy constructor. - #' - #' @param name the name of the field - #' @param value the value of the field - #' @return the new value of the field - #' + # @description The copy constructor. + # + # @param name the name of the field + # @param value the value of the field + # @return the new value of the field + # deep_clone = function(name, value) { if (name == "content") { lapply(value, function(content_block) content_block$clone(deep = TRUE)) diff --git a/R/Reporter.R b/R/Reporter.R index d7cfec75..e7f865c9 100644 --- a/R/Reporter.R +++ b/R/Reporter.R @@ -119,12 +119,12 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. ), private = list( cards = list(), - #' @description The copy constructor. - #' - #' @param name the name of the field - #' @param value the value of the field - #' @return the new value of the field - #' + # @description The copy constructor. + # + # @param name the name of the field + # @param value the value of the field + # @return the new value of the field + # deep_clone = function(name, value) { if (name == "cards") { lapply(value, function(card) card$clone(deep = TRUE)) diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index c7acab66..df54e9ae 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -19,7 +19,7 @@ simple_reporter_ui <- function(id) { #' @param notification logical if to add shiny notification about the download process. #' @return shiny `moduleServer` #' @export -simple_reporter <- function(id, reporter, card, notification = TRUE) { +simple_reporter_srv <- function(id, reporter, card, notification = TRUE) { shiny::moduleServer( id, function(input, output, session) { diff --git a/man/simple_reporter.Rd b/man/simple_reporter_srv.Rd similarity index 79% rename from man/simple_reporter.Rd rename to man/simple_reporter_srv.Rd index bc878f91..721263f6 100644 --- a/man/simple_reporter.Rd +++ b/man/simple_reporter_srv.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/SimpleReporter.R -\name{simple_reporter} -\alias{simple_reporter} +\name{simple_reporter_srv} +\alias{simple_reporter_srv} \title{Simple Reporter Server} \usage{ -simple_reporter(id, reporter, card, notification = TRUE) +simple_reporter_srv(id, reporter, card, notification = TRUE) } \arguments{ \item{id}{character} diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index 1c6a880a..cd8d75c5 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -14,6 +14,7 @@ testthat::test_that("download_report_button_srv", { download_report_button_srv, args = list(reporter = reporter), expr = { + session$setInputs(`download_button` = 0) session$setInputs(`docType` = "html_document") session$setInputs(`docTitle` = "TITLE") session$setInputs(`docAuthor` = "AUTHOR") @@ -31,3 +32,27 @@ testthat::test_that("download_report_button_srv", { } ) }) + +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() +) + +reporter <- Reporter$new() +reporter$append_cards(list(card1)) + +testthat::test_that("download_report_button_srv", { + shiny::testServer( + download_report_button_srv, + args = list(reporter = reporter), + expr = { + testthat::expect_identical(reporter$get_cards(), list(card1)) + session$setInputs(`reset_reporter` = 0) + session$setInputs(`reset_reporter_ok` = 0) + testthat::expect_identical(reporter$get_blocks(), list()) + } + ) +}) diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R new file mode 100644 index 00000000..15136f9e --- /dev/null +++ b/tests/testthat/test-SimpleReporter.R @@ -0,0 +1,96 @@ +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() +) + +reporter <- Reporter$new() +reporter$append_cards(list(card1)) + +testthat::test_that("download_report_button_srv", { + shiny::testServer( + simple_reporter_srv, + args = list(reporter = reporter), + expr = { + session$setInputs(`download_button` = 0) + session$setInputs(`downloadButton-docType` = "html_document") + session$setInputs(`downloadButton-docTitle` = "TITLE") + session$setInputs(`downloadButton-docAuthor` = "AUTHOR") + session$setInputs(`downloadButton-download_data` = 0) + + f <- output$`downloadButton-download_data` + testthat::expect_true(file.exists(f)) + tmp_dir <- tempdir() + output_dir <- file.path(tmp_dir, sprintf("report_test_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) + dir.create(path = output_dir) + zip::unzip(f, exdir = output_dir) + files <- list.files(output_dir, recursive = TRUE) + testthat::expect_true(any(grepl("[.]Rmd", files))) + testthat::expect_true(any(grepl("[.]html", files))) + } + ) +}) + +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() +) + +reporter <- Reporter$new() +reporter$append_cards(list(card1)) + +testthat::test_that("download_report_button_srv", { + shiny::testServer( + simple_reporter_srv, + args = list(reporter = reporter), + expr = { + testthat::expect_identical(reporter$get_cards(), list(card1)) + session$setInputs(`downloadButton-reset_reporter` = 0) + session$setInputs(`downloadButton-reset_reporter_ok` = 0) + testthat::expect_identical(reporter$get_blocks(), list()) + } + ) +}) + +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() +) + +reporter <- Reporter$new() + +testthat::test_that("add_card_button_srv", { + shiny::testServer( + simple_reporter_srv, + args = list(reporter = reporter, card = reactive(card1)), + expr = { + card_len <- length(card()$get_content()) + session$setInputs(`addReportCard-addReportCardButton` = 0) + session$setInputs(`addReportCard-comment` = "Comment Body") + session$setInputs(`addReportCard-addCardOk` = 0) + + testthat::expect_identical( + length(reporter$get_blocks()), + card_len + 2L + ) + + testthat::expect_identical( + tail(reporter$get_blocks(), 1)[[1]]$get_content(), + "Comment Body" + ) + + testthat::expect_identical( + tail(reporter$get_blocks(), 2)[[1]]$get_content(), + "Comment" + ) + } + ) +}) diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R index 56d4162f..b4358861 100644 --- a/tests/testthat/test-addCardModule.R +++ b/tests/testthat/test-addCardModule.R @@ -14,6 +14,7 @@ testthat::test_that("add_card_button_srv", { args = list(reporter = reporter, card = reactive(card1)), expr = { card_len <- length(card()$get_content()) + session$setInputs(`addReportCardButton` = 0) session$setInputs(comment = "Comment Body") session$setInputs(`addCardOk` = 0) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index ffd24d3e..e447e110 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -199,7 +199,7 @@ server <- function(input, output, session) { card }) - teal.reporter::simple_reporter("simpleReporter", reporter = reporter, card = card_r) + teal.reporter::simple_reporter_srv("simpleReporter", reporter = reporter, card = card_r) ### } From 5765dfad211ceecc2b72dd40e05aa1be1f88cd23 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 21 Apr 2022 15:15:22 +0200 Subject: [PATCH 08/49] tests --- tests/testthat/test-DownloadReportModule.R | 6 ++++++ tests/testthat/test-SimpleReporter.R | 6 ++++++ tests/testthat/test-addCardModule.R | 6 ++++++ 3 files changed, 18 insertions(+) diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index cd8d75c5..050b2834 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -56,3 +56,9 @@ testthat::test_that("download_report_button_srv", { } ) }) + +testthat::test_that("download_report_button_ui", { + testthat::expect_true( + inherits(download_report_button_ui("sth"), c("shiny.tag.list", "list")) + ) +}) diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R index 15136f9e..8ecb3515 100644 --- a/tests/testthat/test-SimpleReporter.R +++ b/tests/testthat/test-SimpleReporter.R @@ -94,3 +94,9 @@ testthat::test_that("add_card_button_srv", { } ) }) + +testthat::test_that("simple_reporter_ui", { + testthat::expect_true( + inherits(simple_reporter_ui("sth"), c("shiny.tag.list", "list")) + ) +}) diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R index b4358861..91a2432f 100644 --- a/tests/testthat/test-addCardModule.R +++ b/tests/testthat/test-addCardModule.R @@ -35,3 +35,9 @@ testthat::test_that("add_card_button_srv", { } ) }) + +testthat::test_that("add_card_button_ui", { + testthat::expect_true( + inherits(add_card_button_ui("sth"), c("shiny.tag.list", "list")) + ) +}) From 856aa1fb363c9b1dd4858a962b4f0476392e4b49 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 22 Apr 2022 08:50:04 +0200 Subject: [PATCH 09/49] extract input --- NAMESPACE | 2 +- R/utils.R | 20 +++++++++++-------- ...addcard_id.Rd => extract_addcard_input.Rd} | 10 +++++----- tests/testthat/test-utils.R | 18 ++++++++--------- vignettes/simpleReporter.Rmd | 6 +++--- 5 files changed, 30 insertions(+), 26 deletions(-) rename man/{extract_addcard_id.Rd => extract_addcard_input.Rd} (66%) diff --git a/NAMESPACE b/NAMESPACE index 686895ed..a87f8e80 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,7 @@ export(add_card_button_srv) export(add_card_button_ui) export(download_report_button_srv) export(download_report_button_ui) -export(extract_addcard_id) +export(extract_addcard_input) export(simple_reporter_srv) export(simple_reporter_ui) importFrom(R6,R6Class) diff --git a/R/utils.R b/R/utils.R index 5019273c..7f6e2d21 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,17 +1,21 @@ -#' Extract Add Card Button id -#' @description extract Add Card Button id. +#' Extract Add Card Button input +#' @description extract Add Card Button input. #' It is needed to know when trigger the reactivity cycle for the `ReportCard`. #' @param input shiny input, `reactivevalues`. #' @note has to be invoked inside the reactive call. #' @export -extract_addcard_id <- function(input) { +extract_addcard_input <- function(input) { checkmate::assert_class(input, "reactivevalues") nams <- names(input) which_addcard <- grep("addReportCardButton$", nams) res <- nams[which_addcard] - val <- if (length(res) == 1) { - res - } else { - "not_exists_id" + val <- + reactive( + if (length(res) == 1) { + input[[res]] + } else { + NULL + } + ) + val() } -} diff --git a/man/extract_addcard_id.Rd b/man/extract_addcard_input.Rd similarity index 66% rename from man/extract_addcard_id.Rd rename to man/extract_addcard_input.Rd index 7cf4d870..734e986e 100644 --- a/man/extract_addcard_id.Rd +++ b/man/extract_addcard_input.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R -\name{extract_addcard_id} -\alias{extract_addcard_id} -\title{Extract Add Card Button id} +\name{extract_addcard_input} +\alias{extract_addcard_input} +\title{Extract Add Card Button input} \usage{ -extract_addcard_id(input) +extract_addcard_input(input) } \arguments{ \item{input}{shiny input, \code{reactivevalues}.} } \description{ -extract Add Card Button id. +extract Add Card Button input. It is needed to know when trigger the reactivity cycle for the \code{ReportCard}. } \note{ diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 6fd219b8..34294eb0 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,29 +1,29 @@ testthat::test_that("error if use not a reactivevalues", { vals <- list() - testthat::expect_error(isolate(extract_addcard_id(vals))) + testthat::expect_error(isolate(extract_addcard_input(vals))) }) testthat::test_that("empty id if there is no match", { vals <- shiny::reactiveValues(a = 1, b = 2) testthat::expect_identical( - isolate(extract_addcard_id(vals)), - "not_exists_id" + isolate(extract_addcard_input(vals)), + NULL ) }) testthat::test_that("correct match", { vals <- shiny::reactiveValues(a = 1, b = 2, `addReportCardButton` = 0) testthat::expect_identical( - isolate(extract_addcard_id(vals)), - "addReportCardButton" + isolate(extract_addcard_input(vals)), + 0 ) }) testthat::test_that("correct match 2", { vals <- shiny::reactiveValues(a = 1, b = 2, `teal-addReportCard-addReportCardButton` = 0) testthat::expect_identical( - isolate(extract_addcard_id(vals)), - "teal-addReportCard-addReportCardButton" + isolate(extract_addcard_input(vals)), + 0 ) }) @@ -35,7 +35,7 @@ testthat::test_that("return empty id if there is double match", { `addReportCard2-addReportCard` = 0 ) testthat::expect_identical( - isolate(extract_addcard_id(vals)), - "not_exists_id" + isolate(extract_addcard_input(vals)), + NULL ) }) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index e447e110..c4e7eac7 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -50,7 +50,6 @@ ui <- fluidPage( ) server <- function(input, output, session) { - browser() output$encoding <- renderUI({ if (input$tabs == "Plot") { sliderInput( @@ -97,8 +96,9 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() card_r <- eventReactive( - input[[teal.reporter::extract_addcard_id(input)]], { + teal.reporter::extract_addcard_input(input), { card <- teal.reporter::ReportCard$new() + print("triggered") if (input$tabs == "Plot") { card$append_text("My plot", "header2") card$append_plot(plot()) @@ -187,7 +187,7 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() card_r <- eventReactive( - input[[teal.reporter::extract_addcard_id(input)]], { + teal.reporter::extract_addcard_input(input), { card <- teal.reporter::ReportCard$new() if (input$tabs == "Plot") { card$append_text("My plot", "header2") From 67c726ff69436e02aa7a65f9cb5f51c84b18ffb3 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 22 Apr 2022 09:00:28 +0200 Subject: [PATCH 10/49] extract input --- R/utils.R | 11 ++++++----- man/extract_addcard_input.Rd | 9 ++++++--- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/R/utils.R b/R/utils.R index 7f6e2d21..b0bf7506 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,8 +1,9 @@ #' Extract Add Card Button input -#' @description extract Add Card Button input. -#' It is needed to know when trigger the reactivity cycle for the `ReportCard`. +#' @description extract Add Card Button input, looks for an id with a suffix `addReportCardButton`. +#' It is needed to know when to trigger the reactivity cycle for the `ReportCard`. #' @param input shiny input, `reactivevalues`. -#' @note has to be invoked inside the reactive call. +#' @return value +#' @note has to be invoked inside the active reactive context. #' @export extract_addcard_input <- function(input) { checkmate::assert_class(input, "reactivevalues") @@ -10,7 +11,7 @@ extract_addcard_input <- function(input) { which_addcard <- grep("addReportCardButton$", nams) res <- nams[which_addcard] val <- - reactive( + shiny::reactive( if (length(res) == 1) { input[[res]] } else { @@ -18,4 +19,4 @@ extract_addcard_input <- function(input) { } ) val() - } +} diff --git a/man/extract_addcard_input.Rd b/man/extract_addcard_input.Rd index 734e986e..675cf3f7 100644 --- a/man/extract_addcard_input.Rd +++ b/man/extract_addcard_input.Rd @@ -9,10 +9,13 @@ extract_addcard_input(input) \arguments{ \item{input}{shiny input, \code{reactivevalues}.} } +\value{ +value +} \description{ -extract Add Card Button input. -It is needed to know when trigger the reactivity cycle for the \code{ReportCard}. +extract Add Card Button input, looks for an id with a suffix \code{addReportCardButton}. +It is needed to know when to trigger the reactivity cycle for the \code{ReportCard}. } \note{ -has to be invoked inside the reactive call. +has to be invoked inside the active reactive context. } From 04f4146fb1bb184b6985ddbce0426c899ab7cfdc Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 22 Apr 2022 10:07:03 +0200 Subject: [PATCH 11/49] polish --- R/DownloadModule.R | 4 +++- vignettes/simpleReporter.Rmd | 12 ++++++++---- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index c60c007d..31b3076a 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -131,7 +131,9 @@ download_report_button_srv <- function(id, reporter, notification = TRUE) { yaml_header <- md_header(yaml::as.yaml(yaml)) - if (notification) shiny::showNotification(sprintf("Rendering and Downloading\n%s.", input$docType)) + if (notification) { + shiny::showNotification(sprintf("Rendering and Downloading\n%s.", input$docType)) + } renderer$render(reporter$get_blocks(), yaml_header) temp_zip_file <- tempfile(fileext = ".zip") diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index c4e7eac7..6f8bd69d 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -96,7 +96,8 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() card_r <- eventReactive( - teal.reporter::extract_addcard_input(input), { + eventExpr = teal.reporter::extract_addcard_input(input), + handlerExpr = { card <- teal.reporter::ReportCard$new() print("triggered") if (input$tabs == "Plot") { @@ -107,7 +108,8 @@ server <- function(input, output, session) { card$append_table(table()) } card - }) + } + ) teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card = card_r) teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) @@ -187,7 +189,8 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() card_r <- eventReactive( - teal.reporter::extract_addcard_input(input), { + eventExpr = teal.reporter::extract_addcard_input(input), + handlerExpr = { card <- teal.reporter::ReportCard$new() if (input$tabs == "Plot") { card$append_text("My plot", "header2") @@ -197,7 +200,8 @@ server <- function(input, output, session) { card$append_table(table()) } card - }) + } + ) teal.reporter::simple_reporter_srv("simpleReporter", reporter = reporter, card = card_r) ### From f52f0903ba41ddf4877e6cf8fd1e187321242bc3 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 22 Apr 2022 10:21:17 +0200 Subject: [PATCH 12/49] lintr actions --- vignettes/simpleReporter.Rmd | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index 6f8bd69d..0d384730 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -42,7 +42,7 @@ ui <- fluidPage( tags$br(), tabsetPanel( id = "tabs", - tabPanel("Plot", plotOutput("distPlot")), + tabPanel("Plot", plotOutput("dist_plot")), tabPanel("Table", verbatimTextOutput("table")) ) ) @@ -76,7 +76,7 @@ server <- function(input, output, session) { ggplot2::geom_histogram(binwidth = input$binwidth) }) - output$distPlot <- renderPlot({ + output$dist_plot <- renderPlot({ plot() }) @@ -135,7 +135,7 @@ ui <- fluidPage( tags$br(), tabsetPanel( id = "tabs", - tabPanel("Plot", plotOutput("distPlot")), + tabPanel("Plot", plotOutput("dist_plot")), tabPanel("Table", verbatimTextOutput("table")) ) ) @@ -169,7 +169,7 @@ server <- function(input, output, session) { ggplot2::geom_histogram(binwidth = input$binwidth) }) - output$distPlot <- renderPlot({ + output$dist_plot <- renderPlot({ plot() }) From b49cf1cc255b81597ea88495acc03962a9fd78aa Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 22 Apr 2022 10:33:01 +0200 Subject: [PATCH 13/49] spelling user interface --- R/AddCardModule.R | 4 ++-- R/DownloadModule.R | 4 ++-- R/SimpleReporter.R | 4 ++-- man/add_card_button_ui.Rd | 4 ++-- man/download_report_button_ui.Rd | 4 ++-- man/simple_reporter_ui.Rd | 4 ++-- 6 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 3b809593..3b867f22 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -1,5 +1,5 @@ -#' Add Card Reporter UI -#' @description button for adding views/cards to the Report. Part of the simple Reporter UI. +#' Add Card Reporter user interface +#' @description button for adding views/cards to the Report. Part of the simple Reporter user interface. #' @param id character #' @return shiny `tagList` #' @export diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 31b3076a..37564cfb 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -1,5 +1,5 @@ -#' Download Button Reporter UI -#' @description button for downloading the Report. Part of the simple Reporter UI. +#' Download Button Reporter user interface +#' @description button for downloading the Report. Part of the simple Reporter user interface. #' @param id character #' @return shiny `tagList` #' @export diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index df54e9ae..36ef0b5e 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -1,5 +1,5 @@ -#' Simple Reporter UI -#' @description two buttons for adding views and downloading the Report +#' Simple Reporter user interface +#' @description two buttons for adding views and downloading the Report. #' @param id character #' @return shiny `tagList` #' @export diff --git a/man/add_card_button_ui.Rd b/man/add_card_button_ui.Rd index 5c8dcfc6..4da3f2bb 100644 --- a/man/add_card_button_ui.Rd +++ b/man/add_card_button_ui.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/AddCardModule.R \name{add_card_button_ui} \alias{add_card_button_ui} -\title{Add Card Reporter UI} +\title{Add Card Reporter user interface} \usage{ add_card_button_ui(id) } @@ -13,5 +13,5 @@ add_card_button_ui(id) shiny \code{tagList} } \description{ -button for adding views/cards to the Report. Part of the simple Reporter UI. +button for adding views/cards to the Report. Part of the simple Reporter user interface. } diff --git a/man/download_report_button_ui.Rd b/man/download_report_button_ui.Rd index 246a2a88..cc961751 100644 --- a/man/download_report_button_ui.Rd +++ b/man/download_report_button_ui.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/DownloadModule.R \name{download_report_button_ui} \alias{download_report_button_ui} -\title{Download Button Reporter UI} +\title{Download Button Reporter user interface} \usage{ download_report_button_ui(id) } @@ -13,5 +13,5 @@ download_report_button_ui(id) shiny \code{tagList} } \description{ -button for downloading the Report. Part of the simple Reporter UI. +button for downloading the Report. Part of the simple Reporter user interface. } diff --git a/man/simple_reporter_ui.Rd b/man/simple_reporter_ui.Rd index 4f8e448a..44fd1351 100644 --- a/man/simple_reporter_ui.Rd +++ b/man/simple_reporter_ui.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/SimpleReporter.R \name{simple_reporter_ui} \alias{simple_reporter_ui} -\title{Simple Reporter UI} +\title{Simple Reporter user interface} \usage{ simple_reporter_ui(id) } @@ -13,5 +13,5 @@ simple_reporter_ui(id) shiny \code{tagList} } \description{ -two buttons for adding views and downloading the Report +two buttons for adding views and downloading the Report. } From bc9e614b4ab66c6fd98a43b8de836d5b81cdf43f Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 22 Apr 2022 11:30:25 +0200 Subject: [PATCH 14/49] docs --- .Rbuildignore | 2 ++ .gitignore | 2 ++ R/AddCardModule.R | 6 +++++- R/DownloadModule.R | 6 +++++- R/SimpleReporter.R | 9 +++++++-- R/utils.R | 4 +++- man/add_card_button_srv.Rd | 2 ++ man/add_card_button_ui.Rd | 4 +++- man/download_report_button_srv.Rd | 2 ++ man/download_report_button_ui.Rd | 4 +++- man/extract_addcard_input.Rd | 4 +++- man/simple_reporter_srv.Rd | 5 ++++- man/simple_reporter_ui.Rd | 4 +++- vignettes/simpleReporter.Rmd | 12 ++++++++++++ 14 files changed, 56 insertions(+), 10 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index ae6b391f..20f43252 100755 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -7,3 +7,5 @@ ^\.github$ ^\.lintr$ ^\.pre-commit-config\.yaml$ +^doc$ +^Meta$ diff --git a/.gitignore b/.gitignore index cf066375..399bfa9d 100755 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,5 @@ .Rhistory docs inst/doc +/doc/ +/Meta/ diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 3b867f22..94de0a8a 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -1,5 +1,7 @@ -#' Add Card Reporter user interface +#' Add Card Reporter User Interface #' @description button for adding views/cards to the Report. Part of the simple Reporter user interface. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id character #' @return shiny `tagList` #' @export @@ -19,6 +21,8 @@ add_card_button_ui <- function(id) { #' Add Card Button Server #' @description server for adding views/cards the Report. Part of the simple Reporter. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id character #' @param reporter `Reporter` instance. #' @param card `ReportCard` instance diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 37564cfb..fb95d1ab 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -1,5 +1,7 @@ -#' Download Button Reporter user interface +#' Download Button Reporter User Interface #' @description button for downloading the Report. Part of the simple Reporter user interface. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id character #' @return shiny `tagList` #' @export @@ -19,6 +21,8 @@ download_report_button_ui <- function(id) { #' Download Button Server #' @description server for downloading the Report. Part of the simple Reporter. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id character #' @param reporter `Reporter` instance. #' @param notification logical if to add shiny notification about the download process. diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index 36ef0b5e..08d07c0b 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -1,5 +1,7 @@ -#' Simple Reporter user interface +#' Simple Reporter User Interface #' @description two buttons for adding views and downloading the Report. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id character #' @return shiny `tagList` #' @export @@ -12,7 +14,10 @@ simple_reporter_ui <- function(id) { } #' Simple Reporter Server -#' @description two buttons for adding views and downloading the Report +#' @description two buttons for adding views and downloading the Report. +#' The add module has `addReportCard` id and download module the `downloadButton` id. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id character #' @param reporter `Reporter` instance. #' @param card `ReportCard` instance diff --git a/R/utils.R b/R/utils.R index b0bf7506..e52a2616 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,6 +1,8 @@ #' Extract Add Card Button input #' @description extract Add Card Button input, looks for an id with a suffix `addReportCardButton`. -#' It is needed to know when to trigger the reactivity cycle for the `ReportCard`. +#' It is needed to identify when to trigger the reactivity cycle for the `ReportCard`. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param input shiny input, `reactivevalues`. #' @return value #' @note has to be invoked inside the active reactive context. diff --git a/man/add_card_button_srv.Rd b/man/add_card_button_srv.Rd index bbb79aa2..757e8bd4 100644 --- a/man/add_card_button_srv.Rd +++ b/man/add_card_button_srv.Rd @@ -18,4 +18,6 @@ shiny \code{moduleServer} } \description{ server for adding views/cards the Report. Part of the simple Reporter. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/man/add_card_button_ui.Rd b/man/add_card_button_ui.Rd index 4da3f2bb..4eb6cccd 100644 --- a/man/add_card_button_ui.Rd +++ b/man/add_card_button_ui.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/AddCardModule.R \name{add_card_button_ui} \alias{add_card_button_ui} -\title{Add Card Reporter user interface} +\title{Add Card Reporter User Interface} \usage{ add_card_button_ui(id) } @@ -14,4 +14,6 @@ shiny \code{tagList} } \description{ button for adding views/cards to the Report. Part of the simple Reporter user interface. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/man/download_report_button_srv.Rd b/man/download_report_button_srv.Rd index 5eed3a15..99ef221a 100644 --- a/man/download_report_button_srv.Rd +++ b/man/download_report_button_srv.Rd @@ -18,4 +18,6 @@ shiny \code{moduleServer} } \description{ server for downloading the Report. Part of the simple Reporter. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/man/download_report_button_ui.Rd b/man/download_report_button_ui.Rd index cc961751..a6f16302 100644 --- a/man/download_report_button_ui.Rd +++ b/man/download_report_button_ui.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/DownloadModule.R \name{download_report_button_ui} \alias{download_report_button_ui} -\title{Download Button Reporter user interface} +\title{Download Button Reporter User Interface} \usage{ download_report_button_ui(id) } @@ -14,4 +14,6 @@ shiny \code{tagList} } \description{ button for downloading the Report. Part of the simple Reporter user interface. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/man/extract_addcard_input.Rd b/man/extract_addcard_input.Rd index 675cf3f7..77f8d749 100644 --- a/man/extract_addcard_input.Rd +++ b/man/extract_addcard_input.Rd @@ -14,7 +14,9 @@ value } \description{ extract Add Card Button input, looks for an id with a suffix \code{addReportCardButton}. -It is needed to know when to trigger the reactivity cycle for the \code{ReportCard}. +It is needed to identify when to trigger the reactivity cycle for the \code{ReportCard}. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } \note{ has to be invoked inside the active reactive context. diff --git a/man/simple_reporter_srv.Rd b/man/simple_reporter_srv.Rd index 721263f6..ddbe1cd0 100644 --- a/man/simple_reporter_srv.Rd +++ b/man/simple_reporter_srv.Rd @@ -19,5 +19,8 @@ simple_reporter_srv(id, reporter, card, notification = TRUE) shiny \code{moduleServer} } \description{ -two buttons for adding views and downloading the Report +two buttons for adding views and downloading the Report. +The add module has \code{addReportCard} id and download module the \code{downloadButton} id. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/man/simple_reporter_ui.Rd b/man/simple_reporter_ui.Rd index 44fd1351..7a24e26f 100644 --- a/man/simple_reporter_ui.Rd +++ b/man/simple_reporter_ui.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/SimpleReporter.R \name{simple_reporter_ui} \alias{simple_reporter_ui} -\title{Simple Reporter user interface} +\title{Simple Reporter User Interface} \usage{ simple_reporter_ui(id) } @@ -14,4 +14,6 @@ shiny \code{tagList} } \description{ two buttons for adding views and downloading the Report. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index 0d384730..b18179b2 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -24,6 +24,17 @@ library(rtables) Simple Reporter is a shiny module for capturing app views during the session, and eventually downloading a report document. The Simple Reporter module consists of two separate modules one for each of two buttons, Add Card and Download Report buttons modules. +The code added to introduce the simply reporter is wrapped in the `### REPORTER` code blocks. + +The implementation should consist of 5 steps: + +1. Add modules user interface to the user interface of the app. +2. Initialize Reporter instance. +3. Create the Report Card when the Add Button is clicked, a `eventReactive` part. +This part is one of the most demanding step as require from the developer to use his imagination, +how the document page should looks like. +4. Invoke the servers with the reporter instance and the reactive of the report card instance. + Simple Reporter shiny app with separate modules for each button: ```{r} @@ -113,6 +124,7 @@ server <- function(input, output, session) { teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card = card_r) teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) + ### } shinyApp(ui = ui, server = server) From a4f1e258baa3e2971c1fd87e5c958242d3163918 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Tue, 26 Apr 2022 13:43:27 +0200 Subject: [PATCH 15/49] fix --- R/AddCardModule.R | 2 +- vignettes/simpleReporter.Rmd | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 94de0a8a..a0483a5b 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -76,7 +76,7 @@ add_card_button_srv <- function(id, reporter, card) { }) shiny::observeEvent(input$addCardOk, { - stopifnot(inherits(card(), "ReportCard")) + stopifnot(inherits(card(), "ReportCard"), "added card is not a ReportCrad class") card()$append_text("Comment", "header3") card()$append_text(input$comment) reporter$append_cards(list(card())) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index b18179b2..3607cda8 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -32,7 +32,8 @@ The implementation should consist of 5 steps: 2. Initialize Reporter instance. 3. Create the Report Card when the Add Button is clicked, a `eventReactive` part. This part is one of the most demanding step as require from the developer to use his imagination, -how the document page should looks like. +how the document page should looks like. +The `teal.reporter::extract_addcard_input` is created to help retrieve an add button input. 4. Invoke the servers with the reporter instance and the reactive of the report card instance. Simple Reporter shiny app with separate modules for each button: @@ -108,9 +109,8 @@ server <- function(input, output, session) { reporter <- teal.reporter::Reporter$new() card_r <- eventReactive( eventExpr = teal.reporter::extract_addcard_input(input), - handlerExpr = { + valueExpr = { card <- teal.reporter::ReportCard$new() - print("triggered") if (input$tabs == "Plot") { card$append_text("My plot", "header2") card$append_plot(plot()) @@ -202,7 +202,7 @@ server <- function(input, output, session) { reporter <- teal.reporter::Reporter$new() card_r <- eventReactive( eventExpr = teal.reporter::extract_addcard_input(input), - handlerExpr = { + valueExpr = { card <- teal.reporter::ReportCard$new() if (input$tabs == "Plot") { card$append_text("My plot", "header2") From 1587e43a15eb1743383df55205affe456a38ad1e Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Tue, 26 Apr 2022 13:45:54 +0200 Subject: [PATCH 16/49] fix --- R/AddCardModule.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index a0483a5b..94de0a8a 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -76,7 +76,7 @@ add_card_button_srv <- function(id, reporter, card) { }) shiny::observeEvent(input$addCardOk, { - stopifnot(inherits(card(), "ReportCard"), "added card is not a ReportCrad class") + stopifnot(inherits(card(), "ReportCard")) card()$append_text("Comment", "header3") card()$append_text(input$comment) reporter$append_cards(list(card())) From fed131b28e27a43862e7892eef345005868f71c6 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Tue, 26 Apr 2022 15:17:37 +0200 Subject: [PATCH 17/49] Mahmoud rev --- R/AddCardModule.R | 8 ++++---- R/DownloadModule.R | 6 +++--- R/SimpleReporter.R | 2 +- man/add_card_button_srv.Rd | 2 +- man/add_card_button_ui.Rd | 6 +++--- man/download_report_button_srv.Rd | 2 +- man/download_report_button_ui.Rd | 4 ++-- man/simple_reporter_ui.Rd | 2 +- 8 files changed, 16 insertions(+), 16 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 94de0a8a..66fb8b78 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -1,9 +1,9 @@ -#' Add Card Reporter User Interface +#' Add Card Button User Interface #' @description button for adding views/cards to the Report. Part of the simple Reporter user interface. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param id character -#' @return shiny `tagList` +#' @param id `character` +#' @return `shiny::tagList` #' @export add_card_button_ui <- function(id) { ns <- shiny::NS(id) @@ -23,7 +23,7 @@ add_card_button_ui <- function(id) { #' @description server for adding views/cards the Report. Part of the simple Reporter. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param id character +#' @param id `character` #' @param reporter `Reporter` instance. #' @param card `ReportCard` instance #' @return shiny `moduleServer` diff --git a/R/DownloadModule.R b/R/DownloadModule.R index fb95d1ab..4192bb22 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -2,8 +2,8 @@ #' @description button for downloading the Report. Part of the simple Reporter user interface. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param id character -#' @return shiny `tagList` +#' @param id `character` +#' @return `shiny::tagList` #' @export download_report_button_ui <- function(id) { ns <- shiny::NS(id) @@ -23,7 +23,7 @@ download_report_button_ui <- function(id) { #' @description server for downloading the Report. Part of the simple Reporter. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param id character +#' @param id `character` #' @param reporter `Reporter` instance. #' @param notification logical if to add shiny notification about the download process. #' @return shiny `moduleServer` diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index 08d07c0b..a62d5f4a 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -3,7 +3,7 @@ #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id character -#' @return shiny `tagList` +#' @return `shiny::tagList` #' @export simple_reporter_ui <- function(id) { ns <- shiny::NS(id) diff --git a/man/add_card_button_srv.Rd b/man/add_card_button_srv.Rd index 757e8bd4..4de29974 100644 --- a/man/add_card_button_srv.Rd +++ b/man/add_card_button_srv.Rd @@ -7,7 +7,7 @@ add_card_button_srv(id, reporter, card) } \arguments{ -\item{id}{character} +\item{id}{\code{character}} \item{reporter}{\code{Reporter} instance.} diff --git a/man/add_card_button_ui.Rd b/man/add_card_button_ui.Rd index 4eb6cccd..c52ace0f 100644 --- a/man/add_card_button_ui.Rd +++ b/man/add_card_button_ui.Rd @@ -2,15 +2,15 @@ % Please edit documentation in R/AddCardModule.R \name{add_card_button_ui} \alias{add_card_button_ui} -\title{Add Card Reporter User Interface} +\title{Add Card Button User Interface} \usage{ add_card_button_ui(id) } \arguments{ -\item{id}{character} +\item{id}{\code{character}} } \value{ -shiny \code{tagList} +\code{shiny::tagList} } \description{ button for adding views/cards to the Report. Part of the simple Reporter user interface. diff --git a/man/download_report_button_srv.Rd b/man/download_report_button_srv.Rd index 99ef221a..462beba9 100644 --- a/man/download_report_button_srv.Rd +++ b/man/download_report_button_srv.Rd @@ -7,7 +7,7 @@ download_report_button_srv(id, reporter, notification = TRUE) } \arguments{ -\item{id}{character} +\item{id}{\code{character}} \item{reporter}{\code{Reporter} instance.} diff --git a/man/download_report_button_ui.Rd b/man/download_report_button_ui.Rd index a6f16302..9db63046 100644 --- a/man/download_report_button_ui.Rd +++ b/man/download_report_button_ui.Rd @@ -7,10 +7,10 @@ download_report_button_ui(id) } \arguments{ -\item{id}{character} +\item{id}{\code{character}} } \value{ -shiny \code{tagList} +\code{shiny::tagList} } \description{ button for downloading the Report. Part of the simple Reporter user interface. diff --git a/man/simple_reporter_ui.Rd b/man/simple_reporter_ui.Rd index 7a24e26f..869e2191 100644 --- a/man/simple_reporter_ui.Rd +++ b/man/simple_reporter_ui.Rd @@ -10,7 +10,7 @@ simple_reporter_ui(id) \item{id}{character} } \value{ -shiny \code{tagList} +\code{shiny::tagList} } \description{ two buttons for adding views and downloading the Report. From b1cd6a73a985d99aeeeb40b8c830e5a76a6d0d37 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Tue, 26 Apr 2022 15:25:45 +0200 Subject: [PATCH 18/49] Mahmoud rev 2 --- R/AddCardModule.R | 2 +- R/DownloadModule.R | 4 ++-- R/SimpleReporter.R | 6 +++--- man/add_card_button_srv.Rd | 2 +- man/download_report_button_srv.Rd | 4 ++-- man/simple_reporter_srv.Rd | 4 ++-- man/simple_reporter_ui.Rd | 2 +- 7 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 66fb8b78..88c6af65 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -26,7 +26,7 @@ add_card_button_ui <- function(id) { #' @param id `character` #' @param reporter `Reporter` instance. #' @param card `ReportCard` instance -#' @return shiny `moduleServer` +#' @return `shiny::tagList` #' @export #' @export add_card_button_srv <- function(id, reporter, card) { diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 4192bb22..49a29952 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -25,8 +25,8 @@ download_report_button_ui <- function(id) { #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` #' @param reporter `Reporter` instance. -#' @param notification logical if to add shiny notification about the download process. -#' @return shiny `moduleServer` +#' @param notification logical whether to add shiny notification about the download process. +#' @return `shiny::tagList` #' @export download_report_button_srv <- function(id, reporter, notification = TRUE) { shiny::moduleServer( diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index a62d5f4a..a938e531 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -2,7 +2,7 @@ #' @description two buttons for adding views and downloading the Report. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param id character +#' @param id `character` #' @return `shiny::tagList` #' @export simple_reporter_ui <- function(id) { @@ -18,11 +18,11 @@ simple_reporter_ui <- function(id) { #' The add module has `addReportCard` id and download module the `downloadButton` id. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param id character +#' @param id `character` #' @param reporter `Reporter` instance. #' @param card `ReportCard` instance #' @param notification logical if to add shiny notification about the download process. -#' @return shiny `moduleServer` +#' @return `shiny::tagList` #' @export simple_reporter_srv <- function(id, reporter, card, notification = TRUE) { shiny::moduleServer( diff --git a/man/add_card_button_srv.Rd b/man/add_card_button_srv.Rd index 4de29974..f01d8731 100644 --- a/man/add_card_button_srv.Rd +++ b/man/add_card_button_srv.Rd @@ -14,7 +14,7 @@ add_card_button_srv(id, reporter, card) \item{card}{\code{ReportCard} instance} } \value{ -shiny \code{moduleServer} +\code{shiny::tagList} } \description{ server for adding views/cards the Report. Part of the simple Reporter. diff --git a/man/download_report_button_srv.Rd b/man/download_report_button_srv.Rd index 462beba9..cf57da48 100644 --- a/man/download_report_button_srv.Rd +++ b/man/download_report_button_srv.Rd @@ -11,10 +11,10 @@ download_report_button_srv(id, reporter, notification = TRUE) \item{reporter}{\code{Reporter} instance.} -\item{notification}{logical if to add shiny notification about the download process.} +\item{notification}{logical whether to add shiny notification about the download process.} } \value{ -shiny \code{moduleServer} +\code{shiny::tagList} } \description{ server for downloading the Report. Part of the simple Reporter. diff --git a/man/simple_reporter_srv.Rd b/man/simple_reporter_srv.Rd index ddbe1cd0..2f68224b 100644 --- a/man/simple_reporter_srv.Rd +++ b/man/simple_reporter_srv.Rd @@ -7,7 +7,7 @@ simple_reporter_srv(id, reporter, card, notification = TRUE) } \arguments{ -\item{id}{character} +\item{id}{\code{character}} \item{reporter}{\code{Reporter} instance.} @@ -16,7 +16,7 @@ simple_reporter_srv(id, reporter, card, notification = TRUE) \item{notification}{logical if to add shiny notification about the download process.} } \value{ -shiny \code{moduleServer} +\code{shiny::tagList} } \description{ two buttons for adding views and downloading the Report. diff --git a/man/simple_reporter_ui.Rd b/man/simple_reporter_ui.Rd index 869e2191..0f268fe1 100644 --- a/man/simple_reporter_ui.Rd +++ b/man/simple_reporter_ui.Rd @@ -7,7 +7,7 @@ simple_reporter_ui(id) } \arguments{ -\item{id}{character} +\item{id}{\code{character}} } \value{ \code{shiny::tagList} From 2dbf120992ec6e382db3a52af5685d87668ba95d Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Tue, 26 Apr 2022 15:27:13 +0200 Subject: [PATCH 19/49] Mahmoud rev 2b --- R/AddCardModule.R | 2 +- R/DownloadModule.R | 2 +- R/SimpleReporter.R | 2 +- man/add_card_button_srv.Rd | 2 +- man/download_report_button_srv.Rd | 2 +- man/simple_reporter_srv.Rd | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 88c6af65..322cd778 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -26,7 +26,7 @@ add_card_button_ui <- function(id) { #' @param id `character` #' @param reporter `Reporter` instance. #' @param card `ReportCard` instance -#' @return `shiny::tagList` +#' @return `shiny::moduleServer` #' @export #' @export add_card_button_srv <- function(id, reporter, card) { diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 49a29952..59d4cca2 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -26,7 +26,7 @@ download_report_button_ui <- function(id) { #' @param id `character` #' @param reporter `Reporter` instance. #' @param notification logical whether to add shiny notification about the download process. -#' @return `shiny::tagList` +#' @return `shiny::moduleServer` #' @export download_report_button_srv <- function(id, reporter, notification = TRUE) { shiny::moduleServer( diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index a938e531..43e1041e 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -22,7 +22,7 @@ simple_reporter_ui <- function(id) { #' @param reporter `Reporter` instance. #' @param card `ReportCard` instance #' @param notification logical if to add shiny notification about the download process. -#' @return `shiny::tagList` +#' @return `shiny::moduleServer` #' @export simple_reporter_srv <- function(id, reporter, card, notification = TRUE) { shiny::moduleServer( diff --git a/man/add_card_button_srv.Rd b/man/add_card_button_srv.Rd index f01d8731..c1464e04 100644 --- a/man/add_card_button_srv.Rd +++ b/man/add_card_button_srv.Rd @@ -14,7 +14,7 @@ add_card_button_srv(id, reporter, card) \item{card}{\code{ReportCard} instance} } \value{ -\code{shiny::tagList} +\code{shiny::moduleServer} } \description{ server for adding views/cards the Report. Part of the simple Reporter. diff --git a/man/download_report_button_srv.Rd b/man/download_report_button_srv.Rd index cf57da48..a042c6ef 100644 --- a/man/download_report_button_srv.Rd +++ b/man/download_report_button_srv.Rd @@ -14,7 +14,7 @@ download_report_button_srv(id, reporter, notification = TRUE) \item{notification}{logical whether to add shiny notification about the download process.} } \value{ -\code{shiny::tagList} +\code{shiny::moduleServer} } \description{ server for downloading the Report. Part of the simple Reporter. diff --git a/man/simple_reporter_srv.Rd b/man/simple_reporter_srv.Rd index 2f68224b..e5fe382e 100644 --- a/man/simple_reporter_srv.Rd +++ b/man/simple_reporter_srv.Rd @@ -16,7 +16,7 @@ simple_reporter_srv(id, reporter, card, notification = TRUE) \item{notification}{logical if to add shiny notification about the download process.} } \value{ -\code{shiny::tagList} +\code{shiny::moduleServer} } \description{ two buttons for adding views and downloading the Report. From ba2926484107dfe365cbf1c3758d8d1b9f09eb4a Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Tue, 26 Apr 2022 15:31:09 +0200 Subject: [PATCH 20/49] Update R/utils.R Co-authored-by: Mahmoud Hallal <86970066+mhallal1@users.noreply.github.com> --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index e52a2616..59acbfbf 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,5 +1,5 @@ #' Extract Add Card Button input -#' @description extract Add Card Button input, looks for an id with a suffix `addReportCardButton`. +#' @description extracts Add Card Button input and looks for an id with a suffix `addReportCardButton`. #' It is needed to identify when to trigger the reactivity cycle for the `ReportCard`. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. From b3d132ce731f78515b2dfafe60a7fd20dd3660a0 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Tue, 26 Apr 2022 15:47:48 +0200 Subject: [PATCH 21/49] Mahmoud rev 2c --- man/extract_addcard_input.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/extract_addcard_input.Rd b/man/extract_addcard_input.Rd index 77f8d749..66ed0c82 100644 --- a/man/extract_addcard_input.Rd +++ b/man/extract_addcard_input.Rd @@ -13,7 +13,7 @@ extract_addcard_input(input) value } \description{ -extract Add Card Button input, looks for an id with a suffix \code{addReportCardButton}. +extracts Add Card Button input and looks for an id with a suffix \code{addReportCardButton}. It is needed to identify when to trigger the reactivity cycle for the \code{ReportCard}. For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. From 6dfa710ee476d513e87dd701f0191ccd88d812a7 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 09:46:14 +0200 Subject: [PATCH 22/49] small update --- R/AddCardModule.R | 2 +- R/DownloadModule.R | 14 +++++++++++--- man/download_report_button_srv.Rd | 13 +++++++++++-- 3 files changed, 23 insertions(+), 6 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 322cd778..8a531360 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -76,7 +76,7 @@ add_card_button_srv <- function(id, reporter, card) { }) shiny::observeEvent(input$addCardOk, { - stopifnot(inherits(card(), "ReportCard")) + checkmate::assert_class(card(), "ReportCard") card()$append_text("Comment", "header3") card()$append_text(input$comment) reporter$append_cards(list(card())) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 59d4cca2..378efc3a 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -25,10 +25,18 @@ download_report_button_ui <- function(id) { #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` #' @param reporter `Reporter` instance. -#' @param notification logical whether to add shiny notification about the download process. +#' @param notification logical whether to add shiny notification about the download process, by default `TRUE`. +#' @param output_types `character` vector with `rmarkdown` output types, +#' by default `c("pdf document", "html document", "powerpoint presentation", "word document")`. #' @return `shiny::moduleServer` #' @export -download_report_button_srv <- function(id, reporter, notification = TRUE) { +download_report_button_srv <- function(id, + reporter, + notification = TRUE, + output_types = c( + "pdf document", "html document", + "powerpoint presentation", "word document" + )) { shiny::moduleServer( id, function(input, output, session) { @@ -67,7 +75,7 @@ download_report_button_srv <- function(id, reporter, notification = TRUE) { shinyWidgets::pickerInput( inputId = ns("docType"), label = "Choose a document type: ", - choices = c("pdf document", "html document", "powerpoint presentation", "word document") + choices = output_types ) ), if (failed) { diff --git a/man/download_report_button_srv.Rd b/man/download_report_button_srv.Rd index a042c6ef..2da5e3e1 100644 --- a/man/download_report_button_srv.Rd +++ b/man/download_report_button_srv.Rd @@ -4,14 +4,23 @@ \alias{download_report_button_srv} \title{Download Button Server} \usage{ -download_report_button_srv(id, reporter, notification = TRUE) +download_report_button_srv( + id, + reporter, + notification = TRUE, + output_types = c("pdf document", "html document", "powerpoint presentation", + "word document") +) } \arguments{ \item{id}{\code{character}} \item{reporter}{\code{Reporter} instance.} -\item{notification}{logical whether to add shiny notification about the download process.} +\item{notification}{logical whether to add shiny notification about the download process, by default \code{TRUE}.} + +\item{output_types}{\code{character} vector with \code{rmarkdown} output types, +by default \code{c("pdf document", "html document", "powerpoint presentation", "word document")}.} } \value{ \code{shiny::moduleServer} From 60c80eb87a0cff65b2906a790d2d0401cb723d14 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 13:23:09 +0200 Subject: [PATCH 23/49] Apply suggestions from code review Co-authored-by: Mahmoud Hallal <86970066+mhallal1@users.noreply.github.com> --- tests/testthat/test-utils.R | 8 ++++---- vignettes/simpleReporter.Rmd | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 34294eb0..6a2e1bb5 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,9 +1,9 @@ -testthat::test_that("error if use not a reactivevalues", { +testthat::test_that("extract_addcard_input throws error when input is not a reactivevalues", { vals <- list() testthat::expect_error(isolate(extract_addcard_input(vals))) }) -testthat::test_that("empty id if there is no match", { +testthat::test_that("extract_addcard_input returns empty id if there is no match", { vals <- shiny::reactiveValues(a = 1, b = 2) testthat::expect_identical( isolate(extract_addcard_input(vals)), @@ -11,7 +11,7 @@ testthat::test_that("empty id if there is no match", { ) }) -testthat::test_that("correct match", { +testthat::test_that("extract_addcard_input returns right id when there is a correct match", { vals <- shiny::reactiveValues(a = 1, b = 2, `addReportCardButton` = 0) testthat::expect_identical( isolate(extract_addcard_input(vals)), @@ -27,7 +27,7 @@ testthat::test_that("correct match 2", { ) }) -testthat::test_that("return empty id if there is double match", { +testthat::test_that("extract_addcard_input returns empty id if there is double match", { vals <- shiny::reactiveValues( a = 1, b = 2, diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index 3607cda8..47be2e53 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -22,9 +22,9 @@ library(rtables) ``` Simple Reporter is a shiny module for capturing app views during the session, and eventually downloading a report document. -The Simple Reporter module consists of two separate modules one for each of two buttons, Add Card and Download Report buttons modules. +The Simple Reporter module consists of two separate modules one for each of the two buttons, Add Card and Download Report buttons modules. -The code added to introduce the simply reporter is wrapped in the `### REPORTER` code blocks. +The code added to introduce the simple reporter is wrapped in the `### REPORTER` code blocks. The implementation should consist of 5 steps: From af9e25bd7f8a39d46b8c6a1b5adfac968b30c349 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= <6959016+gogonzo@users.noreply.github.com> Date: Thu, 28 Apr 2022 13:36:48 +0200 Subject: [PATCH 24/49] buttons specified by user (#28) * buttons specified by user * remove utils --- NAMESPACE | 8 +- R/AddCardModule.R | 26 +---- R/DownloadModule.R | 32 +---- R/SimpleReporter.R | 35 ------ R/utils.R | 24 ---- man/add_card_button_ui.Rd | 19 --- ...add_card_button_srv.Rd => add_card_srv.Rd} | 8 +- man/download_report_button_ui.Rd | 19 --- ...t_button_srv.Rd => download_report_srv.Rd} | 13 ++- man/simple_reporter_srv.Rd | 26 ----- man/simple_reporter_ui.Rd | 19 --- tests/testthat/test-DownloadReportModule.R | 14 +-- tests/testthat/test-SimpleReporter.R | 102 ---------------- tests/testthat/test-addCardModule.R | 10 +- tests/testthat/test-utils.R | 41 ------- vignettes/simpleReporter.Rmd | 109 ++---------------- 16 files changed, 38 insertions(+), 467 deletions(-) delete mode 100644 R/SimpleReporter.R delete mode 100644 R/utils.R delete mode 100644 man/add_card_button_ui.Rd rename man/{add_card_button_srv.Rd => add_card_srv.Rd} (77%) delete mode 100644 man/download_report_button_ui.Rd rename man/{download_report_button_srv.Rd => download_report_srv.Rd} (77%) delete mode 100644 man/simple_reporter_srv.Rd delete mode 100644 man/simple_reporter_ui.Rd delete mode 100644 tests/testthat/test-SimpleReporter.R delete mode 100644 tests/testthat/test-utils.R diff --git a/NAMESPACE b/NAMESPACE index a87f8e80..74b097a5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,13 +2,9 @@ export(ReportCard) export(Reporter) -export(add_card_button_srv) -export(add_card_button_ui) -export(download_report_button_srv) -export(download_report_button_ui) +export(add_card_srv) +export(download_report_srv) export(extract_addcard_input) -export(simple_reporter_srv) -export(simple_reporter_ui) importFrom(R6,R6Class) importFrom(checkmate,assert_string) importFrom(grid,grid.newpage) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 8a531360..2d96fab9 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -1,25 +1,5 @@ -#' Add Card Button User Interface -#' @description button for adding views/cards to the Report. Part of the simple Reporter user interface. -#' -#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param id `character` -#' @return `shiny::tagList` -#' @export -add_card_button_ui <- function(id) { - ns <- shiny::NS(id) - shiny::tagList( - shiny::tags$button( - id = ns("addReportCardButton"), - type = "button", - class = "btn btn-primary action-button", - `data-val` = shiny::restoreInput(id = ns("addReportCardButton"), default = NULL), - NULL, - "Add Card" - ) - ) -} -#' Add Card Button Server +#' Add Card Server #' @description server for adding views/cards the Report. Part of the simple Reporter. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. @@ -29,7 +9,7 @@ add_card_button_ui <- function(id) { #' @return `shiny::moduleServer` #' @export #' @export -add_card_button_srv <- function(id, reporter, card) { +add_card_srv <- function(id, reporter, card) { shiny::moduleServer( id, function(input, output, session) { @@ -71,7 +51,7 @@ add_card_button_srv <- function(id, reporter, card) { ) } - shiny::observeEvent(input$addReportCardButton, { + shiny::observeEvent(card(), { shiny::showModal(add_modal()) }) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 378efc3a..cfd2e55d 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -1,25 +1,4 @@ -#' Download Button Reporter User Interface -#' @description button for downloading the Report. Part of the simple Reporter user interface. -#' -#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param id `character` -#' @return `shiny::tagList` -#' @export -download_report_button_ui <- function(id) { - ns <- shiny::NS(id) - shiny::tagList( - shiny::tags$button( - id = ns("download_button"), - type = "button", - class = "btn btn-primary action-button", - `data-val` = shiny::restoreInput(id = ns("download_button"), default = NULL), - NULL, - "Download Report" - ) - ) -} - -#' Download Button Server +#' Download report Server #' @description server for downloading the Report. Part of the simple Reporter. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. @@ -28,15 +7,15 @@ download_report_button_ui <- function(id) { #' @param notification logical whether to add shiny notification about the download process, by default `TRUE`. #' @param output_types `character` vector with `rmarkdown` output types, #' by default `c("pdf document", "html document", "powerpoint presentation", "word document")`. +#' @param show_modal `reactive` to trigger popup of the download modal #' @return `shiny::moduleServer` #' @export -download_report_button_srv <- function(id, - reporter, +download_report_srv <- function(id, reporter, notification = TRUE, output_types = c( "pdf document", "html document", "powerpoint presentation", "word document" - )) { + ), show_modal = shiny::reactive(NULL)) { shiny::moduleServer( id, function(input, output, session) { @@ -104,10 +83,11 @@ download_report_button_srv <- function(id, ) } - shiny::observeEvent(input$download_button, { + shiny::observeEvent(show_modal(), { shiny::showModal(download_modal()) }) + shiny::observeEvent(input$reset_reporter, { shiny::showModal( shiny::modalDialog( diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R deleted file mode 100644 index 43e1041e..00000000 --- a/R/SimpleReporter.R +++ /dev/null @@ -1,35 +0,0 @@ -#' Simple Reporter User Interface -#' @description two buttons for adding views and downloading the Report. -#' -#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param id `character` -#' @return `shiny::tagList` -#' @export -simple_reporter_ui <- function(id) { - ns <- shiny::NS(id) - shiny::tagList( - add_card_button_ui(ns("addReportCard")), - download_report_button_ui(ns("downloadButton")), - ) -} - -#' Simple Reporter Server -#' @description two buttons for adding views and downloading the Report. -#' The add module has `addReportCard` id and download module the `downloadButton` id. -#' -#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param id `character` -#' @param reporter `Reporter` instance. -#' @param card `ReportCard` instance -#' @param notification logical if to add shiny notification about the download process. -#' @return `shiny::moduleServer` -#' @export -simple_reporter_srv <- function(id, reporter, card, notification = TRUE) { - shiny::moduleServer( - id, - function(input, output, session) { - add_card_button_srv("addReportCard", reporter = reporter, card = card) - download_report_button_srv("downloadButton", reporter = reporter, notification = notification) - } - ) -} diff --git a/R/utils.R b/R/utils.R deleted file mode 100644 index 59acbfbf..00000000 --- a/R/utils.R +++ /dev/null @@ -1,24 +0,0 @@ -#' Extract Add Card Button input -#' @description extracts Add Card Button input and looks for an id with a suffix `addReportCardButton`. -#' It is needed to identify when to trigger the reactivity cycle for the `ReportCard`. -#' -#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param input shiny input, `reactivevalues`. -#' @return value -#' @note has to be invoked inside the active reactive context. -#' @export -extract_addcard_input <- function(input) { - checkmate::assert_class(input, "reactivevalues") - nams <- names(input) - which_addcard <- grep("addReportCardButton$", nams) - res <- nams[which_addcard] - val <- - shiny::reactive( - if (length(res) == 1) { - input[[res]] - } else { - NULL - } - ) - val() -} diff --git a/man/add_card_button_ui.Rd b/man/add_card_button_ui.Rd deleted file mode 100644 index c52ace0f..00000000 --- a/man/add_card_button_ui.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AddCardModule.R -\name{add_card_button_ui} -\alias{add_card_button_ui} -\title{Add Card Button User Interface} -\usage{ -add_card_button_ui(id) -} -\arguments{ -\item{id}{\code{character}} -} -\value{ -\code{shiny::tagList} -} -\description{ -button for adding views/cards to the Report. Part of the simple Reporter user interface. - -For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. -} diff --git a/man/add_card_button_srv.Rd b/man/add_card_srv.Rd similarity index 77% rename from man/add_card_button_srv.Rd rename to man/add_card_srv.Rd index c1464e04..c576ea75 100644 --- a/man/add_card_button_srv.Rd +++ b/man/add_card_srv.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AddCardModule.R -\name{add_card_button_srv} -\alias{add_card_button_srv} -\title{Add Card Button Server} +\name{add_card_srv} +\alias{add_card_srv} +\title{Add Card Server} \usage{ -add_card_button_srv(id, reporter, card) +add_card_srv(id, reporter, card) } \arguments{ \item{id}{\code{character}} diff --git a/man/download_report_button_ui.Rd b/man/download_report_button_ui.Rd deleted file mode 100644 index 9db63046..00000000 --- a/man/download_report_button_ui.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/DownloadModule.R -\name{download_report_button_ui} -\alias{download_report_button_ui} -\title{Download Button Reporter User Interface} -\usage{ -download_report_button_ui(id) -} -\arguments{ -\item{id}{\code{character}} -} -\value{ -\code{shiny::tagList} -} -\description{ -button for downloading the Report. Part of the simple Reporter user interface. - -For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. -} diff --git a/man/download_report_button_srv.Rd b/man/download_report_srv.Rd similarity index 77% rename from man/download_report_button_srv.Rd rename to man/download_report_srv.Rd index 2da5e3e1..b7fb8d64 100644 --- a/man/download_report_button_srv.Rd +++ b/man/download_report_srv.Rd @@ -1,15 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/DownloadModule.R -\name{download_report_button_srv} -\alias{download_report_button_srv} -\title{Download Button Server} +\name{download_report_srv} +\alias{download_report_srv} +\title{Download report Server} \usage{ -download_report_button_srv( +download_report_srv( id, reporter, notification = TRUE, output_types = c("pdf document", "html document", "powerpoint presentation", - "word document") + "word document"), + show_modal = shiny::reactive(NULL) ) } \arguments{ @@ -21,6 +22,8 @@ download_report_button_srv( \item{output_types}{\code{character} vector with \code{rmarkdown} output types, by default \code{c("pdf document", "html document", "powerpoint presentation", "word document")}.} + +\item{show_modal}{\code{reactive} to trigger popup of the download modal} } \value{ \code{shiny::moduleServer} diff --git a/man/simple_reporter_srv.Rd b/man/simple_reporter_srv.Rd deleted file mode 100644 index e5fe382e..00000000 --- a/man/simple_reporter_srv.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SimpleReporter.R -\name{simple_reporter_srv} -\alias{simple_reporter_srv} -\title{Simple Reporter Server} -\usage{ -simple_reporter_srv(id, reporter, card, notification = TRUE) -} -\arguments{ -\item{id}{\code{character}} - -\item{reporter}{\code{Reporter} instance.} - -\item{card}{\code{ReportCard} instance} - -\item{notification}{logical if to add shiny notification about the download process.} -} -\value{ -\code{shiny::moduleServer} -} -\description{ -two buttons for adding views and downloading the Report. -The add module has \code{addReportCard} id and download module the \code{downloadButton} id. - -For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. -} diff --git a/man/simple_reporter_ui.Rd b/man/simple_reporter_ui.Rd deleted file mode 100644 index 0f268fe1..00000000 --- a/man/simple_reporter_ui.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SimpleReporter.R -\name{simple_reporter_ui} -\alias{simple_reporter_ui} -\title{Simple Reporter User Interface} -\usage{ -simple_reporter_ui(id) -} -\arguments{ -\item{id}{\code{character}} -} -\value{ -\code{shiny::tagList} -} -\description{ -two buttons for adding views and downloading the Report. - -For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. -} diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index 050b2834..f8607013 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -9,9 +9,9 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("download_report_button_srv", { +testthat::test_that("download_report_srv", { shiny::testServer( - download_report_button_srv, + download_report_srv, args = list(reporter = reporter), expr = { session$setInputs(`download_button` = 0) @@ -44,9 +44,9 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("download_report_button_srv", { +testthat::test_that("download_report_srv", { shiny::testServer( - download_report_button_srv, + download_report_srv, args = list(reporter = reporter), expr = { testthat::expect_identical(reporter$get_cards(), list(card1)) @@ -56,9 +56,3 @@ testthat::test_that("download_report_button_srv", { } ) }) - -testthat::test_that("download_report_button_ui", { - testthat::expect_true( - inherits(download_report_button_ui("sth"), c("shiny.tag.list", "list")) - ) -}) diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R deleted file mode 100644 index 8ecb3515..00000000 --- a/tests/testthat/test-SimpleReporter.R +++ /dev/null @@ -1,102 +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() -) - -reporter <- Reporter$new() -reporter$append_cards(list(card1)) - -testthat::test_that("download_report_button_srv", { - shiny::testServer( - simple_reporter_srv, - args = list(reporter = reporter), - expr = { - session$setInputs(`download_button` = 0) - session$setInputs(`downloadButton-docType` = "html_document") - session$setInputs(`downloadButton-docTitle` = "TITLE") - session$setInputs(`downloadButton-docAuthor` = "AUTHOR") - session$setInputs(`downloadButton-download_data` = 0) - - f <- output$`downloadButton-download_data` - testthat::expect_true(file.exists(f)) - tmp_dir <- tempdir() - output_dir <- file.path(tmp_dir, sprintf("report_test_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) - dir.create(path = output_dir) - zip::unzip(f, exdir = output_dir) - files <- list.files(output_dir, recursive = TRUE) - testthat::expect_true(any(grepl("[.]Rmd", files))) - testthat::expect_true(any(grepl("[.]html", files))) - } - ) -}) - -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() -) - -reporter <- Reporter$new() -reporter$append_cards(list(card1)) - -testthat::test_that("download_report_button_srv", { - shiny::testServer( - simple_reporter_srv, - args = list(reporter = reporter), - expr = { - testthat::expect_identical(reporter$get_cards(), list(card1)) - session$setInputs(`downloadButton-reset_reporter` = 0) - session$setInputs(`downloadButton-reset_reporter_ok` = 0) - testthat::expect_identical(reporter$get_blocks(), list()) - } - ) -}) - -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() -) - -reporter <- Reporter$new() - -testthat::test_that("add_card_button_srv", { - shiny::testServer( - simple_reporter_srv, - args = list(reporter = reporter, card = reactive(card1)), - expr = { - card_len <- length(card()$get_content()) - session$setInputs(`addReportCard-addReportCardButton` = 0) - session$setInputs(`addReportCard-comment` = "Comment Body") - session$setInputs(`addReportCard-addCardOk` = 0) - - testthat::expect_identical( - length(reporter$get_blocks()), - card_len + 2L - ) - - testthat::expect_identical( - tail(reporter$get_blocks(), 1)[[1]]$get_content(), - "Comment Body" - ) - - testthat::expect_identical( - tail(reporter$get_blocks(), 2)[[1]]$get_content(), - "Comment" - ) - } - ) -}) - -testthat::test_that("simple_reporter_ui", { - testthat::expect_true( - inherits(simple_reporter_ui("sth"), c("shiny.tag.list", "list")) - ) -}) diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R index 91a2432f..24e542fc 100644 --- a/tests/testthat/test-addCardModule.R +++ b/tests/testthat/test-addCardModule.R @@ -8,9 +8,9 @@ card1$append_plot( reporter <- Reporter$new() -testthat::test_that("add_card_button_srv", { +testthat::test_that("add_card_srv", { shiny::testServer( - add_card_button_srv, + add_card_srv, args = list(reporter = reporter, card = reactive(card1)), expr = { card_len <- length(card()$get_content()) @@ -35,9 +35,3 @@ testthat::test_that("add_card_button_srv", { } ) }) - -testthat::test_that("add_card_button_ui", { - testthat::expect_true( - inherits(add_card_button_ui("sth"), c("shiny.tag.list", "list")) - ) -}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R deleted file mode 100644 index 6a2e1bb5..00000000 --- a/tests/testthat/test-utils.R +++ /dev/null @@ -1,41 +0,0 @@ -testthat::test_that("extract_addcard_input throws error when input is not a reactivevalues", { - vals <- list() - testthat::expect_error(isolate(extract_addcard_input(vals))) -}) - -testthat::test_that("extract_addcard_input returns empty id if there is no match", { - vals <- shiny::reactiveValues(a = 1, b = 2) - testthat::expect_identical( - isolate(extract_addcard_input(vals)), - NULL - ) -}) - -testthat::test_that("extract_addcard_input returns right id when there is a correct match", { - vals <- shiny::reactiveValues(a = 1, b = 2, `addReportCardButton` = 0) - testthat::expect_identical( - isolate(extract_addcard_input(vals)), - 0 - ) -}) - -testthat::test_that("correct match 2", { - vals <- shiny::reactiveValues(a = 1, b = 2, `teal-addReportCard-addReportCardButton` = 0) - testthat::expect_identical( - isolate(extract_addcard_input(vals)), - 0 - ) -}) - -testthat::test_that("extract_addcard_input returns empty id if there is double match", { - vals <- shiny::reactiveValues( - a = 1, - b = 2, - `addReportCard-addReportCard` = 0, - `addReportCard2-addReportCard` = 0 - ) - testthat::expect_identical( - isolate(extract_addcard_input(vals)), - NULL - ) -}) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index 47be2e53..ca5da85b 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -47,8 +47,8 @@ ui <- fluidPage( ), mainPanel( ### REPORTER - teal.reporter::add_card_button_ui("addReportCard"), - teal.reporter::download_report_button_ui("downloadButton"), + actionButton("addCardButton", "Add card"), + actionButton("downloadReportButton", "Download report"), ### tags$br(), tags$br(), @@ -107,8 +107,8 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() - card_r <- eventReactive( - eventExpr = teal.reporter::extract_addcard_input(input), + card <- eventReactive( + input$addCardButton, valueExpr = { card <- teal.reporter::ReportCard$new() if (input$tabs == "Plot") { @@ -118,107 +118,16 @@ server <- function(input, output, session) { card$append_text("My Table", "header2") card$append_table(table()) } - card } ) + teal.reporter::add_card_srv("AddCard", reporter = reporter, card) - teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card = card_r) - teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) - ### -} - -shinyApp(ui = ui, server = server) -``` - -Simple Reporter shiny app with combined buttons modules: - -```{r} -ui <- fluidPage( - titlePanel(""), - sidebarLayout( - sidebarPanel( - uiOutput("encoding") - ), - mainPanel( - ### REPORTER - teal.reporter::simple_reporter_ui("simpleReporter"), - ### - tags$br(), - tags$br(), - tabsetPanel( - id = "tabs", - tabPanel("Plot", plotOutput("dist_plot")), - tabPanel("Table", verbatimTextOutput("table")) - ) - ) + teal.reporter::download_report_srv( + "downloadReport", + reporter = reporter, + show_modal = reactive(input$downloadReportButton) ) -) - -server <- function(input, output, session) { - output$encoding <- renderUI({ - if (input$tabs == "Plot") { - sliderInput( - "binwidth", - "binwidth", - min = 2, - max = 10, - value = 8 - ) - } else { - selectInput( - "stat", - label = "Statistic", - choices = c("mean", "median", "sd"), - "mean" - ) - } - }) - - plot <- reactive({ - req(input$binwidth) - x <- mtcars$mpg - ggplot2::ggplot(data = mtcars, ggplot2::aes(x = mpg)) + - ggplot2::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() - }) - - ### REPORTER - reporter <- teal.reporter::Reporter$new() - card_r <- eventReactive( - eventExpr = teal.reporter::extract_addcard_input(input), - valueExpr = { - card <- teal.reporter::ReportCard$new() - if (input$tabs == "Plot") { - card$append_text("My plot", "header2") - card$append_plot(plot()) - } else if (input$tabs == "Table") { - card$append_text("My Table", "header2") - card$append_table(table()) - } - card - } - ) - - teal.reporter::simple_reporter_srv("simpleReporter", reporter = reporter, card = card_r) - ### } shinyApp(ui = ui, server = server) ``` - From d7f4f9744a53a13ef64e6508d714a68f17c74403 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 13:46:27 +0200 Subject: [PATCH 25/49] docs --- NAMESPACE | 1 - man/extract_addcard_input.Rd | 23 ----------------------- 2 files changed, 24 deletions(-) delete mode 100644 man/extract_addcard_input.Rd diff --git a/NAMESPACE b/NAMESPACE index 74b097a5..55c51ecf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,7 +4,6 @@ export(ReportCard) export(Reporter) export(add_card_srv) export(download_report_srv) -export(extract_addcard_input) importFrom(R6,R6Class) importFrom(checkmate,assert_string) importFrom(grid,grid.newpage) diff --git a/man/extract_addcard_input.Rd b/man/extract_addcard_input.Rd deleted file mode 100644 index 66ed0c82..00000000 --- a/man/extract_addcard_input.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{extract_addcard_input} -\alias{extract_addcard_input} -\title{Extract Add Card Button input} -\usage{ -extract_addcard_input(input) -} -\arguments{ -\item{input}{shiny input, \code{reactivevalues}.} -} -\value{ -value -} -\description{ -extracts Add Card Button input and looks for an id with a suffix \code{addReportCardButton}. -It is needed to identify when to trigger the reactivity cycle for the \code{ReportCard}. - -For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. -} -\note{ -has to be invoked inside the active reactive context. -} From 934e7f5dffe48c6bb17e0c6b837ea0e691420e94 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 13:51:30 +0200 Subject: [PATCH 26/49] style --- R/DownloadModule.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index cfd2e55d..bae7fb8b 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -11,11 +11,11 @@ #' @return `shiny::moduleServer` #' @export download_report_srv <- function(id, reporter, - notification = TRUE, - output_types = c( - "pdf document", "html document", - "powerpoint presentation", "word document" - ), show_modal = shiny::reactive(NULL)) { + notification = TRUE, + output_types = c( + "pdf document", "html document", + "powerpoint presentation", "word document" + ), show_modal = shiny::reactive(NULL)) { shiny::moduleServer( id, function(input, output, session) { From d3013bab1bc74d07d44d2f457b21010da88c7b86 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 16:53:20 +0200 Subject: [PATCH 27/49] revert update This reverts commit 934e7f5dffe48c6bb17e0c6b837ea0e691420e94. --- R/DownloadModule.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index bae7fb8b..cfd2e55d 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -11,11 +11,11 @@ #' @return `shiny::moduleServer` #' @export download_report_srv <- function(id, reporter, - notification = TRUE, - output_types = c( - "pdf document", "html document", - "powerpoint presentation", "word document" - ), show_modal = shiny::reactive(NULL)) { + notification = TRUE, + output_types = c( + "pdf document", "html document", + "powerpoint presentation", "word document" + ), show_modal = shiny::reactive(NULL)) { shiny::moduleServer( id, function(input, output, session) { From 2157e0b50fd7fcc49470a5c1f152a315c339c774 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 16:53:41 +0200 Subject: [PATCH 28/49] Revert "docs" This reverts commit d7f4f9744a53a13ef64e6508d714a68f17c74403. --- NAMESPACE | 1 + man/extract_addcard_input.Rd | 23 +++++++++++++++++++++++ 2 files changed, 24 insertions(+) create mode 100644 man/extract_addcard_input.Rd diff --git a/NAMESPACE b/NAMESPACE index 55c51ecf..74b097a5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ export(ReportCard) export(Reporter) export(add_card_srv) export(download_report_srv) +export(extract_addcard_input) importFrom(R6,R6Class) importFrom(checkmate,assert_string) importFrom(grid,grid.newpage) diff --git a/man/extract_addcard_input.Rd b/man/extract_addcard_input.Rd new file mode 100644 index 00000000..66ed0c82 --- /dev/null +++ b/man/extract_addcard_input.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{extract_addcard_input} +\alias{extract_addcard_input} +\title{Extract Add Card Button input} +\usage{ +extract_addcard_input(input) +} +\arguments{ +\item{input}{shiny input, \code{reactivevalues}.} +} +\value{ +value +} +\description{ +extracts Add Card Button input and looks for an id with a suffix \code{addReportCardButton}. +It is needed to identify when to trigger the reactivity cycle for the \code{ReportCard}. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. +} +\note{ +has to be invoked inside the active reactive context. +} From 30954da11fc1cf7559d94f772ce0a0d62eb0a1eb Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 16:53:48 +0200 Subject: [PATCH 29/49] Revert "buttons specified by user (#28)" This reverts commit af9e25bd7f8a39d46b8c6a1b5adfac968b30c349. --- NAMESPACE | 8 +- R/AddCardModule.R | 26 ++++- R/DownloadModule.R | 32 ++++- R/SimpleReporter.R | 35 ++++++ R/utils.R | 24 ++++ ...add_card_srv.Rd => add_card_button_srv.Rd} | 8 +- man/add_card_button_ui.Rd | 19 +++ ...t_srv.Rd => download_report_button_srv.Rd} | 13 +-- man/download_report_button_ui.Rd | 19 +++ man/simple_reporter_srv.Rd | 26 +++++ man/simple_reporter_ui.Rd | 19 +++ tests/testthat/test-DownloadReportModule.R | 14 ++- tests/testthat/test-SimpleReporter.R | 102 ++++++++++++++++ tests/testthat/test-addCardModule.R | 10 +- tests/testthat/test-utils.R | 41 +++++++ vignettes/simpleReporter.Rmd | 109 ++++++++++++++++-- 16 files changed, 467 insertions(+), 38 deletions(-) create mode 100644 R/SimpleReporter.R create mode 100644 R/utils.R rename man/{add_card_srv.Rd => add_card_button_srv.Rd} (77%) create mode 100644 man/add_card_button_ui.Rd rename man/{download_report_srv.Rd => download_report_button_srv.Rd} (77%) create mode 100644 man/download_report_button_ui.Rd create mode 100644 man/simple_reporter_srv.Rd create mode 100644 man/simple_reporter_ui.Rd create mode 100644 tests/testthat/test-SimpleReporter.R create mode 100644 tests/testthat/test-utils.R diff --git a/NAMESPACE b/NAMESPACE index 74b097a5..a87f8e80 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,9 +2,13 @@ export(ReportCard) export(Reporter) -export(add_card_srv) -export(download_report_srv) +export(add_card_button_srv) +export(add_card_button_ui) +export(download_report_button_srv) +export(download_report_button_ui) export(extract_addcard_input) +export(simple_reporter_srv) +export(simple_reporter_ui) importFrom(R6,R6Class) importFrom(checkmate,assert_string) importFrom(grid,grid.newpage) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 2d96fab9..8a531360 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -1,5 +1,25 @@ +#' Add Card Button User Interface +#' @description button for adding views/cards to the Report. Part of the simple Reporter user interface. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. +#' @param id `character` +#' @return `shiny::tagList` +#' @export +add_card_button_ui <- function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::tags$button( + id = ns("addReportCardButton"), + type = "button", + class = "btn btn-primary action-button", + `data-val` = shiny::restoreInput(id = ns("addReportCardButton"), default = NULL), + NULL, + "Add Card" + ) + ) +} -#' Add Card Server +#' Add Card Button Server #' @description server for adding views/cards the Report. Part of the simple Reporter. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. @@ -9,7 +29,7 @@ #' @return `shiny::moduleServer` #' @export #' @export -add_card_srv <- function(id, reporter, card) { +add_card_button_srv <- function(id, reporter, card) { shiny::moduleServer( id, function(input, output, session) { @@ -51,7 +71,7 @@ add_card_srv <- function(id, reporter, card) { ) } - shiny::observeEvent(card(), { + shiny::observeEvent(input$addReportCardButton, { shiny::showModal(add_modal()) }) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index cfd2e55d..378efc3a 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -1,4 +1,25 @@ -#' Download report Server +#' Download Button Reporter User Interface +#' @description button for downloading the Report. Part of the simple Reporter user interface. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. +#' @param id `character` +#' @return `shiny::tagList` +#' @export +download_report_button_ui <- function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::tags$button( + id = ns("download_button"), + type = "button", + class = "btn btn-primary action-button", + `data-val` = shiny::restoreInput(id = ns("download_button"), default = NULL), + NULL, + "Download Report" + ) + ) +} + +#' Download Button Server #' @description server for downloading the Report. Part of the simple Reporter. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. @@ -7,15 +28,15 @@ #' @param notification logical whether to add shiny notification about the download process, by default `TRUE`. #' @param output_types `character` vector with `rmarkdown` output types, #' by default `c("pdf document", "html document", "powerpoint presentation", "word document")`. -#' @param show_modal `reactive` to trigger popup of the download modal #' @return `shiny::moduleServer` #' @export -download_report_srv <- function(id, reporter, +download_report_button_srv <- function(id, + reporter, notification = TRUE, output_types = c( "pdf document", "html document", "powerpoint presentation", "word document" - ), show_modal = shiny::reactive(NULL)) { + )) { shiny::moduleServer( id, function(input, output, session) { @@ -83,11 +104,10 @@ download_report_srv <- function(id, reporter, ) } - shiny::observeEvent(show_modal(), { + shiny::observeEvent(input$download_button, { shiny::showModal(download_modal()) }) - shiny::observeEvent(input$reset_reporter, { shiny::showModal( shiny::modalDialog( diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R new file mode 100644 index 00000000..43e1041e --- /dev/null +++ b/R/SimpleReporter.R @@ -0,0 +1,35 @@ +#' Simple Reporter User Interface +#' @description two buttons for adding views and downloading the Report. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. +#' @param id `character` +#' @return `shiny::tagList` +#' @export +simple_reporter_ui <- function(id) { + ns <- shiny::NS(id) + shiny::tagList( + add_card_button_ui(ns("addReportCard")), + download_report_button_ui(ns("downloadButton")), + ) +} + +#' Simple Reporter Server +#' @description two buttons for adding views and downloading the Report. +#' The add module has `addReportCard` id and download module the `downloadButton` id. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. +#' @param id `character` +#' @param reporter `Reporter` instance. +#' @param card `ReportCard` instance +#' @param notification logical if to add shiny notification about the download process. +#' @return `shiny::moduleServer` +#' @export +simple_reporter_srv <- function(id, reporter, card, notification = TRUE) { + shiny::moduleServer( + id, + function(input, output, session) { + add_card_button_srv("addReportCard", reporter = reporter, card = card) + download_report_button_srv("downloadButton", reporter = reporter, notification = notification) + } + ) +} diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 00000000..59acbfbf --- /dev/null +++ b/R/utils.R @@ -0,0 +1,24 @@ +#' Extract Add Card Button input +#' @description extracts Add Card Button input and looks for an id with a suffix `addReportCardButton`. +#' It is needed to identify when to trigger the reactivity cycle for the `ReportCard`. +#' +#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. +#' @param input shiny input, `reactivevalues`. +#' @return value +#' @note has to be invoked inside the active reactive context. +#' @export +extract_addcard_input <- function(input) { + checkmate::assert_class(input, "reactivevalues") + nams <- names(input) + which_addcard <- grep("addReportCardButton$", nams) + res <- nams[which_addcard] + val <- + shiny::reactive( + if (length(res) == 1) { + input[[res]] + } else { + NULL + } + ) + val() +} diff --git a/man/add_card_srv.Rd b/man/add_card_button_srv.Rd similarity index 77% rename from man/add_card_srv.Rd rename to man/add_card_button_srv.Rd index c576ea75..c1464e04 100644 --- a/man/add_card_srv.Rd +++ b/man/add_card_button_srv.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AddCardModule.R -\name{add_card_srv} -\alias{add_card_srv} -\title{Add Card Server} +\name{add_card_button_srv} +\alias{add_card_button_srv} +\title{Add Card Button Server} \usage{ -add_card_srv(id, reporter, card) +add_card_button_srv(id, reporter, card) } \arguments{ \item{id}{\code{character}} diff --git a/man/add_card_button_ui.Rd b/man/add_card_button_ui.Rd new file mode 100644 index 00000000..c52ace0f --- /dev/null +++ b/man/add_card_button_ui.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AddCardModule.R +\name{add_card_button_ui} +\alias{add_card_button_ui} +\title{Add Card Button User Interface} +\usage{ +add_card_button_ui(id) +} +\arguments{ +\item{id}{\code{character}} +} +\value{ +\code{shiny::tagList} +} +\description{ +button for adding views/cards to the Report. Part of the simple Reporter user interface. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. +} diff --git a/man/download_report_srv.Rd b/man/download_report_button_srv.Rd similarity index 77% rename from man/download_report_srv.Rd rename to man/download_report_button_srv.Rd index b7fb8d64..2da5e3e1 100644 --- a/man/download_report_srv.Rd +++ b/man/download_report_button_srv.Rd @@ -1,16 +1,15 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/DownloadModule.R -\name{download_report_srv} -\alias{download_report_srv} -\title{Download report Server} +\name{download_report_button_srv} +\alias{download_report_button_srv} +\title{Download Button Server} \usage{ -download_report_srv( +download_report_button_srv( id, reporter, notification = TRUE, output_types = c("pdf document", "html document", "powerpoint presentation", - "word document"), - show_modal = shiny::reactive(NULL) + "word document") ) } \arguments{ @@ -22,8 +21,6 @@ download_report_srv( \item{output_types}{\code{character} vector with \code{rmarkdown} output types, by default \code{c("pdf document", "html document", "powerpoint presentation", "word document")}.} - -\item{show_modal}{\code{reactive} to trigger popup of the download modal} } \value{ \code{shiny::moduleServer} diff --git a/man/download_report_button_ui.Rd b/man/download_report_button_ui.Rd new file mode 100644 index 00000000..9db63046 --- /dev/null +++ b/man/download_report_button_ui.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DownloadModule.R +\name{download_report_button_ui} +\alias{download_report_button_ui} +\title{Download Button Reporter User Interface} +\usage{ +download_report_button_ui(id) +} +\arguments{ +\item{id}{\code{character}} +} +\value{ +\code{shiny::tagList} +} +\description{ +button for downloading the Report. Part of the simple Reporter user interface. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. +} diff --git a/man/simple_reporter_srv.Rd b/man/simple_reporter_srv.Rd new file mode 100644 index 00000000..e5fe382e --- /dev/null +++ b/man/simple_reporter_srv.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/SimpleReporter.R +\name{simple_reporter_srv} +\alias{simple_reporter_srv} +\title{Simple Reporter Server} +\usage{ +simple_reporter_srv(id, reporter, card, notification = TRUE) +} +\arguments{ +\item{id}{\code{character}} + +\item{reporter}{\code{Reporter} instance.} + +\item{card}{\code{ReportCard} instance} + +\item{notification}{logical if to add shiny notification about the download process.} +} +\value{ +\code{shiny::moduleServer} +} +\description{ +two buttons for adding views and downloading the Report. +The add module has \code{addReportCard} id and download module the \code{downloadButton} id. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. +} diff --git a/man/simple_reporter_ui.Rd b/man/simple_reporter_ui.Rd new file mode 100644 index 00000000..0f268fe1 --- /dev/null +++ b/man/simple_reporter_ui.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/SimpleReporter.R +\name{simple_reporter_ui} +\alias{simple_reporter_ui} +\title{Simple Reporter User Interface} +\usage{ +simple_reporter_ui(id) +} +\arguments{ +\item{id}{\code{character}} +} +\value{ +\code{shiny::tagList} +} +\description{ +two buttons for adding views and downloading the Report. + +For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. +} diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index f8607013..050b2834 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -9,9 +9,9 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("download_report_srv", { +testthat::test_that("download_report_button_srv", { shiny::testServer( - download_report_srv, + download_report_button_srv, args = list(reporter = reporter), expr = { session$setInputs(`download_button` = 0) @@ -44,9 +44,9 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("download_report_srv", { +testthat::test_that("download_report_button_srv", { shiny::testServer( - download_report_srv, + download_report_button_srv, args = list(reporter = reporter), expr = { testthat::expect_identical(reporter$get_cards(), list(card1)) @@ -56,3 +56,9 @@ testthat::test_that("download_report_srv", { } ) }) + +testthat::test_that("download_report_button_ui", { + testthat::expect_true( + inherits(download_report_button_ui("sth"), c("shiny.tag.list", "list")) + ) +}) diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R new file mode 100644 index 00000000..8ecb3515 --- /dev/null +++ b/tests/testthat/test-SimpleReporter.R @@ -0,0 +1,102 @@ +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() +) + +reporter <- Reporter$new() +reporter$append_cards(list(card1)) + +testthat::test_that("download_report_button_srv", { + shiny::testServer( + simple_reporter_srv, + args = list(reporter = reporter), + expr = { + session$setInputs(`download_button` = 0) + session$setInputs(`downloadButton-docType` = "html_document") + session$setInputs(`downloadButton-docTitle` = "TITLE") + session$setInputs(`downloadButton-docAuthor` = "AUTHOR") + session$setInputs(`downloadButton-download_data` = 0) + + f <- output$`downloadButton-download_data` + testthat::expect_true(file.exists(f)) + tmp_dir <- tempdir() + output_dir <- file.path(tmp_dir, sprintf("report_test_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) + dir.create(path = output_dir) + zip::unzip(f, exdir = output_dir) + files <- list.files(output_dir, recursive = TRUE) + testthat::expect_true(any(grepl("[.]Rmd", files))) + testthat::expect_true(any(grepl("[.]html", files))) + } + ) +}) + +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() +) + +reporter <- Reporter$new() +reporter$append_cards(list(card1)) + +testthat::test_that("download_report_button_srv", { + shiny::testServer( + simple_reporter_srv, + args = list(reporter = reporter), + expr = { + testthat::expect_identical(reporter$get_cards(), list(card1)) + session$setInputs(`downloadButton-reset_reporter` = 0) + session$setInputs(`downloadButton-reset_reporter_ok` = 0) + testthat::expect_identical(reporter$get_blocks(), list()) + } + ) +}) + +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() +) + +reporter <- Reporter$new() + +testthat::test_that("add_card_button_srv", { + shiny::testServer( + simple_reporter_srv, + args = list(reporter = reporter, card = reactive(card1)), + expr = { + card_len <- length(card()$get_content()) + session$setInputs(`addReportCard-addReportCardButton` = 0) + session$setInputs(`addReportCard-comment` = "Comment Body") + session$setInputs(`addReportCard-addCardOk` = 0) + + testthat::expect_identical( + length(reporter$get_blocks()), + card_len + 2L + ) + + testthat::expect_identical( + tail(reporter$get_blocks(), 1)[[1]]$get_content(), + "Comment Body" + ) + + testthat::expect_identical( + tail(reporter$get_blocks(), 2)[[1]]$get_content(), + "Comment" + ) + } + ) +}) + +testthat::test_that("simple_reporter_ui", { + testthat::expect_true( + inherits(simple_reporter_ui("sth"), c("shiny.tag.list", "list")) + ) +}) diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R index 24e542fc..91a2432f 100644 --- a/tests/testthat/test-addCardModule.R +++ b/tests/testthat/test-addCardModule.R @@ -8,9 +8,9 @@ card1$append_plot( reporter <- Reporter$new() -testthat::test_that("add_card_srv", { +testthat::test_that("add_card_button_srv", { shiny::testServer( - add_card_srv, + add_card_button_srv, args = list(reporter = reporter, card = reactive(card1)), expr = { card_len <- length(card()$get_content()) @@ -35,3 +35,9 @@ testthat::test_that("add_card_srv", { } ) }) + +testthat::test_that("add_card_button_ui", { + testthat::expect_true( + inherits(add_card_button_ui("sth"), c("shiny.tag.list", "list")) + ) +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R new file mode 100644 index 00000000..6a2e1bb5 --- /dev/null +++ b/tests/testthat/test-utils.R @@ -0,0 +1,41 @@ +testthat::test_that("extract_addcard_input throws error when input is not a reactivevalues", { + vals <- list() + testthat::expect_error(isolate(extract_addcard_input(vals))) +}) + +testthat::test_that("extract_addcard_input returns empty id if there is no match", { + vals <- shiny::reactiveValues(a = 1, b = 2) + testthat::expect_identical( + isolate(extract_addcard_input(vals)), + NULL + ) +}) + +testthat::test_that("extract_addcard_input returns right id when there is a correct match", { + vals <- shiny::reactiveValues(a = 1, b = 2, `addReportCardButton` = 0) + testthat::expect_identical( + isolate(extract_addcard_input(vals)), + 0 + ) +}) + +testthat::test_that("correct match 2", { + vals <- shiny::reactiveValues(a = 1, b = 2, `teal-addReportCard-addReportCardButton` = 0) + testthat::expect_identical( + isolate(extract_addcard_input(vals)), + 0 + ) +}) + +testthat::test_that("extract_addcard_input returns empty id if there is double match", { + vals <- shiny::reactiveValues( + a = 1, + b = 2, + `addReportCard-addReportCard` = 0, + `addReportCard2-addReportCard` = 0 + ) + testthat::expect_identical( + isolate(extract_addcard_input(vals)), + NULL + ) +}) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index ca5da85b..47be2e53 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -47,8 +47,8 @@ ui <- fluidPage( ), mainPanel( ### REPORTER - actionButton("addCardButton", "Add card"), - actionButton("downloadReportButton", "Download report"), + teal.reporter::add_card_button_ui("addReportCard"), + teal.reporter::download_report_button_ui("downloadButton"), ### tags$br(), tags$br(), @@ -107,8 +107,8 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() - card <- eventReactive( - input$addCardButton, + card_r <- eventReactive( + eventExpr = teal.reporter::extract_addcard_input(input), valueExpr = { card <- teal.reporter::ReportCard$new() if (input$tabs == "Plot") { @@ -118,16 +118,107 @@ server <- function(input, output, session) { card$append_text("My Table", "header2") card$append_table(table()) } + card } ) - teal.reporter::add_card_srv("AddCard", reporter = reporter, card) - teal.reporter::download_report_srv( - "downloadReport", - reporter = reporter, - show_modal = reactive(input$downloadReportButton) + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card = card_r) + teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) + ### +} + +shinyApp(ui = ui, server = server) +``` + +Simple Reporter shiny app with combined buttons modules: + +```{r} +ui <- fluidPage( + titlePanel(""), + sidebarLayout( + sidebarPanel( + uiOutput("encoding") + ), + mainPanel( + ### REPORTER + teal.reporter::simple_reporter_ui("simpleReporter"), + ### + tags$br(), + tags$br(), + tabsetPanel( + id = "tabs", + tabPanel("Plot", plotOutput("dist_plot")), + tabPanel("Table", verbatimTextOutput("table")) + ) + ) ) +) + +server <- function(input, output, session) { + output$encoding <- renderUI({ + if (input$tabs == "Plot") { + sliderInput( + "binwidth", + "binwidth", + min = 2, + max = 10, + value = 8 + ) + } else { + selectInput( + "stat", + label = "Statistic", + choices = c("mean", "median", "sd"), + "mean" + ) + } + }) + + plot <- reactive({ + req(input$binwidth) + x <- mtcars$mpg + ggplot2::ggplot(data = mtcars, ggplot2::aes(x = mpg)) + + ggplot2::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() + }) + + ### REPORTER + reporter <- teal.reporter::Reporter$new() + card_r <- eventReactive( + eventExpr = teal.reporter::extract_addcard_input(input), + valueExpr = { + card <- teal.reporter::ReportCard$new() + if (input$tabs == "Plot") { + card$append_text("My plot", "header2") + card$append_plot(plot()) + } else if (input$tabs == "Table") { + card$append_text("My Table", "header2") + card$append_table(table()) + } + card + } + ) + + teal.reporter::simple_reporter_srv("simpleReporter", reporter = reporter, card = card_r) + ### } shinyApp(ui = ui, server = server) ``` + From 073c0f283b49f8fb66e730396a6d0b8f1a45f8f0 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 17:42:13 +0200 Subject: [PATCH 30/49] callback --- NAMESPACE | 1 - R/AddCardModule.R | 14 ++++++---- R/SimpleReporter.R | 6 ++-- R/utils.R | 24 ---------------- man/add_card_button_srv.Rd | 4 +-- man/extract_addcard_input.Rd | 23 ---------------- man/simple_reporter_srv.Rd | 4 +-- tests/testthat/test-SimpleReporter.R | 30 +++++++++++--------- tests/testthat/test-addCardModule.R | 21 ++++++++------ tests/testthat/test-utils.R | 41 ---------------------------- vignettes/simpleReporter.Rmd | 20 ++++---------- 11 files changed, 50 insertions(+), 138 deletions(-) delete mode 100644 R/utils.R delete mode 100644 man/extract_addcard_input.Rd delete mode 100644 tests/testthat/test-utils.R diff --git a/NAMESPACE b/NAMESPACE index a87f8e80..c8cbc2d7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,6 @@ export(add_card_button_srv) export(add_card_button_ui) export(download_report_button_srv) export(download_report_button_ui) -export(extract_addcard_input) export(simple_reporter_srv) export(simple_reporter_ui) importFrom(R6,R6Class) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 8a531360..3fd3e040 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -25,11 +25,11 @@ add_card_button_ui <- function(id) { #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` #' @param reporter `Reporter` instance. -#' @param card `ReportCard` instance +#' @param card_fun `function` which returns a `ReportCard` instance. #' @return `shiny::moduleServer` #' @export #' @export -add_card_button_srv <- function(id, reporter, card) { +add_card_button_srv <- function(id, reporter, card_fun) { shiny::moduleServer( id, function(input, output, session) { @@ -76,10 +76,12 @@ add_card_button_srv <- function(id, reporter, card) { }) shiny::observeEvent(input$addCardOk, { - checkmate::assert_class(card(), "ReportCard") - card()$append_text("Comment", "header3") - card()$append_text(input$comment) - reporter$append_cards(list(card())) + card <- ReportCard$new() + card_fun(card) + checkmate::assert_class(card, "ReportCard") + card$append_text("Comment", "header3") + card$append_text(input$comment) + reporter$append_cards(list(card)) shiny::removeModal() }) } diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index 43e1041e..9d057a0a 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -20,15 +20,15 @@ simple_reporter_ui <- function(id) { #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` #' @param reporter `Reporter` instance. -#' @param card `ReportCard` instance +#' @param card_fun `function` which returns a `ReportCard` instance. #' @param notification logical if to add shiny notification about the download process. #' @return `shiny::moduleServer` #' @export -simple_reporter_srv <- function(id, reporter, card, notification = TRUE) { +simple_reporter_srv <- function(id, reporter, card_fun, notification = TRUE) { shiny::moduleServer( id, function(input, output, session) { - add_card_button_srv("addReportCard", reporter = reporter, card = card) + add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) download_report_button_srv("downloadButton", reporter = reporter, notification = notification) } ) diff --git a/R/utils.R b/R/utils.R deleted file mode 100644 index 59acbfbf..00000000 --- a/R/utils.R +++ /dev/null @@ -1,24 +0,0 @@ -#' Extract Add Card Button input -#' @description extracts Add Card Button input and looks for an id with a suffix `addReportCardButton`. -#' It is needed to identify when to trigger the reactivity cycle for the `ReportCard`. -#' -#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. -#' @param input shiny input, `reactivevalues`. -#' @return value -#' @note has to be invoked inside the active reactive context. -#' @export -extract_addcard_input <- function(input) { - checkmate::assert_class(input, "reactivevalues") - nams <- names(input) - which_addcard <- grep("addReportCardButton$", nams) - res <- nams[which_addcard] - val <- - shiny::reactive( - if (length(res) == 1) { - input[[res]] - } else { - NULL - } - ) - val() -} diff --git a/man/add_card_button_srv.Rd b/man/add_card_button_srv.Rd index c1464e04..ca456dde 100644 --- a/man/add_card_button_srv.Rd +++ b/man/add_card_button_srv.Rd @@ -4,14 +4,14 @@ \alias{add_card_button_srv} \title{Add Card Button Server} \usage{ -add_card_button_srv(id, reporter, card) +add_card_button_srv(id, reporter, card_fun) } \arguments{ \item{id}{\code{character}} \item{reporter}{\code{Reporter} instance.} -\item{card}{\code{ReportCard} instance} +\item{card_fun}{\code{function} which returns a \code{ReportCard} instance.} } \value{ \code{shiny::moduleServer} diff --git a/man/extract_addcard_input.Rd b/man/extract_addcard_input.Rd deleted file mode 100644 index 66ed0c82..00000000 --- a/man/extract_addcard_input.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{extract_addcard_input} -\alias{extract_addcard_input} -\title{Extract Add Card Button input} -\usage{ -extract_addcard_input(input) -} -\arguments{ -\item{input}{shiny input, \code{reactivevalues}.} -} -\value{ -value -} -\description{ -extracts Add Card Button input and looks for an id with a suffix \code{addReportCardButton}. -It is needed to identify when to trigger the reactivity cycle for the \code{ReportCard}. - -For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. -} -\note{ -has to be invoked inside the active reactive context. -} diff --git a/man/simple_reporter_srv.Rd b/man/simple_reporter_srv.Rd index e5fe382e..774eada0 100644 --- a/man/simple_reporter_srv.Rd +++ b/man/simple_reporter_srv.Rd @@ -4,14 +4,14 @@ \alias{simple_reporter_srv} \title{Simple Reporter Server} \usage{ -simple_reporter_srv(id, reporter, card, notification = TRUE) +simple_reporter_srv(id, reporter, card_fun, notification = TRUE) } \arguments{ \item{id}{\code{character}} \item{reporter}{\code{Reporter} instance.} -\item{card}{\code{ReportCard} instance} +\item{card_fun}{\code{function} which returns a \code{ReportCard} instance.} \item{notification}{logical if to add shiny notification about the download process.} } diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R index 8ecb3515..bada87cd 100644 --- a/tests/testthat/test-SimpleReporter.R +++ b/tests/testthat/test-SimpleReporter.R @@ -9,10 +9,10 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("download_report_button_srv", { +testthat::test_that("simple_reporter_srv", { shiny::testServer( simple_reporter_srv, - args = list(reporter = reporter), + args = list(reporter = reporter, card_fun = NULL), expr = { session$setInputs(`download_button` = 0) session$setInputs(`downloadButton-docType` = "html_document") @@ -44,7 +44,7 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("download_report_button_srv", { +testthat::test_that("simple_reporter_srv", { shiny::testServer( simple_reporter_srv, args = list(reporter = reporter), @@ -57,22 +57,26 @@ testthat::test_that("download_report_button_srv", { ) }) -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() -) + +card_fun <- function(card = 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() + ) + card +} + reporter <- Reporter$new() -testthat::test_that("add_card_button_srv", { +testthat::test_that("simple_reporter_srv", { shiny::testServer( simple_reporter_srv, - args = list(reporter = reporter, card = reactive(card1)), + args = list(reporter = reporter, card_fun = card_fun), expr = { - card_len <- length(card()$get_content()) + card_len <- length(card_fun()$get_content()) session$setInputs(`addReportCard-addReportCardButton` = 0) session$setInputs(`addReportCard-comment` = "Comment Body") session$setInputs(`addReportCard-addCardOk` = 0) diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R index 91a2432f..40d2e99c 100644 --- a/tests/testthat/test-addCardModule.R +++ b/tests/testthat/test-addCardModule.R @@ -1,19 +1,22 @@ -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() -) +card_fun <- function(card = 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() + ) + card +} + reporter <- Reporter$new() testthat::test_that("add_card_button_srv", { shiny::testServer( add_card_button_srv, - args = list(reporter = reporter, card = reactive(card1)), + args = list(reporter = reporter, card_fun = card_fun), expr = { - card_len <- length(card()$get_content()) + card_len <- length(card_fun()$get_content()) session$setInputs(`addReportCardButton` = 0) session$setInputs(comment = "Comment Body") session$setInputs(`addCardOk` = 0) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R deleted file mode 100644 index 6a2e1bb5..00000000 --- a/tests/testthat/test-utils.R +++ /dev/null @@ -1,41 +0,0 @@ -testthat::test_that("extract_addcard_input throws error when input is not a reactivevalues", { - vals <- list() - testthat::expect_error(isolate(extract_addcard_input(vals))) -}) - -testthat::test_that("extract_addcard_input returns empty id if there is no match", { - vals <- shiny::reactiveValues(a = 1, b = 2) - testthat::expect_identical( - isolate(extract_addcard_input(vals)), - NULL - ) -}) - -testthat::test_that("extract_addcard_input returns right id when there is a correct match", { - vals <- shiny::reactiveValues(a = 1, b = 2, `addReportCardButton` = 0) - testthat::expect_identical( - isolate(extract_addcard_input(vals)), - 0 - ) -}) - -testthat::test_that("correct match 2", { - vals <- shiny::reactiveValues(a = 1, b = 2, `teal-addReportCard-addReportCardButton` = 0) - testthat::expect_identical( - isolate(extract_addcard_input(vals)), - 0 - ) -}) - -testthat::test_that("extract_addcard_input returns empty id if there is double match", { - vals <- shiny::reactiveValues( - a = 1, - b = 2, - `addReportCard-addReportCard` = 0, - `addReportCard2-addReportCard` = 0 - ) - testthat::expect_identical( - isolate(extract_addcard_input(vals)), - NULL - ) -}) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index 47be2e53..8b388b16 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -107,10 +107,7 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() - card_r <- eventReactive( - eventExpr = teal.reporter::extract_addcard_input(input), - valueExpr = { - card <- teal.reporter::ReportCard$new() + card_fun <- function(card = ReportCard$new()) { if (input$tabs == "Plot") { card$append_text("My plot", "header2") card$append_plot(plot()) @@ -119,10 +116,9 @@ server <- function(input, output, session) { card$append_table(table()) } card - } - ) + } - teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card = card_r) + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) ### } @@ -200,10 +196,7 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() - card_r <- eventReactive( - eventExpr = teal.reporter::extract_addcard_input(input), - valueExpr = { - card <- teal.reporter::ReportCard$new() + card_fun <- function(card = ReportCard$new()) { if (input$tabs == "Plot") { card$append_text("My plot", "header2") card$append_plot(plot()) @@ -212,10 +205,9 @@ server <- function(input, output, session) { card$append_table(table()) } card - } - ) + } - teal.reporter::simple_reporter_srv("simpleReporter", reporter = reporter, card = card_r) + teal.reporter::simple_reporter_srv("simpleReporter", reporter = reporter, card_fun = card_fun) ### } From 553bdb3239c71e12b73eeb5bd5c020e98f991463 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 17:45:20 +0200 Subject: [PATCH 31/49] Apply suggestions from code review Co-authored-by: Konrad Pagacz Co-authored-by: Mahmoud Hallal <86970066+mhallal1@users.noreply.github.com> --- R/AddCardModule.R | 2 +- R/DownloadModule.R | 2 +- R/Reporter.R | 4 ++-- vignettes/simpleReporter.Rmd | 3 +-- 4 files changed, 5 insertions(+), 6 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 3fd3e040..db7cc092 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -20,7 +20,7 @@ add_card_button_ui <- function(id) { } #' Add Card Button Server -#' @description server for adding views/cards the Report. Part of the simple Reporter. +#' @description server for adding views/cards to the Report. Part of the simple Reporter. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 378efc3a..11bf6ee5 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -25,7 +25,7 @@ download_report_button_ui <- function(id) { #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` #' @param reporter `Reporter` instance. -#' @param notification logical whether to add shiny notification about the download process, by default `TRUE`. +#' @param notification `logical` whether to add a shiny notification about the download process. Default `TRUE`. #' @param output_types `character` vector with `rmarkdown` output types, #' by default `c("pdf document", "html document", "powerpoint presentation", "word document")`. #' @return `shiny::moduleServer` diff --git a/R/Reporter.R b/R/Reporter.R index e7f865c9..ff260570 100644 --- a/R/Reporter.R +++ b/R/Reporter.R @@ -108,9 +108,9 @@ Reporter <- R6::R6Class( # nolint: object_name_linter. } blocks }, - #' @description Reset the instance, remove already added cards. + #' @description Removes all `ReportCard` objects added to this `Reporter`. #' - #' @return a `Reporter` object + #' @return invisibly self #' reset = function() { private$cards <- list() diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index 8b388b16..2e5434e7 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -31,8 +31,7 @@ The implementation should consist of 5 steps: 1. Add modules user interface to the user interface of the app. 2. Initialize Reporter instance. 3. Create the Report Card when the Add Button is clicked, a `eventReactive` part. -This part is one of the most demanding step as require from the developer to use his imagination, -how the document page should looks like. +This part requires the developer to use their imagination on how the document page should look like. The `teal.reporter::extract_addcard_input` is created to help retrieve an add button input. 4. Invoke the servers with the reporter instance and the reactive of the report card instance. From 0f95dfd7f8646ca6fc17b6f84e2043649af24d2a Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 17:54:55 +0200 Subject: [PATCH 32/49] comments --- R/AddCardModule.R | 4 ++-- R/DownloadModule.R | 4 ++-- man/Reporter.Rd | 4 ++-- man/add_card_button_srv.Rd | 2 +- man/add_card_button_ui.Rd | 2 +- man/download_report_button_srv.Rd | 4 ++-- man/download_report_button_ui.Rd | 2 +- tests/testthat/test-DownloadReportModule.R | 6 +++--- tests/testthat/test-SimpleReporter.R | 9 ++++----- tests/testthat/test-addCardModule.R | 4 ++-- vignettes/simpleReporter.Rmd | 5 ++--- 11 files changed, 22 insertions(+), 24 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index db7cc092..5bf3fc9e 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -1,5 +1,5 @@ #' Add Card Button User Interface -#' @description button for adding views/cards to the Report. Part of the simple Reporter user interface. +#' @description button for adding views/cards to the Report. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` @@ -20,7 +20,7 @@ add_card_button_ui <- function(id) { } #' Add Card Button Server -#' @description server for adding views/cards to the Report. Part of the simple Reporter. +#' @description server for adding views/cards to the Report. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 11bf6ee5..10fb83e0 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -1,5 +1,5 @@ #' Download Button Reporter User Interface -#' @description button for downloading the Report. Part of the simple Reporter user interface. +#' @description button for downloading the Report. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` @@ -20,7 +20,7 @@ download_report_button_ui <- function(id) { } #' Download Button Server -#' @description server for downloading the Report. Part of the simple Reporter. +#' @description server for downloading the Report. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` diff --git a/man/Reporter.Rd b/man/Reporter.Rd index 76d05c1b..43aecb02 100644 --- a/man/Reporter.Rd +++ b/man/Reporter.Rd @@ -266,13 +266,13 @@ reporter$get_blocks() \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-reset}{}}} \subsection{Method \code{reset()}}{ -Reset the instance, remove already added cards. +Removes all \code{ReportCard} objects added to this \code{Reporter}. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Reporter$reset()}\if{html}{\out{
}} } \subsection{Returns}{ -a \code{Reporter} object +invisibly self } } \if{html}{\out{
}} diff --git a/man/add_card_button_srv.Rd b/man/add_card_button_srv.Rd index ca456dde..7d410e5c 100644 --- a/man/add_card_button_srv.Rd +++ b/man/add_card_button_srv.Rd @@ -17,7 +17,7 @@ add_card_button_srv(id, reporter, card_fun) \code{shiny::moduleServer} } \description{ -server for adding views/cards the Report. Part of the simple Reporter. +server for adding views/cards to the Report. For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/man/add_card_button_ui.Rd b/man/add_card_button_ui.Rd index c52ace0f..dcb88bb1 100644 --- a/man/add_card_button_ui.Rd +++ b/man/add_card_button_ui.Rd @@ -13,7 +13,7 @@ add_card_button_ui(id) \code{shiny::tagList} } \description{ -button for adding views/cards to the Report. Part of the simple Reporter user interface. +button for adding views/cards to the Report. For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/man/download_report_button_srv.Rd b/man/download_report_button_srv.Rd index 2da5e3e1..2b60a706 100644 --- a/man/download_report_button_srv.Rd +++ b/man/download_report_button_srv.Rd @@ -17,7 +17,7 @@ download_report_button_srv( \item{reporter}{\code{Reporter} instance.} -\item{notification}{logical whether to add shiny notification about the download process, by default \code{TRUE}.} +\item{notification}{\code{logical} whether to add a shiny notification about the download process. Default \code{TRUE}.} \item{output_types}{\code{character} vector with \code{rmarkdown} output types, by default \code{c("pdf document", "html document", "powerpoint presentation", "word document")}.} @@ -26,7 +26,7 @@ by default \code{c("pdf document", "html document", "powerpoint presentation", " \code{shiny::moduleServer} } \description{ -server for downloading the Report. Part of the simple Reporter. +server for downloading the Report. For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/man/download_report_button_ui.Rd b/man/download_report_button_ui.Rd index 9db63046..e7419e2a 100644 --- a/man/download_report_button_ui.Rd +++ b/man/download_report_button_ui.Rd @@ -13,7 +13,7 @@ download_report_button_ui(id) \code{shiny::tagList} } \description{ -button for downloading the Report. Part of the simple Reporter user interface. +button for downloading the Report. For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index 050b2834..01fe1f27 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -9,7 +9,7 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("download_report_button_srv", { +testthat::test_that("download_report_button_srv - render and downlaod a document", { shiny::testServer( download_report_button_srv, args = list(reporter = reporter), @@ -44,7 +44,7 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("download_report_button_srv", { +testthat::test_that("download_report_button_srv - reset a report", { shiny::testServer( download_report_button_srv, args = list(reporter = reporter), @@ -57,7 +57,7 @@ testthat::test_that("download_report_button_srv", { ) }) -testthat::test_that("download_report_button_ui", { +testthat::test_that("download_report_button_ui - returns a tagList", { testthat::expect_true( inherits(download_report_button_ui("sth"), c("shiny.tag.list", "list")) ) diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R index bada87cd..315c7f9c 100644 --- a/tests/testthat/test-SimpleReporter.R +++ b/tests/testthat/test-SimpleReporter.R @@ -9,7 +9,7 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("simple_reporter_srv", { +testthat::test_that("simple_reporter_srv - render and downlaod a document", { shiny::testServer( simple_reporter_srv, args = list(reporter = reporter, card_fun = NULL), @@ -44,7 +44,7 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("simple_reporter_srv", { +testthat::test_that("simple_reporter_srv - reset a reporter", { shiny::testServer( simple_reporter_srv, args = list(reporter = reporter), @@ -68,10 +68,9 @@ card_fun <- function(card = ReportCard$new()) { card } - reporter <- Reporter$new() -testthat::test_that("simple_reporter_srv", { +testthat::test_that("simple_reporter_srv - add a Card to Reporter", { shiny::testServer( simple_reporter_srv, args = list(reporter = reporter, card_fun = card_fun), @@ -99,7 +98,7 @@ testthat::test_that("simple_reporter_srv", { ) }) -testthat::test_that("simple_reporter_ui", { +testthat::test_that("simple_reporter_ui - returns a tagList", { testthat::expect_true( inherits(simple_reporter_ui("sth"), c("shiny.tag.list", "list")) ) diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R index 40d2e99c..e24c618d 100644 --- a/tests/testthat/test-addCardModule.R +++ b/tests/testthat/test-addCardModule.R @@ -11,7 +11,7 @@ card_fun <- function(card = ReportCard$new()) { reporter <- Reporter$new() -testthat::test_that("add_card_button_srv", { +testthat::test_that("add_card_button_srv - add a Card to the Reporter", { shiny::testServer( add_card_button_srv, args = list(reporter = reporter, card_fun = card_fun), @@ -39,7 +39,7 @@ testthat::test_that("add_card_button_srv", { ) }) -testthat::test_that("add_card_button_ui", { +testthat::test_that("add_card_button_ui - returns a tagList", { testthat::expect_true( inherits(add_card_button_ui("sth"), c("shiny.tag.list", "list")) ) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index 2e5434e7..bc9e8520 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -30,10 +30,9 @@ The implementation should consist of 5 steps: 1. Add modules user interface to the user interface of the app. 2. Initialize Reporter instance. -3. Create the Report Card when the Add Button is clicked, a `eventReactive` part. +3. Create the Report Card function. This part requires the developer to use their imagination on how the document page should look like. -The `teal.reporter::extract_addcard_input` is created to help retrieve an add button input. -4. Invoke the servers with the reporter instance and the reactive of the report card instance. +4. Invoke the servers with the reporter instance and the function to create the report card instance. Simple Reporter shiny app with separate modules for each button: From 6ebb60361d759a095dc3a48d9a4f4a57a99ef1dd Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 18:15:53 +0200 Subject: [PATCH 33/49] style --- R/DownloadModule.R | 44 +++++++++++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 17 deletions(-) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 10fb83e0..52feb2e9 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -132,29 +132,39 @@ download_report_button_srv <- function(id, paste("report_", format(Sys.time(), "%y%m%d%H%M%S"), ".zip", sep = "") }, content = function(file) { - renderer <- Renderer$new() - yaml <- list( - author = yaml_quoted(input$docAuthor), - title = yaml_quoted(input$docTitle), - date = yaml_quoted(as.character(Sys.Date())) - ) - - yaml[["output"]] <- gsub(" ", "_", input$docType) - - yaml_header <- md_header(yaml::as.yaml(yaml)) - if (notification) { - shiny::showNotification(sprintf("Rendering and Downloading\n%s.", input$docType)) + shiny::showNotification(sprintf("Rendering and Downloading a document.")) } - renderer$render(reporter$get_blocks(), yaml_header) - temp_zip_file <- tempfile(fileext = ".zip") - zip::zipr(temp_zip_file, renderer$get_output_dir()) - file.copy(temp_zip_file, file) - rm(renderer) + render_and_download(reporter, input, file) }, contentType = "application/zip" ) } ) } + +#' Render and Download the Document +#' @param reporter `Reporter` instance. +#' @param input shiny input. +# @param `character` argument of the content function inside `downloadHandler`. +#' @keywords internal +render_and_download <- function(reporter, input, file) { + yaml <- list( + author = yaml_quoted(input$docAuthor), + title = yaml_quoted(input$docTitle), + date = yaml_quoted(as.character(Sys.Date())) + ) + + yaml[["output"]] <- gsub(" ", "_", input$docType) + + yaml_header <- md_header(yaml::as.yaml(yaml)) + + renderer <- Renderer$new() + + renderer$render(reporter$get_blocks(), yaml_header) + temp_zip_file <- tempfile(fileext = ".zip") + zip::zipr(temp_zip_file, renderer$get_output_dir()) + file.copy(temp_zip_file, file) + rm(renderer) +} From 7d965175fa4be16c42e05edb7a9f9cf2a5065f5a Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 18:18:26 +0200 Subject: [PATCH 34/49] docs --- man/render_and_download.Rd | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 man/render_and_download.Rd diff --git a/man/render_and_download.Rd b/man/render_and_download.Rd new file mode 100644 index 00000000..113df810 --- /dev/null +++ b/man/render_and_download.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DownloadModule.R +\name{render_and_download} +\alias{render_and_download} +\title{Render and Download the Document} +\usage{ +render_and_download(reporter, input, file) +} +\arguments{ +\item{reporter}{\code{Reporter} instance.} + +\item{input}{shiny input.} +} +\description{ +Render and Download the Document +} +\keyword{internal} From 2951746251a450018bb7a8d777e7c008d1a4b5f9 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 18:23:02 +0200 Subject: [PATCH 35/49] docs --- R/DownloadModule.R | 5 +++++ man/render_and_download.Rd | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 52feb2e9..44286a24 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -145,11 +145,16 @@ download_report_button_srv <- function(id, } #' Render and Download the Document +#' @description render and download the document #' @param reporter `Reporter` instance. #' @param input shiny input. # @param `character` argument of the content function inside `downloadHandler`. #' @keywords internal render_and_download <- function(reporter, input, file) { + checkmate::assert_class(reporter, "Reporter") + checkmate::assert_class(input, "reactivevalues") + checkmate::assert_class(file, "character") + yaml <- list( author = yaml_quoted(input$docAuthor), title = yaml_quoted(input$docTitle), diff --git a/man/render_and_download.Rd b/man/render_and_download.Rd index 113df810..5b7a936a 100644 --- a/man/render_and_download.Rd +++ b/man/render_and_download.Rd @@ -12,6 +12,6 @@ render_and_download(reporter, input, file) \item{input}{shiny input.} } \description{ -Render and Download the Document +render and download the document } \keyword{internal} From bfbae659c3da258459f8d43270b3e23ac46df770 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 18:29:42 +0200 Subject: [PATCH 36/49] docs --- vignettes/simpleReporter.Rmd | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index bc9e8520..dad5d65e 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -106,14 +106,14 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() card_fun <- function(card = ReportCard$new()) { - if (input$tabs == "Plot") { - card$append_text("My plot", "header2") - card$append_plot(plot()) - } else if (input$tabs == "Table") { - card$append_text("My Table", "header2") - card$append_table(table()) - } - card + if (input$tabs == "Plot") { + card$append_text("My plot", "header2") + card$append_plot(plot()) + } else if (input$tabs == "Table") { + card$append_text("My Table", "header2") + card$append_table(table()) + } + card } teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) @@ -195,14 +195,14 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() card_fun <- function(card = ReportCard$new()) { - if (input$tabs == "Plot") { - card$append_text("My plot", "header2") - card$append_plot(plot()) - } else if (input$tabs == "Table") { - card$append_text("My Table", "header2") - card$append_table(table()) - } - card + if (input$tabs == "Plot") { + card$append_text("My plot", "header2") + card$append_plot(plot()) + } else if (input$tabs == "Table") { + card$append_text("My Table", "header2") + card$append_table(table()) + } + card } teal.reporter::simple_reporter_srv("simpleReporter", reporter = reporter, card_fun = card_fun) From 1e23c5da6a31b191ced159c6a09c64e490331db5 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 19:01:45 +0200 Subject: [PATCH 37/49] download fun --- R/DownloadModule.R | 22 ++++++++-------- man/download_report_button_srv.Rd | 6 ++--- tests/testthat/test-DownloadReportModule.R | 30 +++++++++++++++++++--- tests/testthat/test-SimpleReporter.R | 6 ++--- 4 files changed, 45 insertions(+), 19 deletions(-) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 44286a24..3ad5a5bb 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -27,15 +27,15 @@ download_report_button_ui <- function(id) { #' @param reporter `Reporter` instance. #' @param notification `logical` whether to add a shiny notification about the download process. Default `TRUE`. #' @param output_types `character` vector with `rmarkdown` output types, -#' by default `c("pdf document", "html document", "powerpoint presentation", "word document")`. +#' by default `c("pdf_document", "html_document", "powerpoint_presentation", "word_document")`. #' @return `shiny::moduleServer` #' @export download_report_button_srv <- function(id, reporter, notification = TRUE, output_types = c( - "pdf document", "html document", - "powerpoint presentation", "word document" + "pdf_document", "html_document", + "powerpoint_presentation", "word_document" )) { shiny::moduleServer( id, @@ -69,11 +69,11 @@ download_report_button_srv <- function(id, ), ) }, - shiny::textInput(ns("docAuthor"), label = "Author:", value = "NEST"), - shiny::textInput(ns("docTitle"), label = "Title:", value = "NEST Report"), + shiny::textInput(ns("author"), label = "Author:", value = "NEST"), + shiny::textInput(ns("title"), label = "Title:", value = "NEST Report"), shiny::tags$div( shinyWidgets::pickerInput( - inputId = ns("docType"), + inputId = ns("output"), label = "Choose a document type: ", choices = output_types ) @@ -156,12 +156,14 @@ render_and_download <- function(reporter, input, file) { checkmate::assert_class(file, "character") yaml <- list( - author = yaml_quoted(input$docAuthor), - title = yaml_quoted(input$docTitle), - date = yaml_quoted(as.character(Sys.Date())) + author = input$author, + title = input$title, + date = as.character(Sys.Date()) ) - yaml[["output"]] <- gsub(" ", "_", input$docType) + if (!is.null(input$output)) { + yaml[["output"]] <- input$output + } yaml_header <- md_header(yaml::as.yaml(yaml)) diff --git a/man/download_report_button_srv.Rd b/man/download_report_button_srv.Rd index 2b60a706..96bb31f1 100644 --- a/man/download_report_button_srv.Rd +++ b/man/download_report_button_srv.Rd @@ -8,8 +8,8 @@ download_report_button_srv( id, reporter, notification = TRUE, - output_types = c("pdf document", "html document", "powerpoint presentation", - "word document") + output_types = c("pdf_document", "html_document", "powerpoint_presentation", + "word_document") ) } \arguments{ @@ -20,7 +20,7 @@ download_report_button_srv( \item{notification}{\code{logical} whether to add a shiny notification about the download process. Default \code{TRUE}.} \item{output_types}{\code{character} vector with \code{rmarkdown} output types, -by default \code{c("pdf document", "html document", "powerpoint presentation", "word document")}.} +by default \code{c("pdf_document", "html_document", "powerpoint_presentation", "word_document")}.} } \value{ \code{shiny::moduleServer} diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index 01fe1f27..b6c4283c 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -15,9 +15,9 @@ testthat::test_that("download_report_button_srv - render and downlaod a document args = list(reporter = reporter), expr = { session$setInputs(`download_button` = 0) - session$setInputs(`docType` = "html_document") - session$setInputs(`docTitle` = "TITLE") - session$setInputs(`docAuthor` = "AUTHOR") + session$setInputs(`output` = "html_document") + session$setInputs(`title` = "TITLE") + session$setInputs(`author` = "AUTHOR") session$setInputs(`download_data` = 0) f <- output$download_data @@ -62,3 +62,27 @@ testthat::test_that("download_report_button_ui - returns a tagList", { inherits(download_report_button_ui("sth"), c("shiny.tag.list", "list")) ) }) + +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() +) + +reporter <- Reporter$new() +reporter$append_cards(list(card1)) + +testthat::test_that("render_and_download - ", { + input <- shiny::reactiveValues(author = "NEST", title = "Report", output = "html_document") + temp_zip <- tempfile(fileext = "zip") + shiny::isolate(render_and_download(reporter, input, temp_zip)) + tmp_dir <- tempdir() + output_dir <- file.path(tmp_dir, sprintf("report_test_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) + dir.create(path = output_dir) + zip::unzip(temp_zip, exdir = output_dir) + files <- list.files(output_dir, recursive = TRUE) + testthat::expect_true(any(grepl("[.]Rmd", files))) + testthat::expect_true(any(grepl("[.]html", files))) +}) diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R index 315c7f9c..4a92114e 100644 --- a/tests/testthat/test-SimpleReporter.R +++ b/tests/testthat/test-SimpleReporter.R @@ -15,9 +15,9 @@ testthat::test_that("simple_reporter_srv - render and downlaod a document", { args = list(reporter = reporter, card_fun = NULL), expr = { session$setInputs(`download_button` = 0) - session$setInputs(`downloadButton-docType` = "html_document") - session$setInputs(`downloadButton-docTitle` = "TITLE") - session$setInputs(`downloadButton-docAuthor` = "AUTHOR") + session$setInputs(`downloadButton-output` = "html_document") + session$setInputs(`downloadButton-title` = "TITLE") + session$setInputs(`downloadButton-author` = "AUTHOR") session$setInputs(`downloadButton-download_data` = 0) f <- output$`downloadButton-download_data` From 8746c1af23993e73a643a8b671524344cd2e3386 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 19:13:22 +0200 Subject: [PATCH 38/49] docs --- R/DownloadModule.R | 2 ++ tests/testthat/test-DownloadReportModule.R | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 3ad5a5bb..68f28ac9 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -170,8 +170,10 @@ render_and_download <- function(reporter, input, file) { renderer <- Renderer$new() renderer$render(reporter$get_blocks(), yaml_header) + temp_zip_file <- tempfile(fileext = ".zip") zip::zipr(temp_zip_file, renderer$get_output_dir()) file.copy(temp_zip_file, file) + rm(renderer) } diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index b6c4283c..bb72ed8d 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -74,9 +74,9 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -testthat::test_that("render_and_download - ", { +testthat::test_that("render_and_download - render and downlaod a html document", { input <- shiny::reactiveValues(author = "NEST", title = "Report", output = "html_document") - temp_zip <- tempfile(fileext = "zip") + temp_zip <- tempfile(fileext = ".zip") shiny::isolate(render_and_download(reporter, input, temp_zip)) tmp_dir <- tempdir() output_dir <- file.path(tmp_dir, sprintf("report_test_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) From 994a86f51b5a1f304f4313937ea0096f767a5ed8 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 21:09:42 +0200 Subject: [PATCH 39/49] tests --- R/DownloadModule.R | 19 ++++++++-------- man/render_and_download.Rd | 17 --------------- man/render_report.Rd | 22 +++++++++++++++++++ tests/testthat/test-DownloadReportModule.R | 25 +++++++++++++++------- 4 files changed, 48 insertions(+), 35 deletions(-) delete mode 100644 man/render_and_download.Rd create mode 100644 man/render_report.Rd diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 68f28ac9..01aa1ddb 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -136,7 +136,7 @@ download_report_button_srv <- function(id, shiny::showNotification(sprintf("Rendering and Downloading a document.")) } - render_and_download(reporter, input, file) + render_report(reporter, input, file) }, contentType = "application/zip" ) @@ -144,31 +144,29 @@ download_report_button_srv <- function(id, ) } -#' Render and Download the Document -#' @description render and download the document +#' Render the Report +#' @description render the report and zip the created directory. #' @param reporter `Reporter` instance. -#' @param input shiny input. -# @param `character` argument of the content function inside `downloadHandler`. +#' @param input `reactivevalues` shiny input. +#' @param file `character` where to copy the returned directory. +#' @return `file` argument #' @keywords internal -render_and_download <- function(reporter, input, file) { +render_report <- function(reporter, input, file = tempdir()) { checkmate::assert_class(reporter, "Reporter") checkmate::assert_class(input, "reactivevalues") - checkmate::assert_class(file, "character") + checkmate::assert_string(file) yaml <- list( author = input$author, title = input$title, date = as.character(Sys.Date()) ) - if (!is.null(input$output)) { yaml[["output"]] <- input$output } - yaml_header <- md_header(yaml::as.yaml(yaml)) renderer <- Renderer$new() - renderer$render(reporter$get_blocks(), yaml_header) temp_zip_file <- tempfile(fileext = ".zip") @@ -176,4 +174,5 @@ render_and_download <- function(reporter, input, file) { file.copy(temp_zip_file, file) rm(renderer) + file } diff --git a/man/render_and_download.Rd b/man/render_and_download.Rd deleted file mode 100644 index 5b7a936a..00000000 --- a/man/render_and_download.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/DownloadModule.R -\name{render_and_download} -\alias{render_and_download} -\title{Render and Download the Document} -\usage{ -render_and_download(reporter, input, file) -} -\arguments{ -\item{reporter}{\code{Reporter} instance.} - -\item{input}{shiny input.} -} -\description{ -render and download the document -} -\keyword{internal} diff --git a/man/render_report.Rd b/man/render_report.Rd new file mode 100644 index 00000000..e793351a --- /dev/null +++ b/man/render_report.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DownloadModule.R +\name{render_report} +\alias{render_report} +\title{Render the Report} +\usage{ +render_report(reporter, input, file = tempdir()) +} +\arguments{ +\item{reporter}{\code{Reporter} instance.} + +\item{input}{\code{reactivevalues} shiny input.} + +\item{file}{\code{character} where to copy the returned directory.} +} +\value{ +\code{file} argument +} +\description{ +render the report and zip the created directory. +} +\keyword{internal} diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index bb72ed8d..674b33b1 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -73,16 +73,25 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) +input <- shiny::reactiveValues(author = "NEST", title = "Report", output = "html_document") +temp_dir <- tempdir() -testthat::test_that("render_and_download - render and downlaod a html document", { +testthat::test_that("render_and_download - valid arguments", { + testthat::expect_error(shiny::isolate(render_report(reporter, input, temp_dir)), NA) +}) + +testthat::test_that("render_and_download - invalid arguments", { + testthat::expect_error(render_report(reporter, list(), temp_zip)) + testthat::expect_error(render_report(reporter, input, 2)) + testthat::expect_error(render_report(reporter, list, "")) +}) + +testthat::test_that("render_report - render an html document", { input <- shiny::reactiveValues(author = "NEST", title = "Report", output = "html_document") - temp_zip <- tempfile(fileext = ".zip") - shiny::isolate(render_and_download(reporter, input, temp_zip)) - tmp_dir <- tempdir() - output_dir <- file.path(tmp_dir, sprintf("report_test_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) - dir.create(path = output_dir) - zip::unzip(temp_zip, exdir = output_dir) - files <- list.files(output_dir, recursive = TRUE) + temp_dir <- tempdir() + res_path <- shiny::isolate(render_report(reporter, input, temp_dir)) + expect_identical(res_path, temp_dir) + files <- list.files(temp_dir, recursive = TRUE) testthat::expect_true(any(grepl("[.]Rmd", files))) testthat::expect_true(any(grepl("[.]html", files))) }) From a05ccef9d46737a16775cf1d1aef737b01157e16 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Thu, 28 Apr 2022 21:40:55 +0200 Subject: [PATCH 40/49] call back magic, comment --- R/AddCardModule.R | 4 +--- tests/testthat/test-SimpleReporter.R | 14 ++------------ tests/testthat/test-addCardModule.R | 15 +++------------ vignettes/simpleReporter.Rmd | 14 +++++++++++--- 4 files changed, 17 insertions(+), 30 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 5bf3fc9e..ca1425ae 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -77,10 +77,8 @@ add_card_button_srv <- function(id, reporter, card_fun) { shiny::observeEvent(input$addCardOk, { card <- ReportCard$new() - card_fun(card) + card_fun(card, input$comment) checkmate::assert_class(card, "ReportCard") - card$append_text("Comment", "header3") - card$append_text(input$comment) reporter$append_cards(list(card)) shiny::removeModal() }) diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R index 4a92114e..ecf47bd6 100644 --- a/tests/testthat/test-SimpleReporter.R +++ b/tests/testthat/test-SimpleReporter.R @@ -58,7 +58,7 @@ testthat::test_that("simple_reporter_srv - reset a reporter", { }) -card_fun <- function(card = ReportCard$new()) { +card_fun <- function(card = ReportCard$new(), comment = NULL) { card$append_text("Header 2 text", "header2") card$append_text("A paragraph of default text", "header2") card$append_plot( @@ -82,17 +82,7 @@ testthat::test_that("simple_reporter_srv - add a Card to Reporter", { testthat::expect_identical( length(reporter$get_blocks()), - card_len + 2L - ) - - testthat::expect_identical( - tail(reporter$get_blocks(), 1)[[1]]$get_content(), - "Comment Body" - ) - - testthat::expect_identical( - tail(reporter$get_blocks(), 2)[[1]]$get_content(), - "Comment" + card_len ) } ) diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R index e24c618d..93d0cbc5 100644 --- a/tests/testthat/test-addCardModule.R +++ b/tests/testthat/test-addCardModule.R @@ -1,4 +1,5 @@ -card_fun <- function(card = ReportCard$new()) { +card_fun <- function(card = ReportCard$new(), + comment = NULL) { card$append_text("Header 2 text", "header2") card$append_text("A paragraph of default text", "header2") card$append_plot( @@ -23,17 +24,7 @@ testthat::test_that("add_card_button_srv - add a Card to the Reporter", { testthat::expect_identical( length(reporter$get_blocks()), - card_len + 2L - ) - - testthat::expect_identical( - tail(reporter$get_blocks(), 1)[[1]]$get_content(), - "Comment Body" - ) - - testthat::expect_identical( - tail(reporter$get_blocks(), 2)[[1]]$get_content(), - "Comment" + card_len ) } ) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index dad5d65e..c8d06142 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -30,7 +30,9 @@ The implementation should consist of 5 steps: 1. Add modules user interface to the user interface of the app. 2. Initialize Reporter instance. -3. Create the Report Card function. +3. Create the Report Card function with two arguments: card and comment. +The function should build the Card step by step and assuming it is empty ad the start, +the comment argument is a string provided by the user when the card is added. This part requires the developer to use their imagination on how the document page should look like. 4. Invoke the servers with the reporter instance and the function to create the report card instance. @@ -105,7 +107,8 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() - card_fun <- function(card = ReportCard$new()) { + card_fun <- function(card = ReportCard$new(), + comment) { if (input$tabs == "Plot") { card$append_text("My plot", "header2") card$append_plot(plot()) @@ -113,6 +116,8 @@ server <- function(input, output, session) { card$append_text("My Table", "header2") card$append_table(table()) } + card$append_text("Comment", "header3") + card$append_text(comment) card } @@ -194,7 +199,8 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() - card_fun <- function(card = ReportCard$new()) { + card_fun <- function(card = ReportCard$new(), + comment) { if (input$tabs == "Plot") { card$append_text("My plot", "header2") card$append_plot(plot()) @@ -202,6 +208,8 @@ server <- function(input, output, session) { card$append_text("My Table", "header2") card$append_table(table()) } + card$append_text("Comment", "header3") + card$append_text(comment) card } From eabeb336fc420f514e4cc79ea600563ae031e646 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 29 Apr 2022 06:37:16 +0200 Subject: [PATCH 41/49] no pdf render --- R/AddCardModule.R | 3 ++- R/Renderer.R | 4 ++-- R/SimpleReporter.R | 3 ++- man/Renderer.Rd | 8 ++++---- man/add_card_button_srv.Rd | 3 ++- man/simple_reporter_srv.Rd | 3 ++- 6 files changed, 14 insertions(+), 10 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index ca1425ae..bcd576f5 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -25,7 +25,8 @@ add_card_button_ui <- function(id) { #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` #' @param reporter `Reporter` instance. -#' @param card_fun `function` which returns a `ReportCard` instance. +#' @param card_fun `function` which returns a `ReportCard` instance, +#' the function have at least two arguments `card` and `comment`. #' @return `shiny::moduleServer` #' @export #' @export diff --git a/R/Renderer.R b/R/Renderer.R index 0631307a..5b1ee727 100644 --- a/R/Renderer.R +++ b/R/Renderer.R @@ -51,7 +51,7 @@ Renderer <- R6::R6Class( # nolint: object_name_linter. #' author = teal.reporter:::yaml_quoted("NEST"), #' title = teal.reporter:::yaml_quoted("Report"), #' date = teal.reporter:::yaml_quoted("07/04/2019"), - #' output = list(pdf_document = list(keep_tex = TRUE)) + #' output = list(html_document = list(toc = FALSE)) #' ) #' #' yaml_header <- teal.reporter:::md_header(yaml::as.yaml(yaml_l)) @@ -103,7 +103,7 @@ Renderer <- R6::R6Class( # nolint: object_name_linter. #' author = teal.reporter:::yaml_quoted("NEST"), #' title = teal.reporter:::yaml_quoted("Report"), #' date = teal.reporter:::yaml_quoted("07/04/2019"), - #' output = list(pdf_document = list(keep_tex = TRUE)) + #' output = list(html_document = list(toc = FALSE)) #' ) #' #' yaml_header <- teal.reporter:::md_header(yaml::as.yaml(yaml_l)) diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index 9d057a0a..025d15a3 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -20,7 +20,8 @@ simple_reporter_ui <- function(id) { #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` #' @param reporter `Reporter` instance. -#' @param card_fun `function` which returns a `ReportCard` instance. +#' @param card_fun `function` which returns a `ReportCard` instance, +#' the function have at least two arguments `card` and `comment`. #' @param notification logical if to add shiny notification about the download process. #' @return `shiny::moduleServer` #' @export diff --git a/man/Renderer.Rd b/man/Renderer.Rd index 57d8fc35..8cc8eca4 100644 --- a/man/Renderer.Rd +++ b/man/Renderer.Rd @@ -44,7 +44,7 @@ yaml_l <- list( author = teal.reporter:::yaml_quoted("NEST"), title = teal.reporter:::yaml_quoted("Report"), date = teal.reporter:::yaml_quoted("07/04/2019"), - output = list(pdf_document = list(keep_tex = TRUE)) + output = list(html_document = list(toc = FALSE)) ) yaml_header <- teal.reporter:::md_header(yaml::as.yaml(yaml_l)) @@ -76,7 +76,7 @@ yaml_l <- list( author = teal.reporter:::yaml_quoted("NEST"), title = teal.reporter:::yaml_quoted("Report"), date = teal.reporter:::yaml_quoted("07/04/2019"), - output = list(pdf_document = list(keep_tex = TRUE)) + output = list(html_document = list(toc = FALSE)) ) yaml_header <- teal.reporter:::md_header(yaml::as.yaml(yaml_l)) @@ -183,7 +183,7 @@ yaml_l <- list( author = teal.reporter:::yaml_quoted("NEST"), title = teal.reporter:::yaml_quoted("Report"), date = teal.reporter:::yaml_quoted("07/04/2019"), - output = list(pdf_document = list(keep_tex = TRUE)) + output = list(html_document = list(toc = FALSE)) ) yaml_header <- teal.reporter:::md_header(yaml::as.yaml(yaml_l)) @@ -241,7 +241,7 @@ yaml_l <- list( author = teal.reporter:::yaml_quoted("NEST"), title = teal.reporter:::yaml_quoted("Report"), date = teal.reporter:::yaml_quoted("07/04/2019"), - output = list(pdf_document = list(keep_tex = TRUE)) + output = list(html_document = list(toc = FALSE)) ) yaml_header <- teal.reporter:::md_header(yaml::as.yaml(yaml_l)) diff --git a/man/add_card_button_srv.Rd b/man/add_card_button_srv.Rd index 7d410e5c..acd2476d 100644 --- a/man/add_card_button_srv.Rd +++ b/man/add_card_button_srv.Rd @@ -11,7 +11,8 @@ add_card_button_srv(id, reporter, card_fun) \item{reporter}{\code{Reporter} instance.} -\item{card_fun}{\code{function} which returns a \code{ReportCard} instance.} +\item{card_fun}{\code{function} which returns a \code{ReportCard} instance, +the function have at least two arguments \code{card} and \code{comment}.} } \value{ \code{shiny::moduleServer} diff --git a/man/simple_reporter_srv.Rd b/man/simple_reporter_srv.Rd index 774eada0..2b327e28 100644 --- a/man/simple_reporter_srv.Rd +++ b/man/simple_reporter_srv.Rd @@ -11,7 +11,8 @@ simple_reporter_srv(id, reporter, card_fun, notification = TRUE) \item{reporter}{\code{Reporter} instance.} -\item{card_fun}{\code{function} which returns a \code{ReportCard} instance.} +\item{card_fun}{\code{function} which returns a \code{ReportCard} instance, +the function have at least two arguments \code{card} and \code{comment}.} \item{notification}{logical if to add shiny notification about the download process.} } From 34200dc46bb4838b822a6aa85a3c6cf3739e1190 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 29 Apr 2022 06:43:10 +0200 Subject: [PATCH 42/49] lintr --- vignettes/simpleReporter.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index c8d06142..cd35ab4a 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -107,7 +107,7 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() - card_fun <- function(card = ReportCard$new(), + card_fun <- function(card = ReportCard$new(), comment) { if (input$tabs == "Plot") { card$append_text("My plot", "header2") From f485b3e6bebcc7ccf4ca784c7cd39769221ff73a Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 29 Apr 2022 07:30:20 +0200 Subject: [PATCH 43/49] even better --- R/DownloadModule.R | 34 ++++++++++++------- man/download_report_button_srv.Rd | 12 +++++-- ...eport.Rd => report_render_and_compress.Rd} | 8 ++--- tests/testthat/test-DownloadReportModule.R | 20 +++++------ 4 files changed, 45 insertions(+), 29 deletions(-) rename man/{render_report.Rd => report_render_and_compress.Rd} (64%) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index 01aa1ddb..a63260ca 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -26,16 +26,23 @@ download_report_button_ui <- function(id) { #' @param id `character` #' @param reporter `Reporter` instance. #' @param notification `logical` whether to add a shiny notification about the download process. Default `TRUE`. -#' @param output_types `character` vector with `rmarkdown` output types, +#' @param rmd_output `character` vector with `rmarkdown` output types, #' by default `c("pdf_document", "html_document", "powerpoint_presentation", "word_document")`. +#' @param rmd_yaml_args `named list` vector with `Rmd` `yaml` header fields and their default values. +#' Default `list(author = "NEST", title = "Report", date = Sys.Date(), output = "html_document")`. +#' Please update only values at this moment. #' @return `shiny::moduleServer` #' @export download_report_button_srv <- function(id, reporter, notification = TRUE, - output_types = c( - "pdf_document", "html_document", + rmd_output = c( + "html_document", "pdf_document", "powerpoint_presentation", "word_document" + ), + rmd_yaml_args = list( + author = "NEST", title = "Report", + date = as.character(Sys.Date()), output = "html_document" )) { shiny::moduleServer( id, @@ -69,13 +76,15 @@ download_report_button_srv <- function(id, ), ) }, - shiny::textInput(ns("author"), label = "Author:", value = "NEST"), - shiny::textInput(ns("title"), label = "Title:", value = "NEST Report"), + shiny::textInput(ns("author"), label = "Author:", value = rmd_yaml_args$author), + shiny::textInput(ns("title"), label = "Title:", value = rmd_yaml_args$title), + shiny::dateInput(ns("date"), "Date:", value = rmd_yaml_args$date), shiny::tags$div( shinyWidgets::pickerInput( inputId = ns("output"), label = "Choose a document type: ", - choices = output_types + choices = rmd_output, + selected = rmd_yaml_args$output ) ), if (failed) { @@ -135,8 +144,9 @@ download_report_button_srv <- function(id, if (notification) { shiny::showNotification(sprintf("Rendering and Downloading a document.")) } - - render_report(reporter, input, file) + input_list <- lapply(names(rmd_yaml_args), function(x) input[[x]]) + names(input_list) <- names(rmd_yaml_args) + report_render_and_compress(reporter, input_list, file) }, contentType = "application/zip" ) @@ -147,19 +157,19 @@ download_report_button_srv <- function(id, #' Render the Report #' @description render the report and zip the created directory. #' @param reporter `Reporter` instance. -#' @param input `reactivevalues` shiny input. +#' @param input `list` like shiny input converted to a regular list. #' @param file `character` where to copy the returned directory. #' @return `file` argument #' @keywords internal -render_report <- function(reporter, input, file = tempdir()) { +report_render_and_compress <- function(reporter, input, file = tempdir()) { checkmate::assert_class(reporter, "Reporter") - checkmate::assert_class(input, "reactivevalues") + checkmate::assert_list(input, names = "named") checkmate::assert_string(file) yaml <- list( author = input$author, title = input$title, - date = as.character(Sys.Date()) + date = as.character(input$date) ) if (!is.null(input$output)) { yaml[["output"]] <- input$output diff --git a/man/download_report_button_srv.Rd b/man/download_report_button_srv.Rd index 96bb31f1..c7430cd6 100644 --- a/man/download_report_button_srv.Rd +++ b/man/download_report_button_srv.Rd @@ -8,8 +8,10 @@ download_report_button_srv( id, reporter, notification = TRUE, - output_types = c("pdf_document", "html_document", "powerpoint_presentation", - "word_document") + rmd_output = c("html_document", "pdf_document", "powerpoint_presentation", + "word_document"), + rmd_yaml_args = list(author = "NEST", title = "Report", date = + as.character(Sys.Date()), output = "html_document") ) } \arguments{ @@ -19,8 +21,12 @@ download_report_button_srv( \item{notification}{\code{logical} whether to add a shiny notification about the download process. Default \code{TRUE}.} -\item{output_types}{\code{character} vector with \code{rmarkdown} output types, +\item{rmd_output}{\code{character} vector with \code{rmarkdown} output types, by default \code{c("pdf_document", "html_document", "powerpoint_presentation", "word_document")}.} + +\item{rmd_yaml_args}{\verb{named list} vector with \code{Rmd} \code{yaml} header fields and their default values. +Default \code{list(author = "NEST", title = "Report", date = Sys.Date(), output = "html_document")}. +Please update only values at this moment.} } \value{ \code{shiny::moduleServer} diff --git a/man/render_report.Rd b/man/report_render_and_compress.Rd similarity index 64% rename from man/render_report.Rd rename to man/report_render_and_compress.Rd index e793351a..574e74b4 100644 --- a/man/render_report.Rd +++ b/man/report_render_and_compress.Rd @@ -1,15 +1,15 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/DownloadModule.R -\name{render_report} -\alias{render_report} +\name{report_render_and_compress} +\alias{report_render_and_compress} \title{Render the Report} \usage{ -render_report(reporter, input, file = tempdir()) +report_render_and_compress(reporter, input, file = tempdir()) } \arguments{ \item{reporter}{\code{Reporter} instance.} -\item{input}{\code{reactivevalues} shiny input.} +\item{input}{\code{list} like shiny input converted to a regular list.} \item{file}{\code{character} where to copy the returned directory.} } diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index 674b33b1..932419a4 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -73,23 +73,23 @@ card1$append_plot( reporter <- Reporter$new() reporter$append_cards(list(card1)) -input <- shiny::reactiveValues(author = "NEST", title = "Report", output = "html_document") +input <- list(author = "NEST", title = "Report", output = "html_document") temp_dir <- tempdir() -testthat::test_that("render_and_download - valid arguments", { - testthat::expect_error(shiny::isolate(render_report(reporter, input, temp_dir)), NA) +testthat::test_that("report_render_and_compress - valid arguments", { + testthat::expect_error(report_render_and_compress(reporter, input, temp_dir), NA) }) -testthat::test_that("render_and_download - invalid arguments", { - testthat::expect_error(render_report(reporter, list(), temp_zip)) - testthat::expect_error(render_report(reporter, input, 2)) - testthat::expect_error(render_report(reporter, list, "")) +testthat::test_that("report_render_and_compress - invalid arguments", { + testthat::expect_error(report_render_and_compress(reporter, list(), temp_zip)) + testthat::expect_error(report_render_and_compress(reporter, input, 2)) + testthat::expect_error(report_render_and_compress(reporter, list, "")) }) -testthat::test_that("render_report - render an html document", { - input <- shiny::reactiveValues(author = "NEST", title = "Report", output = "html_document") +testthat::test_that("report_render_and_compress - render an html document", { + input <- list(author = "NEST", title = "Report", output = "html_document") temp_dir <- tempdir() - res_path <- shiny::isolate(render_report(reporter, input, temp_dir)) + res_path <- report_render_and_compress(reporter, input, temp_dir) expect_identical(res_path, temp_dir) files <- list.files(temp_dir, recursive = TRUE) testthat::expect_true(any(grepl("[.]Rmd", files))) From be355ddae443ccc5ea2a8789865c060ad4c3ebca Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 29 Apr 2022 08:26:44 +0200 Subject: [PATCH 44/49] validate --- R/DownloadModule.R | 11 ++++++++++- man/download_report_button_srv.Rd | 2 +- tests/testthat/test-DownloadReportModule.R | 4 ++-- tests/testthat/test-SimpleReporter.R | 6 +++--- 4 files changed, 16 insertions(+), 7 deletions(-) diff --git a/R/DownloadModule.R b/R/DownloadModule.R index a63260ca..cd34772e 100644 --- a/R/DownloadModule.R +++ b/R/DownloadModule.R @@ -27,7 +27,7 @@ download_report_button_ui <- function(id) { #' @param reporter `Reporter` instance. #' @param notification `logical` whether to add a shiny notification about the download process. Default `TRUE`. #' @param rmd_output `character` vector with `rmarkdown` output types, -#' by default `c("pdf_document", "html_document", "powerpoint_presentation", "word_document")`. +#' by default all possible `c("pdf_document", "html_document", "powerpoint_presentation", "word_document")`. #' @param rmd_yaml_args `named list` vector with `Rmd` `yaml` header fields and their default values. #' Default `list(author = "NEST", title = "Report", date = Sys.Date(), output = "html_document")`. #' Please update only values at this moment. @@ -44,6 +44,15 @@ download_report_button_srv <- function(id, author = "NEST", title = "Report", date = as.character(Sys.Date()), output = "html_document" )) { + checkmate::assert_class(reporter, "Reporter") + checkmate::assert_flag(notification) + checkmate::assert_subset(rmd_output, c( + "html_document", "pdf_document", + "powerpoint_presentation", "word_document" + )) + checkmate::assert_list(rmd_yaml_args, names = "named") + checkmate::assert_true(all(c("author", "title", "date", "output") %in% names(rmd_yaml_args))) + shiny::moduleServer( id, function(input, output, session) { diff --git a/man/download_report_button_srv.Rd b/man/download_report_button_srv.Rd index c7430cd6..80c38935 100644 --- a/man/download_report_button_srv.Rd +++ b/man/download_report_button_srv.Rd @@ -22,7 +22,7 @@ download_report_button_srv( \item{notification}{\code{logical} whether to add a shiny notification about the download process. Default \code{TRUE}.} \item{rmd_output}{\code{character} vector with \code{rmarkdown} output types, -by default \code{c("pdf_document", "html_document", "powerpoint_presentation", "word_document")}.} +by default all possible \code{c("pdf_document", "html_document", "powerpoint_presentation", "word_document")}.} \item{rmd_yaml_args}{\verb{named list} vector with \code{Rmd} \code{yaml} header fields and their default values. Default \code{list(author = "NEST", title = "Report", date = Sys.Date(), output = "html_document")}. diff --git a/tests/testthat/test-DownloadReportModule.R b/tests/testthat/test-DownloadReportModule.R index 932419a4..25c7c625 100644 --- a/tests/testthat/test-DownloadReportModule.R +++ b/tests/testthat/test-DownloadReportModule.R @@ -12,7 +12,7 @@ reporter$append_cards(list(card1)) testthat::test_that("download_report_button_srv - render and downlaod a document", { shiny::testServer( download_report_button_srv, - args = list(reporter = reporter), + args = list(reporter = reporter, notification = FALSE), expr = { session$setInputs(`download_button` = 0) session$setInputs(`output` = "html_document") @@ -47,7 +47,7 @@ reporter$append_cards(list(card1)) testthat::test_that("download_report_button_srv - reset a report", { shiny::testServer( download_report_button_srv, - args = list(reporter = reporter), + args = list(reporter = reporter, notification = FALSE), expr = { testthat::expect_identical(reporter$get_cards(), list(card1)) session$setInputs(`reset_reporter` = 0) diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R index ecf47bd6..b927517a 100644 --- a/tests/testthat/test-SimpleReporter.R +++ b/tests/testthat/test-SimpleReporter.R @@ -12,7 +12,7 @@ reporter$append_cards(list(card1)) testthat::test_that("simple_reporter_srv - render and downlaod a document", { shiny::testServer( simple_reporter_srv, - args = list(reporter = reporter, card_fun = NULL), + args = list(reporter = reporter, notification = FALSE, card_fun = NULL), expr = { session$setInputs(`download_button` = 0) session$setInputs(`downloadButton-output` = "html_document") @@ -47,7 +47,7 @@ reporter$append_cards(list(card1)) testthat::test_that("simple_reporter_srv - reset a reporter", { shiny::testServer( simple_reporter_srv, - args = list(reporter = reporter), + args = list(reporter = reporter, notification = FALSE), expr = { testthat::expect_identical(reporter$get_cards(), list(card1)) session$setInputs(`downloadButton-reset_reporter` = 0) @@ -73,7 +73,7 @@ reporter <- Reporter$new() testthat::test_that("simple_reporter_srv - add a Card to Reporter", { shiny::testServer( simple_reporter_srv, - args = list(reporter = reporter, card_fun = card_fun), + args = list(reporter = reporter, notification = FALSE, card_fun = card_fun), expr = { card_len <- length(card_fun()$get_content()) session$setInputs(`addReportCard-addReportCardButton` = 0) From a165a36216147202f18dd0f5824a2f020b800ab1 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 29 Apr 2022 10:10:48 +0200 Subject: [PATCH 45/49] Apply suggestions from code review Co-authored-by: Mahmoud Hallal <86970066+mhallal1@users.noreply.github.com> --- R/AddCardModule.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index bcd576f5..7b79ad18 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -26,10 +26,9 @@ add_card_button_ui <- function(id) { #' @param id `character` #' @param reporter `Reporter` instance. #' @param card_fun `function` which returns a `ReportCard` instance, -#' the function have at least two arguments `card` and `comment`. +#' the function has at least two arguments `card` and `comment`. #' @return `shiny::moduleServer` #' @export -#' @export add_card_button_srv <- function(id, reporter, card_fun) { shiny::moduleServer( id, From 61f77cb84e452d9af5100c2e6c92802a5a4b1fe5 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 29 Apr 2022 10:11:48 +0200 Subject: [PATCH 46/49] Apply suggestions from code review --- R/AddCardModule.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index 7b79ad18..f20f7f64 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -60,7 +60,7 @@ add_card_button_srv <- function(id, reporter, card_fun) { "Cancel" ), shiny::tags$button( - id = ns("addCardOk"), + id = ns("add_card_ok"), type = "button", class = "btn btn-primary action-button", `data-val` = shiny::restoreInput(id = ns("addCardOk"), default = NULL), @@ -75,7 +75,7 @@ add_card_button_srv <- function(id, reporter, card_fun) { shiny::showModal(add_modal()) }) - shiny::observeEvent(input$addCardOk, { + shiny::observeEvent(input$add_card_ok, { card <- ReportCard$new() card_fun(card, input$comment) checkmate::assert_class(card, "ReportCard") From 867c673f3cbe69c0d53e40f51e081b4af4940bc8 Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 29 Apr 2022 11:02:32 +0200 Subject: [PATCH 47/49] updates --- NAMESPACE | 2 +- R/AddCardModule.R | 23 +++++++--- R/SimpleReporter.R | 12 ++--- man/add_card_button_srv.Rd | 2 +- man/simple_reporter_srv.Rd | 4 +- tests/testthat/test-SimpleReporter.R | 68 ++++++++++++++++------------ tests/testthat/test-addCardModule.R | 4 +- vignettes/simpleReporter.Rmd | 9 ++-- 8 files changed, 71 insertions(+), 53 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 9e7c868b..ff00728f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,13 +2,13 @@ export(ReportCard) export(Reporter) +export(TealReportCard) export(add_card_button_srv) export(add_card_button_ui) export(download_report_button_srv) export(download_report_button_ui) export(simple_reporter_srv) export(simple_reporter_ui) -export(TealReportCard) importFrom(R6,R6Class) importFrom(checkmate,assert_string) importFrom(grid,grid.newpage) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index f20f7f64..ef9ada79 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -9,10 +9,10 @@ add_card_button_ui <- function(id) { ns <- shiny::NS(id) shiny::tagList( shiny::tags$button( - id = ns("addReportCardButton"), + id = ns("add_report_card_button"), type = "button", class = "btn btn-primary action-button", - `data-val` = shiny::restoreInput(id = ns("addReportCardButton"), default = NULL), + `data-val` = shiny::restoreInput(id = ns("add_report_card_button"), default = NULL), NULL, "Add Card" ) @@ -26,10 +26,14 @@ add_card_button_ui <- function(id) { #' @param id `character` #' @param reporter `Reporter` instance. #' @param card_fun `function` which returns a `ReportCard` instance, -#' the function has at least two arguments `card` and `comment`. +#' the function have at`card`argument and optional `comment`. #' @return `shiny::moduleServer` #' @export add_card_button_srv <- function(id, reporter, card_fun) { + checkmate::assert_function(card_fun) + checkmate::assert_class(reporter, "Reporter") + checkmate::assert_subset(names(formals(card_fun)), c("card", "comment"), empty.ok = FALSE) + shiny::moduleServer( id, function(input, output, session) { @@ -63,7 +67,7 @@ add_card_button_srv <- function(id, reporter, card_fun) { id = ns("add_card_ok"), type = "button", class = "btn btn-primary action-button", - `data-val` = shiny::restoreInput(id = ns("addCardOk"), default = NULL), + `data-val` = shiny::restoreInput(id = ns("add_card_ok"), default = NULL), NULL, "Add Card" ) @@ -71,13 +75,20 @@ add_card_button_srv <- function(id, reporter, card_fun) { ) } - shiny::observeEvent(input$addReportCardButton, { + shiny::observeEvent(input$add_report_card_button, { shiny::showModal(add_modal()) }) shiny::observeEvent(input$add_card_ok, { card <- ReportCard$new() - card_fun(card, input$comment) + card_fun_args_nams <- names(formals(card_fun)) + if (length(card_fun_args_nams) == 1) { + card_fun(card) + card$append_text("Comment", "header3") + card$append_text(input$comment) + } else { + card_fun(card, input$comment) + } checkmate::assert_class(card, "ReportCard") reporter$append_cards(list(card)) shiny::removeModal() diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index 025d15a3..824a0f3f 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -8,20 +8,20 @@ simple_reporter_ui <- function(id) { ns <- shiny::NS(id) shiny::tagList( - add_card_button_ui(ns("addReportCard")), - download_report_button_ui(ns("downloadButton")), + add_card_button_ui(ns("add_report_card_simple")), + download_report_button_ui(ns("download_button_simple")), ) } #' Simple Reporter Server #' @description two buttons for adding views and downloading the Report. -#' The add module has `addReportCard` id and download module the `downloadButton` id. +#' The add module has `add_report_card_simple` id and download module the `download_button_simple` id. #' #' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`. #' @param id `character` #' @param reporter `Reporter` instance. #' @param card_fun `function` which returns a `ReportCard` instance, -#' the function have at least two arguments `card` and `comment`. +#' the function have at`card`argument and optional `comment`. #' @param notification logical if to add shiny notification about the download process. #' @return `shiny::moduleServer` #' @export @@ -29,8 +29,8 @@ simple_reporter_srv <- function(id, reporter, card_fun, notification = TRUE) { shiny::moduleServer( id, function(input, output, session) { - add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) - download_report_button_srv("downloadButton", reporter = reporter, notification = notification) + add_card_button_srv("add_report_card_simple", reporter = reporter, card_fun = card_fun) + download_report_button_srv("download_button_simple", reporter = reporter, notification = notification) } ) } diff --git a/man/add_card_button_srv.Rd b/man/add_card_button_srv.Rd index acd2476d..fedec6b0 100644 --- a/man/add_card_button_srv.Rd +++ b/man/add_card_button_srv.Rd @@ -12,7 +12,7 @@ add_card_button_srv(id, reporter, card_fun) \item{reporter}{\code{Reporter} instance.} \item{card_fun}{\code{function} which returns a \code{ReportCard} instance, -the function have at least two arguments \code{card} and \code{comment}.} +the function have at\code{card}argument and optional \code{comment}.} } \value{ \code{shiny::moduleServer} diff --git a/man/simple_reporter_srv.Rd b/man/simple_reporter_srv.Rd index 2b327e28..4bf73e97 100644 --- a/man/simple_reporter_srv.Rd +++ b/man/simple_reporter_srv.Rd @@ -12,7 +12,7 @@ simple_reporter_srv(id, reporter, card_fun, notification = TRUE) \item{reporter}{\code{Reporter} instance.} \item{card_fun}{\code{function} which returns a \code{ReportCard} instance, -the function have at least two arguments \code{card} and \code{comment}.} +the function have at\code{card}argument and optional \code{comment}.} \item{notification}{logical if to add shiny notification about the download process.} } @@ -21,7 +21,7 @@ the function have at least two arguments \code{card} and \code{comment}.} } \description{ two buttons for adding views and downloading the Report. -The add module has \code{addReportCard} id and download module the \code{downloadButton} id. +The add module has \code{add_report_card_simple} id and download module the \code{download_button_simple} id. For more details see the vignette: \code{vignette("simpleReporter", "teal.reporter")}. } diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R index b927517a..854cb16e 100644 --- a/tests/testthat/test-SimpleReporter.R +++ b/tests/testthat/test-SimpleReporter.R @@ -1,26 +1,30 @@ -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() -) +card_fun <- function(card = 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() + ) + card +} + reporter <- Reporter$new() -reporter$append_cards(list(card1)) +reporter$append_cards(list(card_fun())) testthat::test_that("simple_reporter_srv - render and downlaod a document", { shiny::testServer( simple_reporter_srv, - args = list(reporter = reporter, notification = FALSE, card_fun = NULL), + args = list(reporter = reporter, notification = FALSE, card_fun = card_fun), expr = { - session$setInputs(`download_button` = 0) - session$setInputs(`downloadButton-output` = "html_document") - session$setInputs(`downloadButton-title` = "TITLE") - session$setInputs(`downloadButton-author` = "AUTHOR") - session$setInputs(`downloadButton-download_data` = 0) + session$setInputs(`download_button_simple` = 0) + session$setInputs(`download_button_simple-output` = "html_document") + session$setInputs(`download_button_simple-title` = "TITLE") + session$setInputs(`download_button_simple-author` = "AUTHOR") + session$setInputs(`download_button_simple-download_data` = 0) + - f <- output$`downloadButton-download_data` + f <- output$`download_button_simple-download_data` testthat::expect_true(file.exists(f)) tmp_dir <- tempdir() output_dir <- file.path(tmp_dir, sprintf("report_test_%s", gsub("[.]", "", format(Sys.time(), "%Y%m%d%H%M%OS4")))) @@ -33,13 +37,17 @@ testthat::test_that("simple_reporter_srv - render and downlaod a document", { ) }) -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() -) +card_fun <- function(card = ReportCard$new(), comment = NULL) { + 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() + ) + card +} + +card1 <- card_fun() reporter <- Reporter$new() reporter$append_cards(list(card1)) @@ -47,18 +55,18 @@ reporter$append_cards(list(card1)) testthat::test_that("simple_reporter_srv - reset a reporter", { shiny::testServer( simple_reporter_srv, - args = list(reporter = reporter, notification = FALSE), + args = list(reporter = reporter, notification = FALSE, card_fun = card_fun), expr = { testthat::expect_identical(reporter$get_cards(), list(card1)) - session$setInputs(`downloadButton-reset_reporter` = 0) - session$setInputs(`downloadButton-reset_reporter_ok` = 0) + session$setInputs(`download_button_simple-reset_reporter` = 0) + session$setInputs(`download_button_simple-reset_reporter_ok` = 0) testthat::expect_identical(reporter$get_blocks(), list()) } ) }) -card_fun <- function(card = ReportCard$new(), comment = NULL) { +card_fun <- function(card = ReportCard$new()) { card$append_text("Header 2 text", "header2") card$append_text("A paragraph of default text", "header2") card$append_plot( @@ -76,13 +84,13 @@ testthat::test_that("simple_reporter_srv - add a Card to Reporter", { args = list(reporter = reporter, notification = FALSE, card_fun = card_fun), expr = { card_len <- length(card_fun()$get_content()) - session$setInputs(`addReportCard-addReportCardButton` = 0) - session$setInputs(`addReportCard-comment` = "Comment Body") - session$setInputs(`addReportCard-addCardOk` = 0) + session$setInputs(`add_report_card_simple-add_report_card_button` = 0) + session$setInputs(`add_report_card_simple-comment` = "Comment Body") + session$setInputs(`add_report_card_simple-add_card_ok` = 0) testthat::expect_identical( length(reporter$get_blocks()), - card_len + card_len + 2L ) } ) diff --git a/tests/testthat/test-addCardModule.R b/tests/testthat/test-addCardModule.R index 93d0cbc5..43d866ef 100644 --- a/tests/testthat/test-addCardModule.R +++ b/tests/testthat/test-addCardModule.R @@ -18,9 +18,9 @@ testthat::test_that("add_card_button_srv - add a Card to the Reporter", { args = list(reporter = reporter, card_fun = card_fun), expr = { card_len <- length(card_fun()$get_content()) - session$setInputs(`addReportCardButton` = 0) + session$setInputs(`add_report_card_button` = 0) session$setInputs(comment = "Comment Body") - session$setInputs(`addCardOk` = 0) + session$setInputs(`add_card_ok` = 0) testthat::expect_identical( length(reporter$get_blocks()), diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index cd35ab4a..63950bd2 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -32,7 +32,8 @@ The implementation should consist of 5 steps: 2. Initialize Reporter instance. 3. Create the Report Card function with two arguments: card and comment. The function should build the Card step by step and assuming it is empty ad the start, -the comment argument is a string provided by the user when the card is added. +the optional comment argument is a string provided by the user when the card is added. +If the comment argument is not specified then it is added automatically at the end of the Card. This part requires the developer to use their imagination on how the document page should look like. 4. Invoke the servers with the reporter instance and the function to create the report card instance. @@ -107,8 +108,7 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() - card_fun <- function(card = ReportCard$new(), - comment) { + card_fun <- function(card = ReportCard$new(), comment) { if (input$tabs == "Plot") { card$append_text("My plot", "header2") card$append_plot(plot()) @@ -199,8 +199,7 @@ server <- function(input, output, session) { ### REPORTER reporter <- teal.reporter::Reporter$new() - card_fun <- function(card = ReportCard$new(), - comment) { + card_fun <- function(card = ReportCard$new(), comment) { if (input$tabs == "Plot") { card$append_text("My plot", "header2") card$append_plot(plot()) From 293887ffa96e5c40f247618e0ad47449a32b7fdc Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 29 Apr 2022 11:08:33 +0200 Subject: [PATCH 48/49] empty comment --- R/AddCardModule.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/AddCardModule.R b/R/AddCardModule.R index ef9ada79..d1452020 100644 --- a/R/AddCardModule.R +++ b/R/AddCardModule.R @@ -84,8 +84,10 @@ add_card_button_srv <- function(id, reporter, card_fun) { card_fun_args_nams <- names(formals(card_fun)) if (length(card_fun_args_nams) == 1) { card_fun(card) - card$append_text("Comment", "header3") - card$append_text(input$comment) + if (length(input$comment) > 0 && input$comment != "") { + card$append_text("Comment", "header3") + card$append_text(input$comment) + } } else { card_fun(card, input$comment) } From a7702f3402a116abcf03d9d0f06a16751b53fe8f Mon Sep 17 00:00:00 2001 From: Maciej Nasinski Date: Fri, 29 Apr 2022 11:58:38 +0200 Subject: [PATCH 49/49] docs --- tests/testthat/test-SimpleReporter.R | 20 +++++--------------- vignettes/simpleReporter.Rmd | 2 +- 2 files changed, 6 insertions(+), 16 deletions(-) diff --git a/tests/testthat/test-SimpleReporter.R b/tests/testthat/test-SimpleReporter.R index 854cb16e..a1485c7f 100644 --- a/tests/testthat/test-SimpleReporter.R +++ b/tests/testthat/test-SimpleReporter.R @@ -1,4 +1,4 @@ -card_fun <- function(card = ReportCard$new()) { +card_fun0 <- function(card = ReportCard$new()) { card$append_text("Header 2 text", "header2") card$append_text("A paragraph of default text", "header2") card$append_plot( @@ -10,12 +10,12 @@ card_fun <- function(card = ReportCard$new()) { reporter <- Reporter$new() -reporter$append_cards(list(card_fun())) +reporter$append_cards(list(card_fun0())) testthat::test_that("simple_reporter_srv - render and downlaod a document", { shiny::testServer( simple_reporter_srv, - args = list(reporter = reporter, notification = FALSE, card_fun = card_fun), + args = list(reporter = reporter, notification = FALSE, card_fun = card_fun0), expr = { session$setInputs(`download_button_simple` = 0) session$setInputs(`download_button_simple-output` = "html_document") @@ -66,24 +66,14 @@ testthat::test_that("simple_reporter_srv - reset a reporter", { }) -card_fun <- function(card = 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() - ) - card -} - reporter <- Reporter$new() testthat::test_that("simple_reporter_srv - add a Card to Reporter", { shiny::testServer( simple_reporter_srv, - args = list(reporter = reporter, notification = FALSE, card_fun = card_fun), + args = list(reporter = reporter, notification = FALSE, card_fun = card_fun0), expr = { - card_len <- length(card_fun()$get_content()) + card_len <- length(card_fun0()$get_content()) session$setInputs(`add_report_card_simple-add_report_card_button` = 0) session$setInputs(`add_report_card_simple-comment` = "Comment Body") session$setInputs(`add_report_card_simple-add_card_ok` = 0) diff --git a/vignettes/simpleReporter.Rmd b/vignettes/simpleReporter.Rmd index 63950bd2..24ab375b 100644 --- a/vignettes/simpleReporter.Rmd +++ b/vignettes/simpleReporter.Rmd @@ -31,7 +31,7 @@ The implementation should consist of 5 steps: 1. Add modules user interface to the user interface of the app. 2. Initialize Reporter instance. 3. Create the Report Card function with two arguments: card and comment. -The function should build the Card step by step and assuming it is empty ad the start, +The function should build the Card step by step and assuming it is empty at the beginning, the optional comment argument is a string provided by the user when the card is added. If the comment argument is not specified then it is added automatically at the end of the Card. This part requires the developer to use their imagination on how the document page should look like.