Apply HTML Validation

Squashed commit of the following:

commit 2e809f9
Author: Brock <[email protected]>
Date:   Fri Apr 4 13:26:34 2025 +0200

    remove debugging change

commit ada57e8
Author: Brock <[email protected]>
Date:   Fri Apr 4 13:20:10 2025 +0200

    don't run html validation on mac or windows

commit ff9b8e4
Author: Brock <[email protected]>
Date:   Fri Apr 4 12:27:04 2025 +0200

    Enable HTML validation server

commit f196a9e
Author: Brock <[email protected]>
Date:   Fri Apr 4 12:13:09 2025 +0200

    Add curl to depends

commit 2e51ef2
Author: Brock <[email protected]>
Date:   Fri Apr 4 12:12:36 2025 +0200

    fixes to validate html function

commit 777f9ec
Author: Brock <[email protected]>
Date:   Thu Apr 3 18:19:45 2025 +0200

    Add API based HTML checking

commit 9e4789e
Author: Brock <[email protected]>
Date:   Thu Apr 3 13:15:16 2025 +0200

    extra tests

Author: katrinabrock

.github/workflows/R-CMD-check.yaml

@@ -66,6 +66,13 @@ jobs:
       actions: read
 
     steps:
+      - name: Start HTML validation server
+        run: |
+          docker run --rm -p 8888:8888 -d ghcr.io/validator/validator:latest &&
+          echo "W3C_MARKUP_VALIDATOR_BASEURL=http://0.0.0.0:8888" >> "$GITHUB_ENV"
+        if: runner.os == 'Linux'
+        shell: bash
+
       - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-r@v2

DESCRIPTION

@@ -73,6 +73,7 @@ Suggests:
     downlit (>= 0.4.0),
     htmlwidgets,
     jsonlite,
+    curl,
     rstudioapi,
     miniUI,
     rsconnect (>= 0.4.3),

tests/rmd/split-section.Rmd

@@ -18,10 +18,16 @@ See chapter 2 now at \@ref(section-2)
 
 # Section 2
 
-## subsection 2 {#sub2}
+## subsection 21 {#sub2}
 
 ```{r iris-plot, fig.cap = "A plot"}
 plot(iris)
 ```
 
 See figure \@ref(fig:iris-plot)
+
+# subsection 22
+
+# Section 3
+
+## subsection 3

tests/test-rmd.R

@@ -1,3 +1,4 @@
+source('./testthat/helper-validate_html.R')
 # only run this when NOT_CRAN is true (e.g., on Travis CI)
 if (Sys.getenv('NOT_CRAN') == 'true') local({
   all_files = function() {
@@ -9,10 +10,21 @@ if (Sys.getenv('NOT_CRAN') == 'true') local({
   for (f in list.files('rmd', '[.]Rmd$', full.names = TRUE)) {
     rmarkdown::render(f, envir = globalenv(), quiet = TRUE)
   }
+ 
+  html_issues = simplify_html_validation(
+    validate_html(list.files("rmd", ".html$", full.names = TRUE))
+  )
+  if(nrow(html_issues) > 0)
+    stop("HTML issues detected in ", paste(html_issues$file, collapse = ', '))
 
   # split by section works correctly
   ## id is used for html file name
-  sections_files = c("section-1.html", "subsection-1.html", "section-2.html", "sub2.html")
+  sections_files = c(
+    "section-1.html", "subsection-1.html",
+    "section-2.html", "sub2.html", "subsection-22.html",
+    "section-3.html", "subsection-3.html"
+  )
+
   if (any(!file.exists(file.path("rmd", sections_files))))
     stop("Failed to generate sections files")
   ## reference is working correctly (see #787)

tests/testthat/helper-validate_html.R

@@ -0,0 +1,39 @@
+validate_html <- function(
+  files,
+  # using same env variable old package to keep some compatibility
+  base_url = Sys.getenv('W3C_MARKUP_VALIDATOR_BASEURL')
+) {
+  if(base_url == '' || length(files) == 0) return(NULL)
+  lapply(files, function(file) {
+    h <- curl::new_handle()
+    curl::handle_setform(handle = h, out = 'json', file = curl::form_file(file, "text/html"))
+    jsonlite::fromJSON(rawToChar(
+      curl::curl_fetch_memory(base_url, h)$content
+    ))
+  })
+}
+
+simplify_html_validation <- function(results) {
+  if(is.null(results) || length(results) == 0) return(
+    data.frame(file=character(0), messages=character(0))
+  )
+  expected_errors <- c(
+    "Attribute “number” not allowed on element “div” at this point.",
+    "CSS: “border-top”: “solid\\9” is not a “color” value.",
+    "CSS: “border-bottom”: “solid\\9” is not a “color” value."
+    
+  )
+  do.call(rbind, lapply(results,
+    function(result) {
+      if(is.null(result)) return(
+        data.frame(file=character(0), messages=character(0))
+      )
+      messages <- result$messages$message[result$messages$type == 'error']
+      messages <- messages[!messages %in% expected_errors]
+      data.frame(
+        file = if (length(messages) > 0) result$url else character(0),
+        messages = messages
+      )
+    }
+  ))
+}