13 files changed, 289 insertions, 172 deletions

@@ -6,4 +6,5 @@ boudin
 *.import.scm
 *.types
 *.build.sh
-*.install.sh
\ No newline at end of file
+*.install.sh
+test/out/
\ No newline at end of file
@@ -10,7 +10,8 @@ install:
 
 .PHONY: test
 test: build
-        cd test; ../boudin *.html && (cd out; python -m http.server)
+        ./boudin -C test '*.html'
+        cock test/out # my own little server
 
 .PHONY: clean
 clean:
@@ -1,34 +1,44 @@
 ;;; boudin
 
-((synopsis "a small, tasty ssg.")
+((synopsis "a tiny, tasty ssg.")
  (author "Case Duckworth")
  (license "God Willing")
- (version "0.1.1")
+ (version 1728)
+ (build-dependencies module-declarations)
  (dependencies atom
                html-parser
-               module-declarations
                schmaltz
                srfi-1
                srfi-152
                sxml-serializer
+               scss
                utf8)
  (component-options
-  (csc-options -X module-declarations -X utf8))
+  (csc-options -X module-declarations -X utf8
+               -O2 -d1))
  (components
   (program boudin
            (component-dependencies boudin.page
-                                   boudin.page.instances
+                                   boudin.page.index
+                                   boudin.page.post
+                                   boudin.page.style
                                    boudin.page.write
                                    boudin.site
                                    boudin.util))
   (extension boudin.page
              (component-dependencies boudin.site
                                      boudin.util))
-  (extension boudin.page.instances
+  (extension boudin.page.index
+             (component-dependencies boudin.page
+                                     boudin.page.write
+                                     boudin.site))
+  (extension boudin.page.post
              (component-dependencies boudin.page
                                      boudin.page.write
                                      boudin.site
                                      boudin.util))
+  (extension boudin.page.style
+             (component-dependencies boudin.page))
   (extension boudin.page.write
              (component-dependencies boudin.page
                                      boudin.site))
@@ -0,0 +1,95 @@
+(declare (module (boudin page index))
+         (export make-index
+                 index-template
+                 index-writer
+                 make-feed
+                 feed-template
+                 feed-writer))
+
+(import (boudin page)
+        (boudin page write)
+        (boudin site)
+        (chicken pathname)
+        (html-parser)
+        (sxml-serializer)
+        (rename (atom)
+                (make-feed atom/make-feed)))
+
+(define (make-index pgs)
+  (make-page ((index-template) pgs)
+             (make-pathname (site-output) "index.html")
+             page-content
+             (index-writer)
+             `()))
+
+(define index-writer
+  (make-parameter
+   sxml-display-as-html))
+
+(define index-template
+  (make-parameter
+   (lambda (pgs)
+     `(html (@ (lang "en-us"))
+            (head ,@(html-head)
+                  (title ,(site-name)))
+            (body (h1 ,(site-name))
+                  (ul ,@(map (lambda (pg)
+                               `(li (a (@ (href ,(page-slug pg)))
+                                       ,(or (page-ref pg "title")
+                                            (page-slug pg)))))
+                             ((site-sort) pgs))))))))
+
+(define (make-feed pgs)
+  (make-page ((feed-template) pgs)
+             (make-pathname (site-output) "feed.xml")
+             page-content
+             (feed-writer)
+             `()))
+
+(define feed-writer
+  (make-parameter
+   (lambda (sxml)
+     (serialize-sxml sxml
+                     output: (current-output-port)
+                     cdata-section-elements: '(atom:content)
+                     ns-prefixes:
+                     `((*default* . "http://www.w3.org/2005/Atom")
+                       (*default* . "http://www.w3.org/1999/xhtml")
+                       ,@(atom-ns-prefixes))
+                     allow-prefix-redeclarations: #t))))
+
+(define feed-template
+  (make-parameter
+   (lambda (pgs)
+     (make-atom-doc
+      (atom/make-feed
+       title: (make-title (site-name))
+       id: (site-host)
+       updated: (site-build-time)
+       authors: (list (make-author name: (site-author)
+                                   uri: (site-host)))
+       links: (list (make-link type: 'html
+                               uri-language: "en"
+                               uri: (site-host))
+                    (make-link relation: "self"
+                               type: "application/atom+xml"
+                               uri: (make-pathname
+                                     (site-host) "feed" "xml")))
+       rights: (make-rights (force (site-rights)))
+       generator: (make-generator "Boudin"
+                                  uri: "https://git.acdw.net/boudin"
+                                  version: "rice")
+       entries: (map (lambda (pg)
+                       (make-entry
+                        title: (make-title
+                                (or (page-ref pg "title") "[untitled]"))
+                        links: (list (make-link type: 'html
+                                                uri: (page-url pg)))
+                        id: (page-url pg)
+                        updated: (page-updated pg)
+                        ;;published:
+                        content: (make-content
+                                  (sxml->html
+                                   (page-content pg))
+                                  type: 'html)))
+                     ((site-sort) pgs)))))))
@@ -0,0 +1,77 @@
+(declare (module (boudin page post))
+         (export make-post
+                 post-path-transformers
+                 post-text-transformers
+                 post-template
+                 post-writer))
+
+(import (boudin page)
+        (boudin page write)
+        (boudin site)
+        (boudin util)
+        (chicken pathname)
+        (html-parser)
+        (except (schmaltz)
+                render-specials
+                render-unprintables)
+        (schmaltz chicken)
+        (srfi 152))
+
+(define (make-post path)
+  (let ((sxml ((apply o (post-text-transformers))
+               (with-input-from-file path slurp))))
+    (make-page sxml
+               ((apply o (post-path-transformers)) path)
+               (post-template)
+               (post-writer)
+               (cons (cons "source" path)
+                     (*extract-metadata sxml)))))
+
+(define (*extract-metadata sxml)
+  (let loop ((tree sxml)
+             (acc '()))
+    (cond
+     ((not (pair? tree))
+      (reverse acc))
+     ((and (list? (car tree))
+           (eq? (caar tree) '*COMMENT*))
+      (loop (cdr tree)
+            (map (lambda (ln)
+                   (let ((kv (string-split ln ":" 'infix 1)))
+                     (cons (string-trim-both (car kv))
+                           (string-trim (cdr kv)))))
+                 (string-split (cadar tree) "\n"))))
+     ((list? (car tree))
+      (loop (cdr tree)
+            (let ((subtree (loop (car tree) '())))
+              (if (null? subtree)
+                  acc
+                  (cons subtree acc)))))
+     (else (loop (cdr tree) acc)))))
+
+(define post-text-transformers
+  (make-parameter
+   (list html->sxml
+         wrap-paragraphs
+         render-string->string)))
+
+(define post-path-transformers
+  (make-parameter
+   (list (lambda (path)
+           (make-pathname (list (site-output)
+                                (pathname-strip-extension path))
+                          "index.html")))))
+
+(define post-template
+  (make-parameter
+   (lambda (pg)
+     (let ((title (page-ref pg "title")))
+       `(html (@ (lang "en-us"))
+              (head ,@(html-head)
+                    (title ,(or title "[untitled]")))
+              (body ,(if title `(h1 ,title) "")
+                    ,@(cdr (page-content pg))))))))
+
+(define post-writer
+  (make-parameter
+   sxml-display-as-html))
@@ -1,24 +1,16 @@
 (declare (module (boudin page))
-         (export make-page
-                 page-content
-                 page-meta
-                 page-meta-set!
-                 page-output
-                 page-ref
-                 page-set!
-                 page-slug
-                 page-template
-                 page-updated
-                 page-url
-                 page-writer
-                 page?)
-         (import (boudin site)
-                 (boudin util)
-                 (chicken file posix)
-                 (chicken file)
-                 (chicken pathname)
-                 (chicken time posix)
-                 (srfi 1)))
+         (export make-page page?
+                 page-content page-output page-template page-writer
+                 page-meta page-meta-set! page-ref page-set!
+                 page-slug page-updated page-url))
+
+(import (boudin site)
+        (boudin util)
+        (chicken file posix)
+        (chicken file)
+        (chicken pathname)
+        (chicken time posix)
+        (srfi 1))
 
 (define-record-type page
   (make-page content output template writer meta)
@@ -0,0 +1,47 @@
+(declare (module (boudin page style))
+         (export make-style
+                 style
+                 page-style
+                 style-template
+                 site-style
+                 style-writer))
+
+(import (boudin page)
+        (boudin site)
+        (scss)
+        (html-parser)
+        (srfi 152)
+        (chicken pathname))
+
+(define (make-style . rules)
+  (make-page rules
+             (make-pathname (site-output) "style.css")
+             (style-template)
+             (style-writer)
+             '()))
+
+(define (style props)
+  ;; sxml: `(el (@ ,(style '((padding 3em) (color red)))) content ...)
+  (let ((sty (scss->css `(css+ (_ ,@props)))))
+    (list 'style
+          (substring sty 4 (- (string-length sty) 2)))))
+
+(define (page-style . rules)
+  ;; sxml: `(html (head ,(page-style '(body (margin auto)))))
+  `(style ,(scss->css `(css+ ,@rules))))
+
+(define style-template
+  (make-parameter
+   (lambda (pg)
+     `(css+ ,@(page-content pg)))))
+
+(define site-style
+  (make-parameter
+   '((body (font 18px/1.4 sans-serif)
+           (max-width 70ch)
+           (padding 2ch)
+           (margin 0 auto)))))
+
+(define style-writer
+  (make-parameter
+   write-css))
@@ -1,20 +1,10 @@
 (declare (module (boudin page write))
-         (export feed-template
-                 feed-writer
-                 html-head
-                 index-template
-                 index-writer
-                 post-template
-                 post-writer
+         (export html-head
                  write-page))
 
-(import (atom)
-        (boudin page)
-        (boudin site)
+(import (boudin page)
         (chicken file)
-        (chicken pathname)
-        (html-parser)
-        (sxml-serializer))
+        (chicken pathname))
 
 (define (write-page pg)
   (let ((outfile (page-output pg)))
@@ -22,9 +12,9 @@
                       'parents)
     (with-output-to-file outfile
       (lambda ()
-        ((page-writer pg)
-         ((page-template pg)
-          pg))))))
+        ((o (page-writer pg)
+            (page-template pg))
+         pg)))))
 
 (define html-head
   (make-parameter
@@ -33,82 +23,3 @@
               (content "initial-scale=1.0")))
      (link (@ (href "/style.css")
               (rel "stylesheet"))))))
-
-(define post-writer
-  (make-parameter
-   sxml-display-as-html))
-
-(define post-template
-  (make-parameter
-   (lambda (pg)
-     (let ((title (page-ref pg "title")))
-       `(html (@ (lang "en-us"))
-              (head ,@(html-head)
-                    (title ,(or title "[untitled]")))
-              (body ,(if title `(h1 ,title) "")
-                    ,@(cdr (page-content pg))))))))
-
-(define index-writer
-  (make-parameter
-   sxml-display-as-html))
-
-(define index-template
-  (make-parameter
-   (lambda (pgs)
-     `(html (@ (lang "en-us"))
-            (head ,@(html-head)
-                  (title ,(site-name)))
-            (body (h1 ,(site-name))
-                  (ul ,@(map (lambda (pg)
-                               `(li (a (@ (href ,(page-slug pg)))
-                                       ,(or (page-ref pg "title")
-                                            (page-slug pg)))))
-                             ((site-sort) pgs))))))))
-
-(define feed-writer
-  (make-parameter
-   (lambda (sxml)
-     (serialize-sxml sxml
-                     output: (current-output-port)
-                     cdata-section-elements: '(atom:content)
-                     ns-prefixes:
-                     `((*default* . "http://www.w3.org/2005/Atom")
-                       (*default* . "http://www.w3.org/1999/xhtml")
-                       ,@(atom-ns-prefixes))
-                     allow-prefix-redeclarations: #t))))
-
-(define feed-template
-  (make-parameter
-   (lambda (pgs)
-     (make-atom-doc
-      (make-feed
-       title: (make-title (site-name))
-       id: (site-host)
-       updated: (site-build-time)
-       authors: (list (make-author name: (site-author)
-                                   uri: (site-host)))
-       links: (list (make-link type: 'html
-                               uri-language: "en"
-                               uri: (site-host))
-                    (make-link relation: "self"
-                               type: "application/atom+xml"
-                               uri: (make-pathname
-                                     (site-host) "feed" "xml")))
-       rights: (make-rights (force (site-rights)))
-       generator: (make-generator "Boudin"
-                                  uri: "https://git.acdw.net/boudin"
-                                  version: "rice")
-       entries: (map (lambda (pg)
-                       (make-entry
-                        title: (make-title
-                                (or (page-ref pg "title") "[untitled]"))
-                        links: (list (make-link type: 'html
-                                                uri: (page-url pg)))
-                        id: (page-url pg)
-                        updated: (page-updated pg)
-                        ;;published:
-                        content: (make-content
-                                  (sxml->html
-                                   (page-content pg))
-                                  type: 'html)))
-                     ((site-sort) pgs)))))))
@@ -1,7 +1,9 @@
 ;;; boudin
 
 (import (boudin page)
-        (boudin page instances)
+        (boudin page post)
+        (boudin page index)
+        (boudin page style)
         (boudin page write)
         (boudin site)
         (boudin util)
@@ -37,29 +39,46 @@
                 (with-progress (string-append "Writing " (page-output pg))
                                (lambda () (write-page pg))))
               (append posts
-                      (list (make-index posts)
+                      (list (apply make-style (site-style))
+                            (make-index posts)
                             (make-feed posts)))))
   (eprint "Done!"))
 
 (define (main args)
   (define *current #f)
+  (define glob? #t)
+  (when (null? args)
+    (exit 1))
   (let loop ((args args))
     (cond
-     ((null? args) (go!))
+     ((null? args)
+      (for-each print (site-posts))
+      (go!))
+     ;; Configuration file: -c FILE
      ((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)))
+     ;; Change directory: -C DIRECTORY
+     ((equal? (car args) "-C")
+      (change-directory (cadr args))
+      (loop (cddr args)))
+     ;; Don't glob filenames: -r (raw)
+     ((equal? (car args) "-r")
+      (set! glob? #f)
       (loop (cdr args)))
+     ;; Posts follow -p
      ((equal? (car args) "-p")
       (set! *current site-posts)
       (loop (cdr args)))
+     ;; Files follow -f
      ((equal? (car args) "-f")
       (set! *current site-files)
       (loop (cdr args)))
+     ;; Append current path to *current
      (else
-      (*current (cons (car args) (*current)))
+      (let ((*current (or *current site-posts))) ; posts by default
+        (*current (append ((if glob? glob list) (car args))
+                          (*current))))
       (loop (cdr args))))))
 
 (cond-expand
@@ -5,17 +5,16 @@
                  edisplay
                  eprint))
 
-(import (srfi 1)
+(import (chicken io)
+        (srfi 1)
         (srfi 152))
 
 (define (edisplay x)
-  (parameterize ((current-output-port (current-error-port)))
-    (display x)))
+  (display x (current-error-port)))
 
 (define (eprint . xs)
-  (parameterize ((current-output-port (current-error-port)))
-    (for-each display xs)
-    (newline)))
+  (for-each edisplay xs)
+  (newline (current-error-port)))
 
 (define (assoc-ref k alist)
   (let ((k/v (and (pair? alist)
@@ -60,9 +59,5 @@
   (case-lambda
     (() (slurp (current-input-port)))
     ((port)
-     (let loop ((ch (read-char port))
-                (acc '()))
-       (if (eof-object? ch)
-           (list->string (reverse acc))
-           (loop (read-char port)
-                 (cons ch acc)))))))
+     (read-string #f port)              ; CHICKEN-ism
+     )))
@@ -1,25 +0,0 @@
-<?xml version="1.0" encoding="utf-8"?>
-<feed xmlns="http://www.w3.org/2005/Atom">
-  <author>
-    <name>nobody</name>
-    <uri>example.com</uri>
-  </author>
-  <generator uri="https://git.acdw.net/boudin" version="rice">Boudin</generator>
-  <id>example.com</id>
-  <link href="example.com" rel="alternate" type="text/html" hreflang="en" />
-  <link href="example.com/feed.xml" rel="self" type="application/atom+xml" />
-  <rights type="text">(C) nobody</rights>
-  <title type="text">a boudin site</title>
-  <updated>2023-09-07T03:42:00Z</updated>
-  <entry>
-    <content type="html"><![CDATA[<p>a test file
-</p>
-<p>3
-</p>
-]]></content>
-    <id>https:/example.com/foo/index.html</id>
-    <title type="text">[untitled]</title>
-    <updated>Wed Sep  6 04:59:10 2023</updated>
-    <link href="https:/example.com/foo/index.html" rel="alternate" type="text/html" />
-  </entry>
-</feed>
\ No newline at end of file
@@ -1,5 +0,0 @@
-<html lang="en-us"><head><meta charset="utf-8"></meta><meta name="viewport" content="initial-scale=1.0"></meta><link href="/style.css" rel="stylesheet"></link><title>[untitled]</title></head><body><p>a test file
-</p>
-<p>3
-</p>
-</body></html>
\ No newline at end of file
@@ -1 +0,0 @@
-<html lang="en-us"><head><meta charset="utf-8"></meta><meta name="viewport" content="initial-scale=1.0"></meta><link href="/style.css" rel="stylesheet"></link><title>a boudin site</title></head><body><h1>a boudin site</h1><ul><li><a href="/foo/">/foo/</a></li></ul></body></html>
\ No newline at end of file