diff --git a/report b/report
new file mode 100755
index 0000000..248c103
--- /dev/null
+++ b/report
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+mkdir -p reports
+gosh -r7 -I . -I ./snow report.scm reports/*.log
+
+
diff --git a/report.scm b/report.scm
new file mode 100644
index 0000000..24a4abf
--- /dev/null
+++ b/report.scm
@@ -0,0 +1,94 @@
+(import (scheme base)
+ (scheme write)
+ (scheme file)
+ (scheme char)
+ (scheme process-context)
+ (scheme file)
+ (arvyy mustache))
+
+(include "util.scm")
+(include "implementations.scm")
+(include "tests.scm")
+
+(define report-top (compile (slurp "templates/Report-top")))
+(define report-row (compile (slurp "templates/Report-row")))
+(define report-bottom (compile (slurp "templates/Report-bottom")))
+
+(define logfiles (list-tail (command-line) 1))
+
+
+
+(call-with-output-file
+ "reports/results.html"
+ (lambda (out)
+ (execute report-top `() out)
+ (display "
" out)
+ (newline out)
+ (display "Test | " out)
+ (for-each
+ (lambda (implementation)
+ (display (string-append "" (symbol->string (cdr (assoc 'name implementation))) " | ") out)
+ (newline out))
+ implementations)
+ (display "
" out)
+ (newline out)
+ (newline out)
+ (for-each
+ (lambda (test)
+ (let ((test-name (symbol->string (cdr (assoc 'name test))))
+ (name (symbol->string (cdr (assoc 'name implementation)))))
+ (display (string-append "") out)
+ (newline out)
+ (display (string-append "" test-name " | ") out)
+ (newline out)
+ (for-each
+ (lambda (implementation)
+ (letrec* ((name (cdr (assoc 'name implementation)))
+ (command (cdr (assoc 'command implementation)))
+ (logfile (string-append "reports/"
+ name
+ "-"
+ test-name
+ ".log"))
+ (read-results (lambda (line results)
+ (if (eof-object? line)
+ results
+ (read-results (read-line)
+ (if (string-starts-with? line "# of")
+ (begin
+ (append results
+ (list (number-of-line->number line))))
+ results)))))
+ (results (if (not (file-exists? logfile))
+ (list "" "" "" "")
+ (with-input-from-file
+ logfile
+ (lambda ()
+ (read-results (read-line) (list))))))
+ (expected-passes (if (> (length results) 0) (list-ref results 0) 0))
+ (expected-failures (if (> (length results) 1) (list-ref results 1) 0))
+ (unexpected-failures (if (> (length results) 2) (list-ref results 2) 0))
+ (skipped-tests (if (> (length results) 3) (list-ref results 3) 0))
+ (color (cond ((string? expected-passes) "white") ; No logfile
+ ((> unexpected-failures 0) "red")
+ ((> skipped-tests 0) "yellow")
+ (else "green"))))
+ (execute report-row
+ `((name . ,name)
+ (command . ,command)
+ (color . ,color)
+ (library-command . ,(if (assoc 'library-command implementation)
+ (cdr (assoc 'library-command implementation))
+ #f))
+ (name . ,name)
+ (expected-passes . ,expected-passes)
+ (expected-failures . ,expected-failures)
+ (unexpected-failures . ,unexpected-failures)
+ (skipped-tests . ,skipped-tests))
+ out)
+ (newline out)))
+ implementations)
+ (display (string-append "
") out)))
+ tests)
+ (execute report-bottom '() out)
+ (newline out)))