From 59598f42c16cf12e544e5bf2ce9c873fba94238e Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Wed, 6 Sep 2023 22:45:45 -0500
Subject: A newerer beginning

---
 boudin.scm | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 63 insertions(+), 8 deletions(-)

(limited to 'boudin.scm')

diff --git a/boudin.scm b/boudin.scm
index 7bd741d..4f6a1b3 100644
--- a/boudin.scm
+++ b/boudin.scm
@@ -1,14 +1,69 @@
-;;; (boudin) --- A small tasty ssg
+;;; boudin
 
-(import (boudin))
+(import (boudin page)
+        (boudin page instances)
+        (boudin page write)
+        (boudin site)
+        (boudin util)
+        (chicken file)
+        (chicken pathname)
+        (chicken process-context))
 
-(define foo (render-string "#,hello from Boudin!"
-                           (interaction-environment)))
+(define site-posts
+  (make-parameter '()))
 
-(define (main . args)
-  (print foo)
-  (for-each print args))
+(define site-files
+  (make-parameter '()))
+
+(define (copy-static file)
+  (copy-file file (pathname-replace-directory file (site-dest))))
+
+(define (with-progress message thunk)
+  (edisplay message)
+  (edisplay "...")
+  (thunk)
+  (eprint "Ok."))
+
+(define (go!)
+  (eprint "Building " (site-name) "...")
+  (when (file-exists? (site-config))
+    (with-progress (string-append "Config found, loading: " (site-config))
+                   (lambda () (load (site-config)))))
+  (for-each (lambda (f)
+              (with-progress (string-append "Copying " f " to " (site-output))
+                             (lambda () (copy-static f)))) (site-files))
+  (let ((posts (map make-post (site-posts))))
+    (for-each (lambda (pg)
+                (with-progress (string-append "Writing " (page-output pg))
+                               (lambda () (write-page pg))))
+              (append posts
+                      (list (make-index posts)
+                            (make-feed posts)))))
+  (eprint "Done!"))
+
+(define (main args)
+  (define *current #f)
+  (let loop ((args args))
+    (cond
+     ((null? args) (go!))
+     ((equal? (car args) "-c")
+      (site-config (cadr args))
+      (loop (cddr args)))
+     ((not *current)                    ; add to posts by default
+      (site-posts (cons (car args) (site-posts)))
+      (loop (cdr args)))
+     ((equal? (car args) "-p")
+      (set! *current site-posts)
+      (loop (cdr args)))
+     ((equal? (car args) "-f")
+      (set! *current site-files)
+      (loop (cdr args)))
+     (else
+      (*current (cons (car args) (*current)))
+      (loop (cdr args))))))
 
 (cond-expand
-  (compiling (apply main (command-line)))
+  ((or chicken-script compiling)
+   (import (chicken process-context))
+   (main (command-line-arguments)))
   (else))
-- 
cgit 1.4.1-21-gabe81