From 806205382950bf3273d18872987b516f30c3d11f Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sun, 25 Dec 2022 15:58:35 +0000
Subject: web: static: Introduce functional html engine customizer.

* tissue/web/static.scm (engine-custom-set): New function.
(html-engine): New public function.
(gemtext-exporter, skribe-exporter): Use html-engine in default value
of engine.
---
 tissue/web/static.scm | 32 +++++++++++++++++++++++---------
 1 file changed, 23 insertions(+), 9 deletions(-)

(limited to 'tissue')

diff --git a/tissue/web/static.scm b/tissue/web/static.scm
index 38a7d42..587799d 100644
--- a/tissue/web/static.scm
+++ b/tissue/web/static.scm
@@ -40,6 +40,7 @@
             file-writer
             replace-extension
             copier
+            html-engine
             gemtext-reader
             gemtext-exporter
             skribe-exporter
@@ -77,6 +78,25 @@ read from and the output port to write to."
                               get-bytevector-some
                               in))))
 
+(define (engine-custom-set engine key value)
+  "Set custom @var{key} of @var{engine} to @var{value}. This is a purely
+functional setter that operates on a copy of @var{engine}. It does not
+mutate @var{engine}."
+  (let ((clone (copy-engine (engine-ident engine) engine)))
+    (engine-custom-set! clone key value)
+    clone))
+
+(define* (html-engine #:key css)
+  "Return a new HTML engine.
+
+@var{css} is the URI to a CSS stylesheet. If it is @code{#f}, no
+stylesheet is included in the generated web pages."
+  (if css
+      (engine-custom-set (find-engine 'html)
+                         'css
+                         (list css))
+      (find-engine 'html)))
+
 (define (gemtext-reader)
   "Return a skribilo reader for gemtext."
   ((reader:make (lookup-reader 'gemtext))
@@ -84,7 +104,7 @@ read from and the output port to write to."
    #:join-lines? #t))
 
 (define* (gemtext-exporter file #:key (reader (gemtext-reader))
-                           (engine (find-engine 'html)))
+                           (engine (html-engine)))
   "Return a writer function that reads gemtext @var{file} using
 @var{reader} and exports it using @var{engine}."
   (exporter file
@@ -95,7 +115,7 @@ read from and the output port to write to."
                      engine)))))
 
 (define* (skribe-exporter file #:key (reader (make-reader 'skribe))
-                          (engine (find-engine 'html)))
+                          (engine (html-engine)))
   "Return a writer function that reads skribe @var{file} using
 @var{reader} and exports it using @var{engine}."
   (exporter file
@@ -113,21 +133,15 @@ original current directory."
                   thunk
                   (cut chdir previous-current-directory))))
 
-(define* (build-website repository-top-level output-directory css files
+(define* (build-website repository-top-level output-directory files
                         #:key (log-port (current-error-port)))
   "Export git repository with REPOSITORY-TOP-LEVEL to OUTPUT-DIRECTORY
 as a website.
 
-CSS is the path to a CSS stylesheet. If it is #f, no stylesheet is
-included in the generated web pages.
-
 FILES is a list of <file> objects representing files to be written to
 the web output.
 
 Log to LOG-PORT. When LOG-PORT is #f, do not log."
-  ;; Set CSS.
-  (when css
-    (engine-custom-set! (find-engine 'html) 'css css))
   ;; Create output directory.
   (make-directories output-directory)
   ;; Write each of the <file> objects.
-- 
cgit v1.2.3