Fixes tests in ReporterCard feature branch (#328)

Manual CI: [![Check
🛠](https://github.com/insightsengineering/teal.reporter/actions/workflows/check.yaml/badge.svg?branch=ci%40redesign%40main)](https://github.com/insightsengineering/teal.reporter/actions/workflows/check.yaml?query=branch%3Aci%40redesign%40main)

### Changes description

- Corrects failing tests
    - [x] `test-Reporter.R`
    - [x] `test-SimpleReporter.R`
    - [x] `test-LoadReporterModule.R`
    - [x] `test-DownloadReportModule.R`
    - [x] `test-yaml_utils.R` (`{testthat} 3e` deprecation warning)
- Improvement on existing tests
    - No longer dependent on order of tests (each is atomic)
    - Generates commonly used cards (see `helper-Reporter.R`)
- Uses testthat 3^rd edition (taking advantage of `waldo` for better
comparisons)
  - See insightsengineering/NEST-roadmap#65
- Use of `describe/it` to group some tests together

---------

Signed-off-by: André Veríssimo <[email protected]>
Co-authored-by: Dawid Kałędkowski <[email protected]>

Author: averissimo

DESCRIPTION

@@ -41,7 +41,6 @@ Imports:
     shinyjs (>= 2.1.0),
     shinyWidgets (>= 0.5.1),
     sortable (>= 0.5.0),
-    stats,
     tools,
     utils,
     yaml (>= 1.1.0),
@@ -57,6 +56,7 @@ Suggests:
     shinytest2,
     testthat (>= 3.2.2),
     tinytex,
+    waldo (>= 0.2.0),
     withr (>= 2.0.0)
 VignetteBuilder:
     knitr,
@@ -77,3 +77,4 @@ Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
+Config/testthat/edition: 3

NAMESPACE

@@ -26,6 +26,7 @@ S3method(toHTML,default)
 S3method(toHTML,gg)
 S3method(toHTML,rlisting)
 S3method(toHTML,rtables)
+S3method(tools::toHTML,ContentBlock)
 S3method(ui_editor_block,character)
 S3method(ui_editor_block,default)
 export("metadata<-")
@@ -53,7 +54,6 @@ export(rmd_outputs)
 export(simple_reporter_srv)
 export(simple_reporter_ui)
 export(srv_editor_block)
-export(toHTML.ContentBlock)
 export(ui_editor_block)
 importFrom(R6,R6Class)
 importFrom(checkmate,assert_string)

R/AddCardModule.R

@@ -185,14 +185,23 @@ add_card_button_srv <- function(id, reporter, card_fun) {
           type = "error"
         )
       } else {
-        checkmate::assert_class(card, "ReportCard")
-        if (!has_comment_arg && length(input$comment) > 0 && input$comment != "") {
-          card$append_text("Comment", "header3")
-          card$append_text(input$comment)
-        }
+        checkmate::assert_multi_class(card, c("ReportCard", "ReportDocument"))
+        if (inherits(card, "ReportCard")) {
+          if (!has_comment_arg && length(input$comment) > 0 && input$comment != "") {
+            card$append_text("Comment", "header3")
+            card$append_text(input$comment)
+          }
 
-        if (!has_label_arg && length(input$label) == 1 && input$label != "") {
-          card$set_name(input$label)
+          if (!has_label_arg && length(input$label) == 1 && input$label != "") {
+            card$set_name(input$label)
+          }
+        } else if (inherits(card, "ReportDocument")) {
+          if (!has_comment_arg && length(input$comment) > 0 && input$comment != "") {
+            card <- c(card, "### Comment", input$comment)
+          }
+          if (!has_label_arg && length(input$label) == 1 && input$label != "") {
+            metadata(card, "title") <- input$label
+          }
         }
 
         reporter$append_cards(list(card))

R/DownloadModule.R

@@ -152,6 +152,7 @@ download_report_button_srv <- function(id,
 #' Render the report and zip the created directory.
 #'
 #' @param reporter (`Reporter`) instance.
+#' @param yaml_header (`named list`) with `Rmd` `yaml` header fields and their values.
 #' @param global_knitr (`list`) a global `knitr` parameters, like echo.
 #' But if local parameter is set it will have priority.
 #' @param file (`character(1)`) where to copy the returned directory.
@@ -266,7 +267,13 @@ report_render <- function(reporter, yaml_header, global_knitr = getOption("teal.
   args <- list(...)
 
   # Create output file with report, code and outputs
-  input_path <- to_rmd(reporter, yaml_header, global_knitr, output_dir, include_echo = TRUE)
+  input_path <- to_rmd(
+    reporter,
+    output_dir,
+    yaml_header = yaml_header,
+    global_knitr = global_knitr,
+    include_echo = TRUE
+  )
   args <- append(args, list(
     input = input_path,
     output_dir = output_dir,
@@ -281,7 +288,13 @@ report_render <- function(reporter, yaml_header, global_knitr = getOption("teal.
   file.remove(input_path)
 
   # Create .Rmd file
-  to_rmd(reporter, yaml_header, global_knitr, output_dir, include_echo = FALSE) # TODO remove eval=FALSE also
+  to_rmd(
+    reporter,
+    output_dir,
+    yaml_header = yaml_header,
+    global_knitr = global_knitr,
+    include_echo = FALSE
+  ) # TODO remove eval=FALSE also
   output_dir
 }
 
@@ -298,12 +311,13 @@ to_rmd.default <- function(block, output_dir, ...) {
 
 #' @method to_rmd Reporter
 #' @keywords internal
-to_rmd.Reporter <- function(reporter,
+to_rmd.Reporter <- function(block,
+                            output_dir,
                             yaml_header,
                             global_knitr = getOption("teal.reporter.global_knitr"),
-                            output_dir,
-                            include_echo) {
-  blocks <- reporter$get_blocks()
+                            include_echo,
+                            ...) {
+  blocks <- block$get_blocks()
 
   checkmate::assert_list(
     blocks,

R/Editor.R

@@ -1,8 +1,16 @@
+#' @rdname srv_editor_block
 #' @export
 ui_editor_block <- function(id, value) {
   UseMethod("ui_editor_block", value)
 }
 
+#' UI and Server functions for editing report document blocks
+#'
+#' These functions provide a user interface and server logic for editing and extending
+#' the editor functionality to support new data types.
+#' @param id (`character(1)`) A unique identifier for the module.
+#' @param value The content of the block to be edited. It can be a character string or other types.
+#' @export
 #' @export
 srv_editor_block <- function(id, value) {
   UseMethod("srv_editor_block", value)
@@ -12,7 +20,7 @@ srv_editor_block <- function(id, value) {
 ui_editor_block.default <- function(id, value) {
   shiny::tags$div(
     shiny::tags$h6(
-      tags$span(
+      shiny::tags$span(
         class = "fa-stack small text-muted",
         # style = "width: 2em;", # necessary to avoid extra space after icon
         shiny::icon("pencil", class = "fa-stack-1x"),
@@ -40,7 +48,7 @@ ui_editor_block.character <- function(id, value) {
 
 #' @export
 srv_editor_block.character <- function(id, value) {
-  shiny::moduleServer(id, function(input, output, session) reactive(input$content))
+  shiny::moduleServer(id, function(input, output, session) shiny::reactive(input$content))
 }
 
 ui_report_document_editor <- function(id, value) {
@@ -75,7 +83,7 @@ srv_report_document_editor <- function(id, card_r) {
 
         if (!block_name %in% names(card_r())) { # Only adds UI if not already rendered
           new_block_ui <- ui_editor_block(session$ns(new_block_id), value = block_content)
-          insertUI(sprintf("#%s", session$ns("blocks")), where = "beforeEnd", ui = new_block_ui)
+          shiny::insertUI(sprintf("#%s", session$ns("blocks")), where = "beforeEnd", ui = new_block_ui)
         }
       })
     })
@@ -109,7 +117,7 @@ ui_previewer_card_actions <- function(id) {
 }
 
 srv_previewer_card_actions <- function(id, card_r, card_id, reporter) {
-  moduleServer(id, function(input, output, session) {
+  shiny::moduleServer(id, function(input, output, session) {
     new_card_rv <- shiny::reactiveVal()
 
     shiny::observeEvent(input$edit_action, {
@@ -119,18 +127,18 @@ srv_previewer_card_actions <- function(id, card_r, card_id, reporter) {
       title <- metadata(template_card, "title")
 
       if (isFALSE(nzchar(title))) {
-        title <- tags$span(class = "text-muted", "(empty title)")
+        title <- shiny::tags$span(class = "text-muted", "(empty title)")
       }
 
       shiny::showModal(
         shiny::modalDialog(
-          title = tags$span(
+          title = shiny::tags$span(
             class = "edit_title_container",
             "Editing Card:",
             shiny::tags$span(id = session$ns("static_title"), title),
             shiny::actionButton(
               session$ns("edit_title"),
-              label = tags$span(shiny::icon("pen-to-square"), "edit title"),
+              label = shiny::tags$span(shiny::icon("pen-to-square"), "edit title"),
               class = "fs-6",
               title = "Edit title"
             ),
@@ -157,7 +165,7 @@ srv_previewer_card_actions <- function(id, card_r, card_id, reporter) {
 
     block_input_names_rvs <- srv_report_document_editor("editor", new_card_rv)
 
-    observeEvent(input$edit_title, {
+    shiny::observeEvent(input$edit_title, {
       shinyjs::hide("edit_title")
       shinyjs::hide("static_title")
       shinyjs::show("new_title")
@@ -169,7 +177,7 @@ srv_previewer_card_actions <- function(id, card_r, card_id, reporter) {
       new_card <- new_card_rv()
       input_r <- Filter(Negate(is.null), shiny::reactiveValuesToList(block_input_names_rvs))
       for (name in names(input_r)) {
-        new_card[[name]] <- isolate(input_r[[name]]())
+        new_card[[name]] <- shiny::isolate(input_r[[name]]())
       }
       if (isFALSE(is.null(input$new_title))) {
         metadata(new_card, "title") <- input$new_title
@@ -202,7 +210,7 @@ srv_previewer_card_actions <- function(id, card_r, card_id, reporter) {
     # Handle remove button
     shiny::observeEvent(input$remove_action, reporter$remove_cards(ids = card_id))
 
-    observeEvent( # Hide button for deprecated objects
+    shiny::observeEvent( # Hide button for deprecated objects
       card_r(),
       once = TRUE,
       handlerExpr = {

R/Previewer.R

@@ -135,9 +135,9 @@ reporter_previewer_cards_ui <- function(id) {
   ns <- shiny::NS(id)
   shiny::tags$div(
     id = "reporter_previewer",
-    tags$div(
+    shiny::tags$div(
       id = ns("empty_reporters"),
-      tags$h4(
+      shiny::tags$h4(
         class = "text-muted",
         shiny::icon("circle-info"),
         "No reports have been added yet."
@@ -148,7 +148,7 @@ reporter_previewer_cards_ui <- function(id) {
 }
 
 reporter_previewer_cards_srv <- function(id, reporter) {
-  moduleServer(id, function(input, output, session) {
+  shiny::moduleServer(id, function(input, output, session) {
     current_ids_rv <- shiny::reactiveVal()
     queues_rv <- list(insert = shiny::reactiveVal(), remove = shiny::reactiveVal())
 
@@ -174,7 +174,7 @@ reporter_previewer_cards_srv <- function(id, reporter) {
         current_ids_rv(c(current_ids_rv(), card_id))
         reporter_previewer_card_srv(
           id = card_id,
-          card_r = reactive(reporter$get_cards()[[card_id]]),
+          card_r = shiny::reactive(reporter$get_cards()[[card_id]]),
           card_id = card_id,
           reporter = reporter
         )
@@ -192,7 +192,7 @@ reporter_previewer_card_ui <- function(id, card_id) {
   accordion_item <- bslib::accordion_panel(
     value = card_id,
     title = shiny::tags$label(shiny::uiOutput(ns("title"))),
-    tags$h6(id = ns("loading_placeholder"), class = "text-muted", "Loading the report..."),
+    shiny::tags$h6(id = ns("loading_placeholder"), class = "text-muted", "Loading the report..."),
     shiny::uiOutput(ns("card_content"))
   )
   accordion_item <- htmltools::tagAppendAttributes(accordion_item, "data-rank-id" = card_id)
@@ -214,14 +214,14 @@ reporter_previewer_card_srv <- function(id, card_r, card_id, reporter) {
   # todo: card_name should be only on the server side
   shiny::moduleServer(id, function(input, output, session) {
     output$title <- shiny::renderUI({
-      title <- metadata(req(card_r()), "title")
+      title <- metadata(shiny::req(card_r()), "title")
       if (isFALSE(nzchar(title))) {
-        title <- tags$span("(empty title)", class = "text-muted")
+        title <- shiny::tags$span("(empty title)", class = "text-muted")
       }
       title
     })
     output$card_content <- shiny::renderUI({
-      result <- toHTML(req(card_r()))
+      result <- toHTML(shiny::req(card_r()))
       shiny::removeUI(sprintf("#%s", session$ns("loading_placeholder")))
       result
     })
@@ -249,8 +249,10 @@ toHTML.default <- function(x, ...) {
   shiny::HTML(commonmark::markdown_html(x, extensions = TRUE))
 }
 
+#' Convert a `ContentBlock` to HTML
+#' @inheritParams tools::toHTML
 #' @keywords internal
-#' @export
+#' @exportS3Method tools::toHTML
 toHTML.ContentBlock <- function(x, ...) {
   UseMethod("toHTML", x$get_content()) # Further dispatch for subclasses
 }

R/ReportDocument.R

@@ -65,12 +65,20 @@ c.ReportDocument <- function(...) {
   out
 }
 
+#' Access metadata from a `ReportDocument` or `ReportCard`
+#'
+#' This function retrieves metadata from a `ReportDocument` or `ReportCard` object.
+#' When `which` is `NULL`, it returns all metadata fields as a list.
+#' @param object (`ReportDocument` or `ReportCard`) The object from which to extract metadata.
+#' @param which (`character` or `NULL`) The name of the metadata field to extract.
+#' @return A list of metadata fields or a specific field if `which` is provided.
 #' @export
 metadata <- function(object, which = NULL) {
   checkmate::assert_string(which, null.ok = TRUE)
   UseMethod("metadata", object)
 }
 
+#' @rdname metadata
 #' @export
 metadata.ReportDocument <- function(object, which = NULL) {
   metadata <- attr(object, which = "metadata", exact = TRUE)
@@ -81,6 +89,7 @@ metadata.ReportDocument <- function(object, which = NULL) {
   result[[which]]
 }
 
+#' @rdname metadata
 #' @export
 metadata.ReportCard <- function(object, which = NULL) {
   # TODO: soft deprecate
@@ -91,20 +100,32 @@ metadata.ReportCard <- function(object, which = NULL) {
   result[[which]]
 }
 
+#' Set metadata for a `ReportDocument` or `ReportCard`
+#'
+#' This function allows you to set or modify metadata fields in a `ReportDocument` or `ReportCard` object.
+#' It can be used to add new metadata or update existing fields.
+#' @param object (`ReportDocument` or `ReportCard`) The object to modify.
+#' @param which (`character`) The name of the metadata field to set.
+#' @param value The value to assign to the specified metadata field.
+#' @return The modified object with updated metadata.
 #' @export
 `metadata<-` <- function(object, which, value) {
   checkmate::assert_string(which)
   UseMethod("metadata<-", object)
 }
 
+#' @rdname metadata-set
 #' @export
 `metadata<-.ReportDocument` <- function(object, which, value) {
-  attr(object, which = "metadata") <- modifyList(
+  attr(object, which = "metadata") <- utils::modifyList(
     metadata(object), structure(list(value), names = which)
   )
   object
 }
 
+#' @rdname metadata-set
+#' @details
+#' The `ReportCard` class only supports the `title` field in metadata.
 #' @export
 `metadata<-.ReportCard` <- function(object, which, value) {
   if (which != "title") {