feat: allow html content to be added to a report

R/HTMLBlock.R

@@ -0,0 +1,47 @@
+#' @title `HTMLBlock`
+#' @docType class
+#' @description
+#' Specialized `FileBlock` for managing HTML content in reports.
+#' It's designed to handle various HTML content, and render the report as HTML,
+#' however `htmlwidgets` objects can also be rendered to static document-ready format.
+#'
+#' @keywords internal
+HTMLBlock <- R6::R6Class( # nolint: object_name_linter.
+  classname = "HTMLBlock",
+  inherit = FileBlock,
+  public = list(
+    #' @description Initialize a `HTMLBlock` object.
+    #'
+    #' @param content An object that can be rendered as a HTML content assigned to
+    #'   this `HTMLBlock`
+    #'
+    #' @return Object of class `HTMLBlock`, invisibly.
+    initialize = function(content) {
+      if (!missing(content)) {
+        checkmate::assert_multi_class(content, c("shiny.tag", "shiny.tag.list", "htmlwidget"))
+        self$set_content(content)
+      }
+      invisible(self)
+    },
+    #' @description Sets content of this `HTMLBlock`.
+    #'
+    #' @param content An object that can be rendered as a HTML content
+    #' assigned to this `HTMLBlock`
+    #'
+    #' @return `self`, invisibly.
+    #' @examples
+    #' HTMLBlock <- getFromNamespace("HTMLBlock", "teal.reporter")
+    #' block <- HTMLBlock$new()
+    #' block$set_content(shiny::div("HTML Content"))
+    #'
+    set_content = function(content) {
+      path <- tempfile(fileext = ".rds")
+      saveRDS(content, file = path)
+      super$set_content(path)
+      invisible(self)
+    }
+  ),
+  private = list(),
+  lock_objects = TRUE,
+  lock_class = TRUE
+)

R/Previewer.R

@@ -319,6 +319,8 @@ block_to_html <- function(b) {
     )
   } else if (inherits(b, "NewpageBlock")) {
     shiny::tags$br()
+  } else if (inherits(b, "HTMLBlock")) {
+    readRDS(b_content)
   } else {
     stop("Unknown block class")
   }

R/Renderer.R

@@ -81,7 +81,10 @@ Renderer <- R6::R6Class( # nolint: object_name_linter.
     #' result_path <- Renderer$new()$renderRmd(reporter$get_blocks(), yaml_header)
     #'
     renderRmd = function(blocks, yaml_header, global_knitr = getOption("teal.reporter.global_knitr")) {
-      checkmate::assert_list(blocks, c("TextBlock", "PictureBlock", "NewpageBlock", "TableBlock", "RcodeBlock"))
+      checkmate::assert_list(
+        blocks,
+        c("TextBlock", "PictureBlock", "NewpageBlock", "TableBlock", "RcodeBlock", "HTMLBlock")
+      )
       checkmate::assert_subset(names(global_knitr), names(knitr::opts_chunk$get()))
 
       if (missing(yaml_header)) {
@@ -220,6 +223,8 @@ Renderer <- R6::R6Class( # nolint: object_name_linter.
         private$tableBlock2md(block)
       } else if (inherits(block, "NewpageBlock")) {
         block$get_content()
+      } else if (inherits(block, "HTMLBlock")) {
+        private$htmlBlock2md(block)
       } else {
         stop("Unknown block class")
       }
@@ -275,6 +280,11 @@ Renderer <- R6::R6Class( # nolint: object_name_linter.
       basename_table <- basename(block$get_content())
       file.copy(block$get_content(), file.path(private$output_dir, basename_table))
       sprintf("```{r echo = FALSE}\nreadRDS('%s')\n```", basename_table)
+    },
+    htmlBlock2md = function(block) {
+      basename_content <- basename(block$get_content())
+      file.copy(block$get_content(), file.path(private$output_dir, basename_content))
+      sprintf("```{r echo = FALSE}\nreadRDS('%s')\n```", basename_content)
     }
   ),
   lock_objects = TRUE,

R/ReportCard.R

@@ -37,6 +37,17 @@ ReportCard <- R6::R6Class( # nolint: object_name_linter.
       self$append_content(TableBlock$new(table))
       invisible(self)
     },
+    #' @description Appends a html content to this `ReportCard`.
+    #'
+    #' @param content An object that can be rendered as a HTML content.
+    #' @return `self`, invisibly.
+    #' @examples
+    #' card <- ReportCard$new()$append_html(shiny::div("HTML Content"))
+    #'
+    append_html = function(content) {
+      self$append_content(HTMLBlock$new(content))
+      invisible(self)
+    },
     #' @description Appends a plot to this `ReportCard`.
     #'
     #' @param plot (`ggplot` or `grob` or `trellis`) plot object.

tests/testthat/test-Renderer.R

@@ -24,7 +24,7 @@ testthat::test_that("renderRmd asserts the argument is a list of TextBlocks/Pict
   renderer <- Renderer$new()
   testthat::expect_error(
     renderer$renderRmd(append(blocks, "STH")),
-    regexp = "May only contain the following types: \\{TextBlock,PictureBlock,NewpageBlock,TableBlock,RcodeBlock\\}"
+    regexp = "May only contain the following types: \\{TextBlock,PictureBlock,NewpageBlock,TableBlock,RcodeBlock,HTMLBlock\\}" # nolint line_length
   )
 })