feat: allow html content to be added to a report (#294)

R/ContentBlock.R

@@ -8,22 +8,9 @@
 ContentBlock <- R6::R6Class( # nolint: object_name_linter.
   classname = "ContentBlock",
   public = list(
-    #' @description Initialize a `ContentBlock` object.
-    #'
-    #' @details Returns a `ContentBlock` object with no content and the default style.
-    #'
-    #' @return Object of class `ContentBlock`, invisibly.
-    #' @examples
-    #' ContentBlock <- getFromNamespace("ContentBlock", "teal.reporter")
-    #' ContentBlock$new()
-    #'
-    initialize = function() {
-      private$content <- character(0)
-      invisible(self)
-    },
     #' @description Sets content of this `ContentBlock`.
     #'
-    #' @param content (`character(0)` or `character(1)`) string or file path assigned to this `ContentBlock`
+    #' @param content (`any`) R object
     #'
     #' @return `self`, invisibly.
     #' @examples
@@ -32,13 +19,12 @@ ContentBlock <- R6::R6Class( # nolint: object_name_linter.
     #' block$set_content("Base64 encoded picture")
     #'
     set_content = function(content) {
-      checkmate::assert_character(content, min.len = 0, max.len = 1)
       private$content <- content
       invisible(self)
     },
     #' @description Retrieves the content assigned to this block.
     #'
-    #' @return `character` string or file path assigned to this `ContentBlock`.
+    #' @return object stored in a `private$content` field
     #' @examples
     #' ContentBlock <- getFromNamespace("ContentBlock", "teal.reporter")
     #' block <- ContentBlock$new()
@@ -64,7 +50,7 @@ ContentBlock <- R6::R6Class( # nolint: object_name_linter.
     }
   ),
   private = list(
-    content = character(0),
+    content = NULL, # this can be any R object
     # @description The copy constructor.
     #
     # @param name (`character(1)`) the name of the field

R/FileBlock.R

@@ -56,6 +56,9 @@ FileBlock <- R6::R6Class( # nolint: object_name_linter.
       list(basename = base_name)
     }
   ),
+  private = list(
+    content = character(0)
+  ),
   lock_objects = TRUE,
   lock_class = TRUE
 )

R/HTMLBlock.R

@@ -0,0 +1,62 @@
+#' @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 = ContentBlock,
+  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, private$supported_types)
+        self$set_content(content)
+      }
+      invisible(self)
+    },
+
+    #' @description Create the `HTMLBlock` from a list.
+    #'
+    #' @param x (`named list`) with a single field `content` containing `shiny.tag`,
+    #' `shiny.tag.list` or `htmlwidget`.
+    #'
+    #' @return `self`, invisibly.
+    #' @examples
+    #' HTMLBlock <- getFromNamespace("HTMLBlock", "teal.reporter")
+    #' block <- HTMLBlock$new()
+    #' block$from_list(list(content = shiny::tags$div("test")))
+    #'
+    from_list = function(x) {
+      checkmate::assert_list(x, types = private$supported_types)
+      checkmate::assert_names(names(x), must.include = "content")
+      self$set_content(x$content)
+      invisible(self)
+    },
+
+    #' @description Convert the `HTMLBlock` to a list.
+    #'
+    #' @return `named list` with a text and style.
+    #' @examples
+    #' HTMLBlock <- getFromNamespace("HTMLBlock", "teal.reporter")
+    #' block <- HTMLBlock$new(shiny::tags$div("test"))
+    #' block$to_list()
+    #'
+    to_list = function() {
+      list(content = self$get_content())
+    }
+  ),
+  private = list(
+    supported_types = c("shiny.tag", "shiny.tag.list", "htmlwidget")
+  ),
+  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")) {
+    b_content
   } else {
     stop("Unknown block class")
   }

R/RcodeBlock.R

@@ -21,10 +21,25 @@ RcodeBlock <- R6::R6Class( # nolint: object_name_linter.
     #' block <- RcodeBlock$new()
     #'
     initialize = function(content = character(0), ...) {
+      checkmate::assert_class(content, "character")
       super$set_content(content)
       self$set_params(list(...))
       invisible(self)
     },
+    #' @description Sets content of this `RcodeBlock`.
+    #'
+    #' @param content (`any`) R object
+    #'
+    #' @return `self`, invisibly.
+    #' @examples
+    #' RcodeBlock <- getFromNamespace("RcodeBlock", "teal.reporter")
+    #' block <- RcodeBlock$new()
+    #' block$set_content("a <- 1")
+    #'
+    set_content = function(content) {
+      checkmate::assert_string(content)
+      super$set_content(content)
+    },
     #' @description Sets the parameters of this `RcodeBlock`.
     #'
     #' @details Configures `rmarkdown` chunk parameters for the `R` code block,
@@ -97,6 +112,7 @@ RcodeBlock <- R6::R6Class( # nolint: object_name_linter.
     }
   ),
   private = list(
+    content = character(0),
     params = list()
   ),
   lock_objects = TRUE,

R/Renderer.R

@@ -81,9 +81,11 @@ 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)) {
         yaml_header <- md_header(yaml::as.yaml(list(title = "Report")))
       }
@@ -220,6 +222,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 +279,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 <- basename(tempfile(fileext = ".rds"))
+      suppressWarnings(saveRDS(block$get_content(), file = file.path(private$output_dir, basename)))
+      sprintf("```{r echo = FALSE}\nreadRDS('%s')\n```", basename)
     }
   ),
   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.

R/TextBlock.R

@@ -27,6 +27,20 @@ TextBlock <- R6::R6Class( # nolint: object_name_linter.
       self$set_style(style)
       invisible(self)
     },
+    #' @description Sets content of this `TextBlock`.
+    #'
+    #' @param content (`any`) R object
+    #'
+    #' @return `self`, invisibly.
+    #' @examples
+    #' ContentBlock <- getFromNamespace("ContentBlock", "teal.reporter")
+    #' block <- ContentBlock$new()
+    #' block$set_content("Base64 encoded picture")
+    #'
+    set_content = function(content) {
+      checkmate::assert_string(content)
+      super$set_content(content)
+    },
     #' @description Sets the style of this `TextBlock`.
     #'
     #' @details The style has bearing on the rendering of this block.
@@ -96,6 +110,7 @@ TextBlock <- R6::R6Class( # nolint: object_name_linter.
     }
   ),
   private = list(
+    content = character(0),
     style = character(0),
     styles = c("default", "header2", "header3", "verbatim")
   ),