about summary refs log tree commit diff
diff options
context:
space:
mode:
authorArun Isaac2026-03-16 23:00:16 +0000
committerArun Isaac2026-03-17 00:23:39 +0000
commit18f2033852f4888af498394e184b1cb498f08956 (patch)
treea2ffc1939c83be593849773682953094f975eb13
parent7a86d1bef0758691cc9ca708d59b272d173fee84 (diff)
downloadrun64-18f2033852f4888af498394e184b1cb498f08956.tar.gz
run64-18f2033852f4888af498394e184b1cb498f08956.tar.lz
run64-18f2033852f4888af498394e184b1cb498f08956.zip
Show off example output on the website.
Change-Id: Ia78a5476a786a8894a75ca0e5b763ab19f492554
-rw-r--r--.guix/run64-website.scm39
-rw-r--r--example.scm45
-rw-r--r--website/insert-example-output.lua11
-rw-r--r--website/style.css7
4 files changed, 100 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"
diff --git a/example.scm b/example.scm
new file mode 100644
index 0000000..beb0fda
--- /dev/null
+++ b/example.scm
@@ -0,0 +1,45 @@
+(test-begin "arithmetic")
+
+(test-equal "addition" 4 (+ 2 2))
+(test-equal "subtraction" 0 (- 5 5))
+(test-equal "multiplication" 12 (* 3 4))
+(test-equal "division" 5 (/ 10 2))
+
+(test-end "arithmetic")
+
+(test-begin "strings")
+
+(test-equal "concatenation"
+  "hello world"
+  (string-append "hello" " " "world"))
+
+(test-equal "length"
+  5
+  (string-length "hello"))
+
+(test-equal "case conversion"
+  "HELLO"
+  (string-upcase "hello"))
+
+(test-end "strings")
+
+(test-begin "lists")
+
+(test-equal "append"
+  '(1 2 3 4)
+  (append '(1 2) '(3 4)))
+
+(test-equal "reverse"
+  '(3 2 1)
+  (reverse '(1 2 3)))
+
+(test-equal "map"
+  '(2 4 6)
+  (map (lambda (x) (* x 2))
+       '(1 2 3)))
+
+(test-equal "wrong result"
+  '(a b c d)
+  '(a x c y))
+
+(test-end "lists")
diff --git a/website/insert-example-output.lua b/website/insert-example-output.lua
new file mode 100644
index 0000000..42639cc
--- /dev/null
+++ b/website/insert-example-output.lua
@@ -0,0 +1,11 @@
+function Header(element)
+   if element.level == 1 and element.attr.identifier == "motivation" then
+      io.input("example-output.html")
+      return {pandoc.RawBlock(
+                 "html",
+                 "<pre id=\"example-output\">"..io.read("*all").."</pre>"),
+              element}
+   else
+      return element
+   end
+end
diff --git a/website/style.css b/website/style.css
index 2ab3b0c..9dd2e29 100644
--- a/website/style.css
+++ b/website/style.css
@@ -22,3 +22,10 @@ code {
 img {
     max-width: 100%;
 }
+
+#example-output {
+    color: white;
+    background-color: black;
+    font-size: smaller;
+    max-width: 400px;
+}