chore: adding tests, adding note about exports

Author: dgkf

R/utils_knitr.R

@@ -1,10 +1,24 @@
+roxygen2_knitr_note <- function() {
+  sprintf(
+    paste(
+      "`%s` `knitr` utilities are exported for use in",
+      "reports maintained by the R Validation Hub.",
+      "If you choose to use these functions for other purposes, be aware",
+      "that these are not considered stable for broader use."
+    ),
+    packageName()
+  )
+}
+
 #' Handler for complex option passing through from a quarto parameter
 #'
 #' Importantly, handles [`S7::new_class()`] objects which cannot be passed
 #' through as a `quarto` command-line parameter because they can not be
 #' deparsed. This helper allows passing arbitrary expressions using the
 #' `!expr` prefix, which is standardized by `yaml`.
 #'
+#' @note `r roxygen2_knitr_note()`
+#'
 #' @param opts A `list` of options. For any non-serializable values that would
 #'   fail using your preferred interface to `knitr`, you may pass them as an
 #'   expression string such as `"!expr mtcars"`. Notably,
@@ -57,32 +71,25 @@ knitr_update_options <- function(opts, envir = parent.frame()) {
 #' a mutable environment that we can modify, which will be used to update the
 #' knitr document header upon render completion.
 #'
+#' @note `r roxygen2_knitr_note()`
+#'
 #' @param params Optionally, provide default parameters to initialize with
 #' @param envir Only used when `params` is not provided, as the source for where
 #'   to try to discover the default knitr frontmatter parameters.
 #'
 #' @importFrom yaml yaml.load
 #' @export
-knitr_mutable_header <- function(params = NULL, envir = parent.frame()) {
+knitr_mutable_header <- function() {
   header <- new.env(parent = emptyenv())
 
-  # if not provided, try to get params from envir
-  if (is.null(params)) {
-    params <- get0("params", envir = envir, ifnotfound = list())
-  }
-
-  # initialize with param values
-  for (name in names(params)) {
-    header[[name]] <- params[[name]]
-  }
-
   # add a hook that will replace the hard-coded front-matter with dynamic
   # front-matter just before rendering.
   knitr::knit_hooks$set(
     document = local({
       default_document_hook <- knitr::knit_hooks$get("document")
-      function(x, output) {
+      function(x, options) {
         # extract and split our document front-matter and body
+        x <- paste(x, collapse = "\n")
         body <- sub("^\\s*(---|\\.\\.\\.).*\\1", "", x)
         fm <- substring(x, 0L, nchar(x) - nchar(body))
 
@@ -115,7 +122,13 @@ knit_print.knitr_log <- local({
   prefix <- "  \u205A " # vertical two dot punctuation
   last_log_trailing_newline <- FALSE
 
-  function(x, ...) {
+  # "progress" is used by knitr::knit function internally to store whether
+  # progress should be written to console, equivalent to !quiet
+  function(x, ..., quiet = !knitr::opts_knit$get("progress")) {
+    if (quiet) {
+      return()
+    }
+
     # prefix newline only for the first message in each chunk
     knitr_log_env <- environment(knitr_logger)
     first_chunk_log <- knitr_log_env$first_chunk_log
@@ -156,6 +169,7 @@ knit_print.knitr_log <- local({
     if (first_chunk_log) {
       cat("\n", file = stderr(), sep = "")
     }
+
     cat(x, file = stderr(), sep = "")
   }
 })
@@ -165,6 +179,8 @@ knit_print.knitr_log <- local({
 #' Sets necessary knitr hooks and returns a logging function that will emit
 #' messages to the console during knitting.
 #'
+#' @note `r roxygen2_knitr_note()`
+#'
 #' @return A `function` accepting `...` arguments, which will be used for
 #'   printing out to the console while rendering the knitr document. Character
 #'   values are logged directrly, while any other object is printed as though

man/knit_print.knitr_log.Rd

@@ -28,8 +28,19 @@ writeLines(
 title: Example
 params: { options: NULL }
 ---
-```{r}
+
+```{r, echo = FALSE}
 library(val.report)
+
+# logging
+log <- knitr_logger()
+log("test 1 2 3\n")
+
+# update header
+header <- knitr_mutable_header()
+header$title <- "Mutable Title"
+
+# update and save out options
 opts <- knitr_update_options(params$options)
 saveRDS(opts, "%s")
 ```',
@@ -54,13 +65,10 @@ test_that(
   {
     skip_if_not_installed("rmarkdown")
 
-    opts <- options()
-    on.exit(options(opts))
-
     # this would work even without our function by just setting
     # `options(params$options)`. However, we want to make sure it still works
     # when it gets passed through our helper
-    rmarkdown::render(example_qmd, params = params_r)
+    rmarkdown::render(example_qmd, params = params_r, quiet = TRUE)
     parsed_options <- example_parsed_options()
 
     expect_identical(parsed_options$example_2, example_2)
@@ -69,14 +77,14 @@ test_that(
 
 test_that("knitr_update_options is still required for quarto::quarto_render", {
   skip_if_not_installed("quarto")
-  skip_if(is.null(quarto::quarto_path()))
+  skip_if(
+    is.null(quarto::quarto_path()),
+    "system `quarto` executable unavailable"
+  )
 
   # ignore this test on cran because it is testing behavior of another package
   skip_on_cran()
 
-  opts <- options()
-  on.exit(options(opts))
-
   # if this test starts to fail, it probably means that S7 has found a solution
   # to serializing their objects, removing the need for `knitr_update_options`
   #
@@ -96,10 +104,10 @@ test_that(
   ),
   {
     skip_if_not_installed("quarto")
-    skip_if(is.null(quarto::quarto_path()))
-
-    opts <- options()
-    on.exit(options(opts))
+    skip_if(
+      is.null(quarto::quarto_path()),
+      "system `quarto` executable unavailable"
+    )
 
     quarto::quarto_render(
       example_qmd,
@@ -112,3 +120,34 @@ test_that(
     expect_identical(parsed_options$example_2, example_2)
   }
 )
+
+test_that("knitr_mutable_header can modify yaml frontmatter during runtime", {
+  skip_if_not_installed("rmarkdown")
+
+  rmarkdown::render(
+    example_qmd,
+    # pass content that will be used to modify the yaml frontmatter at runtime
+    output_file = example_md <- tempfile(fileext = ".md"),
+    output_format = rmarkdown::github_document(),
+    quiet = TRUE
+  )
+
+  content <- readLines(example_md)
+  expect_match(paste(content, collapse = "\n"), "^Mutable Title\n===", )
+})
+
+test_that("knitr_logger writes to console output", {
+  skip_if_not_installed("rmarkdown")
+
+  output <- capture.output({
+    messages <- capture.output(type = "message", {
+      rmarkdown::render(
+        example_qmd,
+        output_file = example_md <- tempfile(fileext = ".md"),
+        output_format = rmarkdown::github_document()
+      )
+    })
+  })
+
+  expect_true(any(grepl("test 1 2 3", messages)))
+})