Show off example output on the website.

Change-Id: Ia78a5476a786a8894a75ca0e5b763ab19f492554

1 files changed, 37 insertions, 2 deletions

diff --git a/.guix/run64-website.scm b/.guix/run64-website.scm
index 72ee0fd..95bd701 100644
--- a/.guix/run64-website.scm
+++ b/.guix/run64-website.scm
@@ -1,5 +1,5 @@
 ;;; run64 --- SRFI-64 test runner
-;;; Copyright © 2025 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2025–2026 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of run64.
 ;;;
@@ -17,6 +17,8 @@
 ;;; along with run64.  If not, see <https://www.gnu.org/licenses/>.
 
 (define-module (run64-website)
+  #:use-module ((gnu packages textutils) #:select (aha))
+  #:use-module ((gnu packages guile) #:select (guile-3.0))
   #:use-module ((gnu packages haskell-xyz) #:select (pandoc))
   #:use-module (guix gexp)
   #:use-module (guix packages)
@@ -25,9 +27,42 @@
 (define run64-website-home-page-gexp
   (with-imported-modules '((guix build utils))
     #~(begin
-        (use-modules (guix build utils))
+        (use-modules (guix build utils)
+                     (rnrs base)
+                     (rnrs io ports)
+                     (srfi srfi-11)
+                     (srfi srfi-26)
+                     (ice-9 match)
+                     (ice-9 popen))
+
+        ;; Run run64 on example.scm to produce example-output.html.
+        (set-path-environment-variable "PATH"
+                                       '("bin")
+                                       (list #$aha #$guile-3.0 #$guile-run64))
+        (copy-file #$(file-append (package-source guile-run64)
+                                  "/example.scm")
+                   "example.scm")
+        (let ((commands '(("guile-run64" "example.scm")
+                          ("aha" "--no-header")))
+              (success? (lambda (pid)
+                          (match (waitpid pid)
+                            ((_ . status)
+                             (zero? (status:exit-val status)))))))
+          (let-values (((from to pids) (pipeline commands)))
+            (let ((example-output (get-bytevector-all from)))
+              (match pids
+                ((aha-pid guile-run64-pid)
+                 ;; We only check for the success of aha since guile-run64 is
+                 ;; supposed to fail.
+                 (assert (success? aha-pid))))
+              (close to)
+              (close from)
+              (call-with-output-file "example-output.html"
+                (cut put-bytevector <> example-output)))))
 
         (invoke #$(file-append pandoc "/bin/pandoc")
+                (string-append "--lua-filter="
+                               #$(local-file "../website/insert-example-output.lua"))
                 "--standalone"
                 "--metadata" "title=run64"
                 "--css=style.css"