From 4a30c23a339278947db0cebbf26c80ce1585e561 Mon Sep 17 00:00:00 2001
From: Florian Pelz
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 | 50 +++++++++++++++++++++++++++++++++++++++++++++-----
1 file changed, 45 insertions(+), 5 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..1dfb123 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
@@ -41,10 +42,49 @@
(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-namer 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 what
+data to write. Otherwise the page contents must be the data to
+write."
+ (define (write-content-variant content-variant file-name)
+ (let ((output (string-append output-directory "/" file-name)))
+ (mkdir-p (dirname output))
+ (call-with-output-file output
+ (cut writer content-variant <>))))
(match 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)
+ (let ((name (variant-namer variant file-name))
+ (content-variant (contents variant)))
+ (when content-variant
+ (format #t " variant '~a'~%" name)
+ (write-contents content-variant name))))
+ variants)
+ (write-contents contents file-name)))))
--------------2.16.1--