From c8d0fdbfdfaba2e9cab3aa7d3ab7920e317d3735 Mon Sep 17 00:00:00 2001
From: Florian Pelz <address@hidden>
Date: Mon, 5 Feb 2018 13:08:14 +0100
Subject: [PATCH 1/2] page: Allow for creating multiple files as variants for
 each page.
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="------------2.16.1"

This is a multi-part message in MIME format.
--------------2.16.1
Content-Type: text/plain; charset=UTF-8; format=fixed
Content-Transfer-Encoding: 8bit


* haunt/page.scm: Adapt write-page to optionally build multiple
                  variants and add helper function to transform file
                  names.
---
 haunt/page.scm | 40 +++++++++++++++++++++++++++++++++++++---
 1 file changed, 37 insertions(+), 3 deletions(-)


--------------2.16.1
Content-Type: text/x-patch; name="0001-page-Allow-for-creating-multiple-files-as-variants-f.patch"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="0001-page-Allow-for-creating-multiple-files-as-variants-f.patch"

diff --git a/haunt/page.scm b/haunt/page.scm
index 85b2ae6..796ad24 100644
--- a/haunt/page.scm
+++ b/haunt/page.scm
@@ -32,6 +32,7 @@
             page-file-name
             page-contents
             page-writer
+            variant->file-name
             write-page))
 
 (define-record-type <page>
@@ -41,10 +42,43 @@
   (contents page-contents)
   (writer page-writer))
 
-(define (write-page page output-directory)
-  "Write PAGE to OUTPUT-DIRECTORY."
+(define (variant->file-name variant base-file-name)
+  (let ((variant-as-text
+         (with-output-to-string
+           (lambda ()
+             (display variant))))
+        (period-index
+         (string-rindex base-file-name #\.)))
+    (if period-index
+        (string-append
+         (string-take base-file-name
+                      period-index)
+         "."
+         variant-as-text
+         "."
+         (string-drop base-file-name
+                      (1+ period-index)))
+        (string-append
+         base-file-name
+         "."
+         variant-as-text))))
+
+(define* (write-page page output-directory
+                     #:optional
+                     variants
+                     (variant-file-name-transformer
+                      variant->file-name))
+  "Write PAGE to OUTPUT-DIRECTORY.  If VARIANTS are given, the page
+contents may be a procedure that given a page variant returns SHTML.
+Otherwise the page contents must be SHTML."
   (match page
     (($ <page> file-name contents writer)
      (let ((output (string-append output-directory "/" file-name)))
        (mkdir-p (dirname output))
-       (call-with-output-file output (cut writer contents <>))))))
+       (if (and variants (not (null? variants)) (procedure? contents))
+           (for-each
+            (lambda (variant)
+              (call-with-output-file output
+                (cut writer (contents variant) <>)))
+            variants)
+           (call-with-output-file output (cut writer contents <>)))))))

--------------2.16.1--