Merge pull request #310 from carpentries/add-strict-errors

add `fail_on_error` option support to config.yaml

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sandpaper
 Title: Create and Curate Carpentries Lessons
-Version: 0.6.2
+Version: 0.7.0
 Authors@R: c(
     person(given = "Zhian N.",
            family = "Kamvar",

NEWS.md

@@ -1,3 +1,14 @@
+# sandpaper 0.7.0
+
+NEW FEATURE
+-----------
+
+* Placing `fail_on_error: true` in `config.yaml` will set the global chunk
+  option `error = FALSE` for R Markdown documents, meaning that if an error
+  is produced from a chunk, the build will fail unless that chunk explicitly
+  uses the `error = TRUE` option. (requested: #306 by @davidps, implemented:
+  #310 by @zkamvar)
+
 # sandpaper 0.6.2
 
 BUG FIX

R/build_episode.R

@@ -182,6 +182,9 @@ get_nav_data <- function(path_md, path_src = NULL, home = NULL,
 #'   environment, which evaluates to the environment from [callr::r()]. 
 #' @param quiet if `TRUE`, output is suppressed, default is `FALSE` to show 
 #'   {knitr} output.
+#' @param error if `TRUE` (default) errors do not make an invalid build.
+#'   This can be set to false to cause the build to fail if an error occurs.
+#'   This is generally controlled via the `fail_on_error` config option.
 #' @return the path to the output, invisibly
 #' @keywords internal
 #' @export
@@ -210,7 +213,10 @@ get_nav_data <- function(path_md, path_src = NULL, home = NULL,
 #' res <- build_episode_md(fun_file, outdir = fun_dir, workdir = fun_dir)
 build_episode_md <- function(path, hash = NULL, outdir = path_built(path), 
                              workdir = path_built(path), 
-                             workenv = globalenv(), profile = "lesson-requirements", quiet = FALSE) {
+                             workenv = globalenv(), 
+                             profile = "lesson-requirements", 
+                             quiet = FALSE,
+                             error = TRUE) {
 
   # define the output
   md <- fs::path_ext_set(fs::path_file(path), "md")
@@ -229,7 +235,8 @@ build_episode_md <- function(path, hash = NULL, outdir = path_built(path),
     outpath = outpath,
     workdir = workdir,
     root    = if (has_consent) root else "",
-    quiet   = quiet
+    quiet   = quiet,
+    error   = error
   )
 
   # Build the article in a separate  process via {callr}

R/build_home.R

@@ -2,7 +2,6 @@ build_home <- function(pkg, quiet, sidebar = NULL, new_setup = TRUE, next_page =
   page_globals <- setup_page_globals()
   path  <- root_path(pkg$src_path)
   syl   <- format_syllabus(get_syllabus(path, questions = TRUE), use_col = FALSE)
-  cfg   <- get_config(path)
   idx      <- fs::path(pkg$src_path, "built", "index.md")
   readme   <- fs::path(pkg$src_path, "built", "README.md")
   idx_file <- if (fs::file_exists(idx)) idx else readme

R/build_markdown.R

@@ -95,13 +95,19 @@ build_markdown <- function(path = ".", rebuild = FALSE, quiet = FALSE, slug = NU
     renv_check_consent(path, quiet, sources)
     build_me <- db$build[needs_building]
     slugs    <- get_slug(build_me)
+    error    <- this_metadata$get()[["fail_on_error"]]
+    error    <- !is.null(error) && !error
+    if (!error && !quiet) {
+      cli::cli_alert_info("{.code fail_on_error: true}. Use {.code error=TRUE} in code chunks for demonstrative errors")
+    }
 
     for (i in seq_along(build_me)) {
       build_episode_md(
         path    = build_me[i],
         outdir  = outdir,
         workdir = outdir,
-        quiet   = quiet
+        quiet   = quiet,
+        error   = error
       )
     }
     handout <- getOption("sandpaper.handout", default = FALSE)

R/utils-callr.R

@@ -1,4 +1,4 @@
-callr_build_episode_md <- function(path, hash, workenv, outpath, workdir, root, quiet) {
+callr_build_episode_md <- function(path, hash, workenv, outpath, workdir, root, quiet, error = TRUE) {
   # Shortcut if the source is a markdown file
   # Taken directly from tools::file_ext
   file_ext <- function (x) {
@@ -28,6 +28,7 @@ callr_build_episode_md <- function(path, hash, workenv, outpath, workdir, root,
   slug <- file_path_sans_ext(basename(outpath))
 
   knitr::opts_chunk$set(
+    error         = error,
     comment       = "",
     fig.align     = "center",
     class.output  = "output",

R/utils-metadata.R

@@ -26,6 +26,7 @@ metadata_url <- function(cfg) {
 initialise_metadata <- function(path = ".") {
   if (length(this_metadata$get()) == 0) {
     cfg <- get_config(path)
+    this_metadata$set(NULL, cfg)
     this_metadata$set("metadata_template", readLines(template_metadata()))
     this_metadata$set("pagetitle", cfg$title)
     this_metadata$set("url", metadata_url(cfg))

tests/testthat/test-build_markdown.R

@@ -68,23 +68,43 @@ test_that("changes in config.yaml triggers a rebuild of the site yaml", {
 })
 
 
-test_that("build_home() will refelct the title in the heading", {
-
-  skip("this was built for the old sandpaper")
-  skip_if_not(rmarkdown::pandoc_available("1.12.3"))
-  pkg <- pkgdown::as_pkgdown(fs::path(res, "site"))
-  fs::dir_create(pkg$dst_path)
-  expect_silent(
-    build_home(pkg, quiet = TRUE, 
-      sidebar = "<a href='index.html'>Home</a>",
-      new_setup = FALSE, 
-      next_page = fs::path(res, "site/built/01-introduction.md")
-    )
-  )
-  idx <- fs::path(pkg$dst_path, "index.html")
-  htm <- xml2::read_html(idx)
-  h1 <- xml2::xml_text(xml2::xml_find_first(htm, ".//h1"))
-  expect_identical(h1, "NEW: Lesson Title")
+test_that("setting `fail_on_error: true` in config will cause build to fail", {
+  old_yaml <- withr::local_tempfile()
+  old_episode <- withr::local_tempfile()
+  suppressMessages(episode <- get_episodes(res, trim = FALSE)[[1]])
+  yaml <- fs::path(res, "config.yaml")
+  fs::file_copy(yaml, old_yaml)
+  fs::file_copy(episode, old_episode)
+  withr::defer({
+    fs::file_copy(old_yaml, yaml, overwrite = TRUE)
+    fs::file_copy(old_episode, episode, overwrite = TRUE)
+  })
+  ep <- pegboard::Episode$new(episode)$confirm_sandpaper()
+  # Adding two errors to the top of the document. The first one will not error
+  # because it has `error = TRUE`, meaning that it will pass.
+  noerr <- "```{r this-will-not-error, error=TRUE}\nstop('hammertime')\n```\n"
+  # The second error will throw an error because it does not have an error=TRUE
+  err <- "```{r this-will-error}\nstop('in the name of love')\n```\n"
+  ep$add_md(err, 1L)
+  ep$add_md(noerr, 1L)
+  ep$write(fs::path(res, "episodes"), format = "Rmd")
+  cat("fail_on_error: true\n", file = yaml, append = TRUE)
+  # Important context for the test: there are two chunks in the top of the
+  # document that will throw errors in this order:
+  #
+  # 1. hammertime
+  # 2. in the name of love
+  # 
+  # The first chunk is allowed to show the error in the document, the second
+  # is not. When we check for the text of the second error, that confirms that
+  # the first error is passed over.
+  suppressMessages({
+    out <- capture.output({
+      build_markdown(res, quiet = FALSE) %>%
+        expect_message("use error=TRUE") %>%
+        expect_error("in the name of love")
+    })
+  })
 })
 
 

tests/testthat/test-utils-metadata.R

@@ -13,9 +13,11 @@ test_that("metadata can be initialised and cleared", {
 
 })
 
-test_that("metadata can be created with custom items", {
+test_that("metadata can be initialised with custom items added ", {
   initialise_metadata(res)
   on.exit(this_metadata$clear())
+  # metadata has same values as config
+  expect_equal(this_metadata$get()[["carpentry"]], "incubator")
   met <- create_metadata_jsonld(res, 
     date = list(created = "2022-02-01", modified = "2022-02-08", published = "2022-02-09"),
     pagetitle = "The Importance of Being Ernest Scared Stupid",