Use evaluate (#344)

Followup to insightsengineering/teal.code#258

- eval_code adds `attr(code, "outputs")` to the `teal_card` but skips
the warnings and messages (conditions).

Author: gogonzo

R/teal_card.R

@@ -104,7 +104,7 @@ c.teal_card <- function(...) {
               "Appended `teal_card` doesn't remove some of the elements from previous `teal_card`.\n",
               "Restoring original content and adding only new items to the end of the card."
             )
-            modifyList(u, v)
+            utils::modifyList(u, v)
           }
         } else {
           attrs <- utils::modifyList(attributes(u) %||% list(), attributes(v))

R/teal_report-eval_code.R

@@ -1,8 +1,5 @@
 #' @inherit teal.code::eval_code
 #' @param object (`teal_report`)
-#' @param keep_output (`character` or `NULL`) Names of output objects in the environment
-#' that are will be added in the card for the reporter.
-#' These are shown in the card via the [tools::toHTML()] and [to_rmd()] implementations.
 #' @param code_block_opts (`list`) Additional options for the R code chunk in R Markdown.
 #' @return `teal_reporter` environment with the code evaluated and the outputs added
 #' to the card or `qenv.error` if evaluation fails.
@@ -19,41 +16,32 @@
 setMethod(
   "eval_code",
   signature = c(object = "teal_report"),
-  function(object, code, keep_output = NULL, code_block_opts = list(), ...) {
+  function(object, code, code_block_opts = list(), ...) {
     new_object <- methods::callNextMethod(object = object, code = code, ...)
     if (inherits(new_object, "error")) {
       return(new_object)
     }
 
-    checkmate::assert(
-      combine = "and",
-      .var.name = "keep_output",
-      checkmate::check_character(keep_output, null.ok = TRUE),
-      checkmate::check_subset(keep_output, ls(new_object, all.names = TRUE), empty.ok = TRUE)
-    )
-    new_code <- .preprocess_code(code)
-    if (length(new_code)) {
-      teal_card(new_object) <- c(
-        teal_card(new_object),
-        do.call(code_chunk, args = c(list(code = new_code), code_block_opts))
-      )
-      teal_card(new_object) <- Reduce(
-        function(result, this) {
-          this_output <- new_object[[this]]
-          c(
-            result,
-            structure(
-              this_output,
-              class = c("chunk_output", class(this_output))
-            )
+    new_blocks <- Reduce(
+      function(items, code_elem) {
+        this_chunk <- do.call(code_chunk, c(list(code = code_elem), code_block_opts))
+        this_outs <- Filter( # intentionally remove warnings,messages from the generated report
+          function(x) !inherits(x, "condition"),
+          lapply(
+            attr(code_elem, "outputs"),
+            function(x) structure(x, class = c("chunk_output", class(x)))
           )
-        },
-        init = teal_card(new_object),
-        x = keep_output
-      )
+        )
+        c(items, list(this_chunk), this_outs)
+      },
+      init = list(),
+      x = setdiff(new_object@code, object@code)
+    )
+
+
+    if (length(new_blocks)) {
+      teal_card(new_object) <- c(teal_card(new_object), new_blocks)
     }
     new_object
   }
 )
-
-.preprocess_code <- getFromNamespace(".preprocess_code", "teal.code")

R/toHTML.R

@@ -94,26 +94,34 @@ toHTML.default <- function(x, ...) {
   shiny::tags$pre(flextable::htmltools_value(to_flextable(x)))
 }
 
-#' @method .toHTML gg
-#' @keywords internal
-.toHTML.gg <- function(x, ...) {
+.plot2html <- function(x, ...) {
   on.exit(unlink(tmpfile))
   tmpfile <- tempfile(fileext = ".png")
-  ggplot2::ggsave(tmpfile, plot = x, width = 5, height = 4, dpi = 100)
+  grDevices::png(filename = tmpfile)
+  print(x)
+  grDevices::dev.off()
   shiny::tags$img(src = knitr::image_uri(tmpfile))
 }
 
+#' @method .toHTML recordedplot
+#' @keywords internal
+.toHTML.recordedplot <- .plot2html
+
+
 #' @method .toHTML trellis
 #' @keywords internal
-.toHTML.trellis <- function(x, ...) {
+.toHTML.trellis <- .plot2html
+
+#' @method .toHTML gg
+#' @keywords internal
+.toHTML.gg <- function(x, ...) {
   on.exit(unlink(tmpfile))
   tmpfile <- tempfile(fileext = ".png")
-  grDevices::png(filename = tmpfile)
-  print(x)
-  grDevices::dev.off()
+  ggplot2::ggsave(tmpfile, plot = x, width = 5, height = 4, dpi = 100)
   shiny::tags$img(src = knitr::image_uri(tmpfile))
 }
 
+
 #' @method .toHTML grob
 #' @keywords internal
 .toHTML.grob <- function(x, ...) {

R/to_rmd.R

@@ -242,6 +242,10 @@ to_rmd.default <- function(block, output_dir, ...) {
 #' @keywords internal
 .to_rmd.trellis <- .content_to_rmd
 
+#' @method .to_rmd recordedplot
+#' @keywords internal
+.to_rmd.recordedplot <- .content_to_rmd
+
 #' @method .to_rmd grob
 #' @keywords internal
 .to_rmd.grob <- .content_to_rmd

man/eval_code-teal_report-method.Rd

@@ -1,53 +1,56 @@
-testthat::describe("keep_output stores the objects in teal_card", {
-  it("using eval_code and explicit reference", {
-    q <- eval_code(teal_report(), "a <- 1L;b <- 2L;c <- 3L", keep_output = "b")
+testthat::describe("eval_code appends code_chunks to the teal_card", {
+  it("code as code_chunk", {
+    q <- eval_code(teal_report(), "a <- 1L;b <- 2L;c <- 3L")
     testthat::expect_equal(
       teal_card(q),
       teal_card(
-        code_chunk("a <- 1L;b <- 2L;c <- 3L"),
-        structure(2L, class = c("chunk_output", "integer"))
+        code_chunk("a <- 1L"),
+        code_chunk("b <- 2L"),
+        code_chunk("c <- 3L")
       ),
       ignore_attr = TRUE
     )
   })
 
-  it("using within and explicit reference", {
-    q <- within(teal_report(),
-      {
-        a <- 1L
-        b <- 2L
-        c <- 3L
-      },
-      keep_output = "b"
-    )
+  it("code as code_chunk and its output as chunk_output", {
+    q <- eval_code(teal_report(), "a <- 1L;a")
     testthat::expect_equal(
       teal_card(q),
-      teal_card(
-        code_chunk("a <- 1L\nb <- 2L\nc <- 3L"),
-        structure(2L, class = c("chunk_output", "integer"))
+      c(
+        teal_card(),
+        code_chunk("a <- 1L"),
+        code_chunk("a"),
+        structure(1L, class = c("chunk_output", "integer"))
       ),
       ignore_attr = TRUE
     )
   })
 
-  it("with multiple explicit object references", {
-    q <- eval_code(teal_report(), "a <- 1L;b <- 2L;c <- 3L", keep_output = c("a", "b"))
+  it("code as code_chunk and condition is excluded from output", {
+    q <- eval_code(teal_report(), "warning('test')")
     testthat::expect_equal(
       teal_card(q),
-      teal_card(
-        code_chunk("a <- 1L;b <- 2L;c <- 3L"),
-        structure(1L, class = c("chunk_output", "integer")),
-        structure(2L, class = c("chunk_output", "integer"))
-      ),
+      c(teal_card(), code_chunk("warning('test')")),
       ignore_attr = TRUE
     )
   })
+})
 
-  it("without explicit reference returing none", {
-    q <- eval_code(teal_report(), "a <- 1L;b <- 2L;c <- 3L", keep_output = character(0L))
+testthat::describe("within appends to teal_card", {
+  it("code as code_chunk", {
+    q <- within(teal_report(), {
+      a <- 1L
+      b <- 2L
+      c <- 3L
+    })
     testthat::expect_equal(
       teal_card(q),
-      teal_card(code_chunk("a <- 1L;b <- 2L;c <- 3L")),
+      c(
+        teal_card(),
+        code_chunk("a <- 1L"),
+        code_chunk("b <- 2L"),
+        code_chunk("c <- 3L")
+      ),
       ignore_attr = TRUE
     )
   })