Merge pull request #643 from carpentries/issue_642

Add better episode yaml frontmatter checking

Author: froggleston

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sandpaper
 Title: Create and Curate Carpentries Lessons
-Version: 0.16.11
+Version: 0.16.12.9000
 Authors@R: c(
     person(given = "Robert",
            family = "Davey",
@@ -93,7 +93,8 @@ Imports:
     callr,
     servr,
     utils,
-    tools
+    tools,
+    R.utils
 Suggests:
     testthat (>= 3.0.0),
     covr,

R/utils-yaml.R

@@ -1,7 +1,9 @@
 # Query only the yaml header. This is faster than slurping the entire file...
 # useful for determining timings :)
 politely_get_yaml <- function(path) {
+  file_len <- R.utils::countLines(path)
   header <- readLines(path, n = 10, encoding = "UTF-8")
+
   barriers <- grep("^---$", header)
   if (length(barriers) == 0) {
     # we don't need to warn if they are scanning an index.md with no yaml
@@ -12,10 +14,17 @@ politely_get_yaml <- function(path) {
     }
     return(character(0))
   }
+
+  # got at least one YAML header in the first 10 lines so check that the first line of a lesson is header open
+  if (barriers[1] != 1) {
+    cli::cli_alert_danger("First line is invalid - [expected ---, got {header[1]}] - in episode {path}")
+    return(character(0))
+  }
+
   if (length(barriers) == 1) {
     to_skip <- 10L
     next_ten <- vector(mode = "character", length = 10)
-    while (length(barriers) < 2) {
+    while (length(barriers) < 2 && to_skip < file_len) {
       next_ten <- scan(
         path,
         what = character(),
@@ -32,7 +41,31 @@ politely_get_yaml <- function(path) {
       to_skip <- to_skip + 10L
     }
   }
-  return(header[barriers[1]:barriers[2]])
+
+  # validate at the end of scanning
+  if (is.na(barriers[1]) || is.na(barriers[2]) || barriers[2] <= barriers[1]) {
+    cli::cli_alert_danger("Cannot find valid open and close of YAML frontmatter in episode {path}")
+    return(character(0))
+  }
+
+  # if the second line is blank
+  if (header[1] == "---" && header[2] == "") {
+    cli::cli_alert_danger("Blank line after first YAML block line in episode {path}")
+    return(character(0))
+  }
+
+  header <- header[barriers[1]:barriers[2]]
+
+  # actually validate the final header
+  yaml_header <- paste(header, collapse = "\n")
+  tryCatch({
+    yaml::yaml.load(yaml_header)
+  }, error = function(e) {
+    cli::cli_alert_danger("YAML header is invalid in episode {path}")
+    return(character(0))
+  })
+
+  return(header)
 }
 
 siQuote <- function(string) {

tests/testthat/test-utils-yaml.R

@@ -17,11 +17,24 @@ test_that("siQuote works for normally escaped strings", {
 })
 
 cli::test_that_cli("polite yaml throws a message when there is no yaml", {
-  
+
   withr::local_file(tmp <- tempfile())
+  cat("A malformed YAML header\n---\n", file = tmp)
+  expect_message(politely_get_yaml(tmp), "First line is invalid")
+
+  cat("foo---\nAnother malformed YAML header\n---\n", file = tmp)
+  expect_message(politely_get_yaml(tmp), "First line is invalid")
+
+  cat("---\nYet another malformed YAML header\n# Start of markdown\n\nFoo bar baz\n", file = tmp)
+  expect_message(politely_get_yaml(tmp), "Cannot find valid open and close of YAML frontmatter")
+
+  cat("---\n\nA malformed YAML block\n---\n", file = tmp)
+  expect_message(politely_get_yaml(tmp), "Blank line after first YAML block line")
+
   cat("# A header\n\nbut no yaml :/\n", file = tmp)
   expect_message(politely_get_yaml(tmp), "No yaml header found in the first 10 lines")
 
+
 })
 
 
@@ -30,27 +43,27 @@ test_that("polite yaml works", {
 yaml <- "---
 a: |
   this
-  
-  
+
+
   is some
-   
-   
-   
-   
-    
-    
-    
-    
+
+
+
+
+
+
+
+
    poetry?
-   
-   
-   
-   
-   
-   
-   
-   
-   
+
+
+
+
+
+
+
+
+
 b: is it?
 ---
 
@@ -72,7 +85,7 @@ This is not poetry
 
 
 test_that("yaml_list() processes nested lists", {
-  
+
   x <- letters[1:3]
   nester <- list(b = x, a = list(hello = x, jello = as.list(setNames(x, rev(x)))))
   expect_snapshot_output(writeLines(yaml_list(nester)))