init simple report

.Rbuildignore

@@ -7,3 +7,5 @@
 ^\.github$
 ^\.lintr$
 ^\.pre-commit-config\.yaml$
+^doc$
+^Meta$

.gitignore

@@ -2,3 +2,5 @@
 .Rhistory
 docs
 inst/doc
+/doc/
+/Meta/

DESCRIPTION

@@ -12,7 +12,10 @@ Imports:
     checkmate,
     grid,
     R6,
-    yaml
+    yaml,
+    shiny,
+    shinyWidgets,
+    zip
 Suggests:
     ggplot2,
     knitr,

NAMESPACE

@@ -2,6 +2,12 @@
 
 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(simple_reporter_srv)
+export(simple_reporter_ui)
 importFrom(R6,R6Class)
 importFrom(checkmate,assert_string)
 importFrom(grid,grid.newpage)

R/AddCardModule.R

@@ -0,0 +1,89 @@
+#' Add Card Button User Interface
+#' @description button for adding views/cards to the Report.
+#'
+#' 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
+#' @description server for adding views/cards to the Report.
+#'
+#' 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.
+#' @return `shiny::moduleServer`
+#' @export
+#' @export
+add_card_button_srv <- function(id, reporter, card_fun) {
+  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$addReportCardButton, {
+        shiny::showModal(add_modal())
+      })
+
+      shiny::observeEvent(input$addCardOk, {
+        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()
+      })
+    }
+  )
+}

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 <- ""

R/DownloadModule.R

@@ -0,0 +1,175 @@
+#' Download Button Reporter User Interface
+#' @description button for downloading the Report.
+#'
+#' 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.
+#'
+#' For more details see the vignette: `vignette("simpleReporter", "teal.reporter")`.
+#' @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,
+#' 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"
+                                       )) {
+  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 = output_types
+            )
+          ),
+          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) {
+          if (notification) {
+            shiny::showNotification(sprintf("Rendering and Downloading a document."))
+          }
+
+          render_and_download(reporter, input, file)
+        },
+        contentType = "application/zip"
+      )
+    }
+  )
+}
+
+#' 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),
+    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)
+}

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))

R/Reporter.R

@@ -107,16 +107,24 @@ Reporter <- R6::R6Class( # nolint: object_name_linter.
         blocks <- append(blocks, private$cards[[length(private$cards)]]$get_content())
       }
       blocks
+    },
+    #' @description Removes all `ReportCard` objects added to this `Reporter`.
+    #'
+    #' @return invisibly self
+    #'
+    reset = function() {
+      private$cards <- list()
+      invisible(self)
     }
   ),
   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))