A new start (again)

14 files changed, 379 insertions, 561 deletions

@@ -0,0 +1,4 @@
+;;; Directory Local Variables            -*- no-byte-compile: t -*-
+;;; For more information see (info "(emacs) Directory Variables")
+
+((scheme-mode . ((geiser-scheme-implementation . chicken))))
@@ -1,3 +1,9 @@
 boudin
-*.sh
-out
\ No newline at end of file
+*.inline
+*.link
+*.so
+*.o
+*.import.scm
+*.types
+*.build.sh
+*.install.sh
\ No newline at end of file
@@ -0,0 +1,4 @@
+;; -*- scheme -*-
+(import (beaker system))
+
+(print "> (load-system \"boudin.egg\")")
@@ -1,15 +0,0 @@
-# boudin : a small static site generator
-
-DESTDIR =
-PREFIX = $(DESTDIR)/usr
-
-boudin: boudin.scm
-        chicken-install -n
-
-.PHONY: install
-install:
-        chicken-install
-
-.PHONY: clean
-clean:
-        rm -f *.build.sh *.install.sh
@@ -1,17 +1,42 @@
-;; boudin -*- scheme
+;;; boudin -*- scheme -*-
 
-((synopsis "A small static site generator.")
+((synopsis "A small tasty ssg.")
  (author "Case Duckworth")
- (version "12044")
+ (version "0.0.0")
  (license "God Willing License")
- (category fluff)
- (dependencies chicanery
-               atom
+
+ (dependencies chicanery r7rs utf8
                html-parser
-               scss
-               srfi-37
-               srfi-152
-               sxml-serializer
-               sxpath)
+               srfi-152)
+
+ (component-options
+  (csc-options "-X" "r7rs" "-R" "r7rs"
+               "-X" "utf8" "-R" "utf8"
+               "-no-warnings"))
+
  (components
-  (program boudin)))
+  (program boudin
+           (component-dependencies boudin-lib))
+
+  (extension boudin-lib
+             (source boudin.sld)
+             (modules boudin)
+             (install-name boudin)
+             (component-dependencies boudin.schmaltz))
+
+  (extension boudin.config
+             (source lib/config.sld)
+             (component-dependencies boudin.schmaltz))
+
+  (extension boudin.schmaltz
+             (source lib/schmaltz.sld)
+             (source-dependencies lib/schmaltz.sls))
+
+  (extension boudin.types
+             (source lib/types.sld)
+             (source-dependencies lib/types.sls)
+             (component-dependencies boudin.config
+                                     boudin.util))
+
+  (extension boudin.util
+             (source lib/util.sld))))
@@ -1,519 +1,14 @@
-#!/bin/sh
-#| -*- scheme -*-
-exec csi -R r7rs -s "$0" "$@"
-boudin --- a little static site generator
-|#
+;;; (boudin) --- A small tasty ssg
 
-(import (chicken file)
-        (chicken file posix)
-        (chicken irregex)
-        (chicken pathname)
-        (chicken port)
-        (chicken process-context)
-        (chicken random)
-        (chicken string)
-        (chicken time posix)
-        (chicanery)
-        (atom)
-        (html-parser)
-        (scss)
-        (srfi 37)
-        (srfi 152)
-        (sxml-serializer)
-        (sxpath))
+(import (boudin))
 
-;;; Utilities
+(define foo (render-string "#,hello from Boudin!"
+                           (interaction-environment)))
 
-(define el sxml->html)
-
-;;; Transformations
-;; A static site generator can be thought of largely as two sets of
-;; transformations: one transforming given input content to output content, and
-;; another transforming source paths to destination paths.  Since both, for my
-;; purposes, are strings, I have a generic function that can perform both
-;; transformations.
-
-(define (transform str . procs) #| string (string ->string) ... -> string
-  Apply PROCS to STR, left-to-right, and return the result.
-  Each PROC will be called with its predecessor's output, and should take a
-  string as input and return a string. |#
-  (if (null? procs)
-      str
-      (apply transform ((car procs) str) (cdr procs))))
-
-;;; Path transformations
-
-(define (indexify path) #| path -> path
-  Replace the PATH's extension with "/index.html".
-  |#
-  (make-pathname (pathname-strip-extension path)
-                 "index"
-                 "html"))
-
-(define (slugify path)
-  (transform path
-             normalize-pathname
-             ;; XXX: this should be much more robust
-             (lambda (p) (pathname-replace-directory p "/"))
-             pathname-strip-extension
-             (lambda (p) (string-append p "/"))))
-
-(define (transform-path path outdir) #| path => path
-  Transform PATH according to boudin's needs. |#
-  (transform path
-             normalize-pathname
-             (lambda (p) (pathname-replace-directory p outdir))
-             indexify))
-
-;;; Content transformations
-
-(define (split-paragraphs str) #| string -> (list string ...)
-  Split STR into paragraphs.
-  A paragraph is a contiguous series of text lines separated from other
-  paragraphs by at least 2 newline \n characters.  This procedure collapses
-  inter-paragraph space. |#
-  (let loop ((lines (string-split str "\n"))
-             (par '())
-             (acc '()))
-    (cond
-     ((and (null? lines)                ; base case: no more lines
-           (null? par))                 ; ... or pending paragraph
-      (reverse acc))
-     ((null? lines)                     ; add the final paragraph
-      (loop '() '() (cons (apply string-append (reverse par)) acc)))
-     ((equal? (car lines) "")           ; paragraph break
-      (loop (cdr lines)
-            '()
-            (cons (apply string-append (reverse par)) acc)))
-     (else                              ; line break
-      (loop (cdr lines)
-            (cons (string-append (car lines) "\n") par)
-            acc)))))
-
-(define (wrap-paragraphs str) #| string -> string
-  Wrap naked paragraphs of STR in <p> tags.
-  A 'naked' paragraph is one that doesn't begin with '<' (after optional
-  beginning whitespace). |#
-  (let loop ((pars (map string-trim (split-paragraphs str)))
-             (acc '()))
-    (cond
-     ((null? pars)
-      (apply string-append (reverse acc)))
-     ((zero? (string-length (car pars)))
-      (loop (cdr pars)
-            acc))
-     ((eq? #\< (string-ref (car pars) 0))
-      (loop (cdr pars)
-            (cons (car pars)
-                  acc)))
-     (else
-      (loop (cdr pars)
-            (cons (string-append "<p>" (car pars) "</p>\n")
-                  acc))))))
-
-(define (preprocess-text str) #| string -> string
-  Preprocess STR before passing it to `expand-string'.
-  For example, replace all '#' with '##' unless followed by a '{' or '('.
-  |#
-  (set! str (irregex-replace/all
-             '(or (: #\# #\# (look-ahead (or #\{ #\()))
-                  (: #\# (look-ahead (~ #\{ #\()))
-                  (: #\# eos))
-             str
-             "##"))
-  #;  (set! str (irregex-replace/all ; XXX: missing end paren
-  '(: #\@ #\()
-  str
-  "#(sxml->html `("))
-  ;; Return transformed string
-  str)
-
-(define (expand-string str) #| string -> string
-  Expand STR by passing it in a port to CHICKEN's #<# string interpolation.
-  Yes, this is as cursed as it sounds.
-
-  To make it slightly less so, all # are duplicated to escape them, except for
-  those before ( and {.  To escape /those/, double them. |#
-  (let* ((delim (let loop ((attempt (number->string (pseudo-random-real))))
-                  (if (irregex-search attempt str)
-                      (loop (number->string (pseudo-random-real)))
-                      attempt)))
-         (template (make-concatenated-port
-                    (open-input-string (string-append "#<#" delim "\n"))
-                    (open-input-string (preprocess-text str))
-                    (open-input-string (string-append "\n" delim "\n"))))
-         (expanded (with-output-to-string
-                     (lambda ()
-                       (display (eval (read template)
-                                      (interaction-environment)))))))
-    (irregex-replace/all '(: "#<unspecified>"
-                             (* whitespace))
-                         expanded
-                         "")))
-
-(define (transform-content content) #| string -> string
-  Transform CONTENT according to boudin's needs.
-  This is the raw html, and will still need to be processed to extract metadata
-  and to be further wrapped in a template. |#
-  (transform content
-             expand-string
-             wrap-paragraphs))
-
-;;; Pages
-;; A <page> is a record type that wraps the two transformations outlined above.
-;; It also includes the extracted metadata from the page for processing.
-
-(define-record-type <page>
-  (make-page slug meta source dest source-path dest-path)
-  page?
-  (slug page-slug (setter page-slug))
-  (meta page-meta (setter page-meta))
-  (source page-source)
-  (dest page-dest (setter page-dest))
-  (source-path page-source-path)
-  (dest-path page-dest-path (setter page-dest-path)))
-
-(define (page-url page)
-  (normalize-pathname
-   (make-pathname (list (site-base-url)
-                        (page-slug page))
-                  #f)))
-
-(define (%read-port port) #| port -> string
-  Read PORT until it hits eof and return the results as a string.
-  |#
-  (let ((chunk-size 512))
-    (let loop ((next (read-string chunk-size port))
-               (blank? #f)
-               (acc '()))
-      (cond
-       ((or (eof-object? next)
-            (and blank? (equal? next "")))
-        (close-input-port port)
-        (apply string-append (reverse acc)))
-       ((equal? next "")
-        (loop (read-string chunk-size port)
-              #t
-              (cons next acc)))
-       (else
-        (loop (read-string chunk-size port)
-              blank?
-              (cons next acc)))))))
-
-(define read-port #| (optional port) -> string
-  Read PORT completely, returning the results as a string.
-  PORT defaults to `current-input-port'.
-  |#
-  (case-lambda
-    (() (%read-port (current-input-port)))
-    ((p) (%read-port p))))
-
-(define (file->page file) #| string -> <page>
-  Convert FILE to an sxml tree after transforming it.
-  This procedure returns both the sxml of the transformed content, but that
-  page's metadata, too. |#
-  (let* ((source (with-input-from-file file read-port))
-         (dest (html->sxml (transform-content source))))
-    (make-page (slugify file)
-               (extract-meta dest)
-               source
-               dest
-               file
-               (transform-path file (build-directory)))))
-
-(define (extract-meta tree) #| sxml -> alist
-  Extract metadata from TREE's comments.
-  Returns an alist of (key . value) pairs where keys and values are strings. |#
-  (let loop ((tree tree)
-             (acc '()))
-    (cond
-     ((or (atom? tree)
-          (null? tree))
-      (reverse acc))
-     ((and (list? (car tree))
-           (eq? (caar tree) '*COMMENT*))
-      (loop (cdr tree)
-            (let* ((comment (string-trim-both (cadar tree)))
-                   (lines (string-split comment "\n")))
-              (map (lambda (l)
-                     (let ((kv (string-split l ":")))
-                       (cons (string-trim-both (car kv))
-                             (string-trim
-                              (string-intersperse (cdr kv) ":")))))
-                   lines))))
-     ((list? (car tree))
-      (loop (cdr tree)
-            (let ((subtree (loop (car tree) '())))
-              (if (null? subtree)
-                  acc
-                  (cons subtree acc)))))
-     (else (loop (cdr tree) acc)))))
-
-(define (meta-ref meta key default) #| alist string string -> <?>
-  Get KEY's value from META, or DEFAULT if it doesn't exist.
-  DEFAULT is required because I think it's a good idea to require it. |#
-  (let ((x (assoc key meta)))
-    (if x (cdr x) default)))
-
-(define (page-meta-ref page key default) #| <page> string string -> <?>
-  Get KEY's value from PAGE's meta, or DEFAULT.
-  |#
-  (let ((meta (page-meta page)))
-    (meta-ref meta key default)))
-
-;;; Time
-;; Time really only matters in feeds ... but it really does matter.  So I need a
-;; few helper functions.
-
-(define publish-time      ; this is a parameter so it's consistent across a run.
-  (make-parameter
-   (time->string (seconds->utc-time) "%FT%TZ")))
-
-(define (page-mtime page) #| <page> -> time-string
-  Grab the mtime field from PAGE's source file. |#
-  (let ((file (page-source-path page)))
-    (and file
-         (file-exists? file)
-         (time->string (seconds->utc-time
-                        (file-modification-time
-                         file))))))
-
-(define (page-guess-updated page) #| <page> -> time-string
-  Guess the "updated" property of PAGE. |#
-  (let ((meta-date (page-meta-ref page "date" #f)))
-    (if meta-date
-        ;; Attempt to parse the date metadata field.
-        (time->string (seconds->utc-time ; This double-conversion is /great/
-                       (local-time->seconds
-                        (or (string->time meta-date "%Y-%m-%d")
-                            (string->time meta-date "%Y-%m-%d%n%H:%M")
-                            (string->time meta-date "%Y-%m-%d%n%I:%M%n%p")
-                            ;; ... more ?
-                            (or (page-mtime page)
-                                (publish-time))))))
-        (or (page-mtime page)
-            (publish-time)))))
-
-;;; Templating
-;; Templating uses sxml to define a layout for pages and indeces (index.html,
-;; feed.xml).  Sxml's "stylesheets" can be used to extract metadata out of html
-;; comments and to further process the document.
-
-;; Each template has a default, but the user can override by defining templates
-;; in .config.scm (see below).  All templates are function parameters that take
-;; a page's sxml tree (argument PAGE) and return a string.
-
-(define page-template
-  (make-parameter
-   (lambda (page)
-     `(html (@ (lang "en"))
-            (head (title ,(page-meta-ref page "title" "[untitled]"))
-                  (link (@ (href "../style.css") ; relative
-                           (rel "stylesheet")))
-                  (meta (@ (name "viewport")
-                           (content "initial-scale=1.0"))))
-            (body ,(let ((title (page-meta-ref page "title" #f)))
-                     (if title `(h1 ,title) ""))
-                  ,@(cdr (page-dest page)))))))
-
-(define index-template
-  (make-parameter
-   (lambda pages
-     `(html (@ (lang "en"))
-            (head (title ,(site-name))
-                  (link (@ (href "./style.css") ; relative
-                           (rel "stylesheet")))
-                  (meta (@ (name "viewport")
-                           (content "initial-scale=1.0"))))
-            (body (h1 ,(site-name))
-                  (ul
-                   ,@(map (lambda (pg)
-                            `(li (a (@ (href ,(page-slug pg)))
-                                    ,(page-meta-ref pg
-                                                    "title"
-                                                    (pathname-file
-                                                     (page-source-path pg))))))
-                          ;; TODO : sort pages
-                          pages)))))))
-
-(define feed-template
-  (make-parameter
-   (lambda pages
-     (make-atom-doc
-      (make-feed
-       title: (make-title (site-name))
-       id: (site-base-url)
-       updated: (publish-time)       ; I don't like these semantics ..
-       authors: (list (make-author name: (site-author)
-                                   uri: (site-base-url)))
-       links: (list (make-link type: 'html
-                               uri-language: "en"
-                               uri: (site-base-url))
-                    (make-link relation: "self"
-                               type: "application/atom+xml"
-                               uri: (make-pathname
-                                     (site-base-url) "feed" "xml")))
-       rights: (make-rights (site-rights))
-       generator: (make-generator "Boudin"
-                                  uri: "https://git.acdw.net/boudin"
-                                  version: "0.1.0")
-       entries: (map (lambda (pg)
-                       (make-entry
-                        title: (make-title
-                                (page-meta-ref pg "title" "[untitled]"))
-                        links: (list (make-link type: 'html
-                                                uri: (page-url pg)))
-                        id: (page-url pg)
-                        updated: (page-guess-updated pg)
-                        ;;published:
-                        content: (make-content
-                                  (sxml->html (page-dest pg))
-                                  type: html)
-                        #;`(atom:content "foo")))
-                     pages))))))
-
-;;; Publishing
-
-(define (write-style)
-  (print-log "writing style")
-  (with-output-to-file (make-pathname (build-directory) "style" "css")
-    (lambda () (write-css (site-style)))))
-
-(define (write-page page)
-  (print-log "writing " (or (page-meta-ref page "title" #f)
-                            (page-source-path page)))
-  (create-directory (pathname-directory (page-dest-path page)) 'parents)
-  (with-output-to-file (page-dest-path page)
-    (lambda () (sxml-display-as-html ((page-template) page)))))
-
-(define (write-index pages)
-  (print-log "writing index")
-  (with-output-to-file (make-pathname (build-directory) "index" "html")
-    (lambda () (sxml-display-as-html (apply (index-template) pages)))))
-
-(define (write-feed pages)
-  (print-log "writing feed")
-    (serialize-sxml (apply (feed-template) pages)
-                    output: (make-pathname (build-directory) "feed" "xml")
-                    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
-                    ))
-
-;;; Configuration
-
-;; Build configuration
-
-(define build-directory
-  (make-parameter "out/"))
-
-(define build-config
-  (make-parameter "config.scm"))
-
-;; Site configuration
-
-(define site-name
-  (make-parameter "[A boudin web site]"))
-
-(define site-base-url
-  (make-parameter "https://example.com/"))
-
-(define site-author
-  (make-parameter "nobody"))
-
-(define site-rights
-  (make-parameter (string-append "(C) " (site-author))))
-
-(define site-style
-  (make-parameter
-   `(css+ (body (font "20px/1.4 sans-serif")
-                (max-width "48em")
-                (padding "1em")
-                (margin auto)))))
-
-;;; Options & Operands (SRFI 37)
-
-(define (print-log . xs)
-  (with-output-to-port (current-error-port)
-    (lambda () (apply print xs))))
-
-(define (die error-code . xs)
-  (apply print-log xs)
-  (exit error-code))
-
-(define usage
-  (string-append
-   "Usage: boudin [OPTIONS] FILE ...\n"
-   "Options:\n"
-   "-h, --help            show this help and exit\n"
-   "-o DIR, --output DIR  build site to DIR (default: out/)\n"
-   "Operands:\n"
-   "FILE ...              files to build\n"))
-
-(define opt/help
-  (option '(#\h "help")                 ; Names
-          #f                            ; Required arg?
-          #f                            ; Optional arg?
-          (lambda _                          ; Option proc (opt name arg seeds ...)
-            (die 0 usage))))
-
-(define opt/build-directory
-  (option '(#\o "output") #t #f
-          (lambda (opt name arg seeds)
-            (build-directory arg)
-            seeds)))
-
-(define opt/build-config
-  (option '(#\c "config") #t #f
-          (lambda (opt name arg seeds)
-            (build-config arg)
-            seeds)))
-
-(define (process-args args)
-  (let ((pages '()))
-    (args-fold args
-               ;; Options
-               (list opt/help
-                     opt/build-directory
-                     opt/build-config)
-               ;; Unrecognized option proc (option name arg seeds ...)
-               (lambda (_ name _ _)
-                 (die 1 "Unrecognized option: -" name "\n" usage))
-               ;; Operand proc (operand seeds ...)
-               (lambda (name seeds)
-                 (if (file-exists? name)
-                     (set! pages (cons name pages))
-                     (die 2 "File not found: " name))
-                 seeds)
-               ;; Seeds
-               '())
-    pages))
-
-;;; Main entry point
-
-(define pages (make-parameter #f))
-
-(define (main args)
-  (parameterize ((pages (process-args args)))
-    (unless (pages)
-      (die 0 "No pages to process.  Abort."))
-    ;; Check for files, create directories
-    (if (file-exists? (build-config))
-        (load (build-config))
-        (print-log "No config.scm found; using default config"))
-    (create-directory (build-directory) 'parents)
-    ;; Convert pages to sxml.  This needs to be done here because config.scm
-    ;; might define functions used by the pages.
-    (pages (map file->page (pages)))
-    ;; Build the site
-    (write-style)                       ; TODO: copy static assets (?)
-    (for-each write-page (pages))
-    (write-index (pages))
-    (write-feed (pages))))
+(define (main . args)
+  (print foo)
+  (for-each print args))
 
 (cond-expand
-  ((or chicken-script compiling)
-   (main (command-line-arguments)))
+  (compiling (apply main (command-line)))
   (else))
@@ -0,0 +1,7 @@
+(define-library (boudin)
+  (import (scheme base)
+          (scheme repl)
+          (boudin schmaltz))
+  (export hello)
+  (begin
+    (define hello "Hi")))
@@ -0,0 +1,45 @@
+;;; (boudin config) --- default values for configuration options
+;;
+;; To change these, make a `config.scm' in your site's root directory and change
+;; these.  They're all parameters so .. change em like that.
+
+(define-library (boudin config)
+  (import (scheme base)
+          (boudin schmaltz)
+          ;; not portable
+          (chicken pathname)
+          (html-parser)
+          )
+
+  (export site-url site-dest
+          page-path-transformers page-text-transformers
+          page-template index-template feed-template)
+
+  (begin
+    ;; Site information
+    (define site-url
+      (make-parameter "example.com"))
+    (define site-dest
+      (make-parameter "out/"))
+    ;; Transformers
+    (define page-path-transformers
+      (make-parameter
+       (list (lambda (path) (make-pathname (site-dest) path)))))
+    (define page-text-transformers
+      (make-parameter
+       (list wrap-paragraphs
+             render-string
+             html->sxml)))
+    ;; Templates --- note that we use quote but include unquote forms here.
+    ;; This is to simplify the configuration and to avoid a cyclical dependency
+    ;; with (boudin types).
+    (define page-template
+      (make-parameter
+       '(html (@ (lang "en-us"))
+              (head (title (or (page-ref pg "title") "[untitled]")))
+              (body ,@(page-sxml pg)))))
+    (define index-template
+      (make-parameter 'todo))
+    (define feed-template
+      (make-parameter 'todo))
+    ))
@@ -0,0 +1,17 @@
+(define-library (boudin schmaltz)
+  (export render
+          render-string
+          wrap-paragraphs)
+
+  (import (scheme base)
+          (scheme case-lambda)          ; case-lambda
+          (scheme eval)                 ; eval
+          (scheme read)                 ; read
+          (scheme repl)                 ; interaction-environment
+          (scheme write)                ; display
+          (only (html-parser)
+                sxml->html)
+          (only (srfi 152)
+                string-split string-trim))
+
+  (include "lib/schmaltz.sls"))
@@ -0,0 +1,103 @@
+;;; (boudin schmaltz) --- transform almost-html plus scheme into html
+
+;;; Embedded scheme code
+
+(define (->string x)
+  (call-with-port (open-output-string)
+    (lambda (port)
+      (display x port)
+      (get-output-string port))))
+
+(define render-string
+  (case-lambda
+    ((s) (render-string s (interaction-environment)))
+    ((s env)
+     (call-with-port (open-input-string s)
+       (lambda (port)
+         (render port env))))))
+
+(define (render port env)
+  ;; A few rough edges:
+  ;; #, x will try to render x
+  (define (burn-char)
+    ;; Throw a character away.  I've defined this for clarity below.
+    (read-char port))
+
+  (let loop ((ch (read-char port))
+             (acc '()))
+    (define (proceed) (loop (read-char port) (cons ch acc)))
+    (cond
+     ((not ch)
+      (loop (read-char port) acc))
+     ((eof-object? ch)
+      (list->string (reverse acc)))
+     ((eq? ch #\#)                      ; special processing to come
+      (case (peek-char port)
+        ((#\\)                          ; inhibit processing of the next char
+         (burn-char)
+         (loop (read-char port) (cons ch acc)))
+        ((#\,)                          ; scheme eval expansion
+         (burn-char)
+         (loop #f
+               (append (let ((s (->string
+                                 (eval (read port)
+                                       env))))
+                         (cond
+                          ((equal? s "#<unspecified>") ; XXX NOT PORTABLE
+                           '())
+                          ((equal? s "#!eof") ; XXX NOT PORTABLE
+                           '(#\, #\#))
+                          (else (reverse (string->list s)))))
+                       acc)))
+        ((#\@)                          ; embedded sxml
+         (burn-char)
+         (loop #f
+               (append (let ((h (eval `(sxml->html ,(list 'quasiquote
+                                                          (read port)))
+                                      env)))
+                         (cond
+                          ((equal? h "#!eof") ; XXX NOT PORTABLE
+                           '(#\@ #\#))
+                          (else (reverse (string->list h)))))
+                       acc)))
+        (else (proceed))))
+     (else (proceed)))))
+
+;;; Wrap paragraphs
+
+(define (split-paragraphs str)
+  (let loop ((lines (string-split str "\n"))
+             (par '())
+             (acc '()))
+    (cond
+     ((and (null? lines)                ; base case: no more lines
+           (null? par))                 ; ... or pending paragraph
+      (reverse acc))
+     ((null? lines)                     ; add the final paragraph
+      (loop '() '() (cons (apply string-append (reverse par)) acc)))
+     ((equal? (car lines) "")           ; paragraph break
+      (loop (cdr lines)
+            '()
+            (cons (apply string-append (reverse par)) acc)))
+     (else                              ; line break
+      (loop (cdr lines)
+            (cons (string-append (car lines) "\n") par)
+            acc)))))
+
+(define (wrap-paragraphs str)
+  (let loop ((pars (split-paragraphs str))
+             (acc '()))
+    (cond
+     ((null? pars)
+      (apply string-append (reverse acc)))
+     ((zero? (string-length (car pars)))
+      (loop (cdr pars)
+            acc))
+     ((eq? #\< (string-ref (string-trim (car pars)) 0))
+      (loop (cdr pars)
+            (cons (car pars)
+                  acc)))
+     (else
+      (loop (cdr pars)
+            (cons (string-append "<p>" (car pars) "</p>\n")
+                  acc))))))
@@ -0,0 +1,24 @@
+(define-library (boudin types)
+  (import (scheme base)
+          (scheme case-lambda)
+          (scheme file)
+          (boudin config)
+          (boudin util)
+          ;; non-portable bits
+          (chicken pathname)
+          (html-parser)
+          )
+
+  (export
+   ;; pages
+   make-page page?
+   page-path page-dest page-text page-sxml page-meta
+   set-page-dest! set-page-text! set-page-sxml! set-page-meta!
+   extract-metadata page-ref page-set!
+   page-url page-slug
+   read-page write-page
+   ;; indeces
+   ;; static files
+   )
+
+  (include "lib/types.sls"))
@@ -0,0 +1,72 @@
+;;; (boudin types) --- pages, indeces, and static files
+
+;; All paths are relative to the site directory unless otherwise noted
+
+(define-record-type page
+  (make-page path                       ; Input path
+             dest                       ; Output path (rel. to output directory)
+             text                       ; Input text
+             sxml                       ; Rendered sxml
+             meta                       ; Metadata (title, etc.)
+             )
+  page?
+  (path page-path)
+  (dest page-dest set-page-dest!)
+  (text page-text set-page-text!)
+  (sxml page-sxml set-page-sxml!)
+  (meta page-meta set-page-meta!))
+
+(define (page-ref pg key)
+  (assoc-ref key (page-meta pg) (identity #f)))
+
+(define (page-set! pg key val)
+  (set-page-meta! pg (cons (cons key val)
+                           (page-meta pg))))
+
+(define (extract-metadata sxml)
+  #f)
+
+(define (*urlify path)
+  (normalize-pathname
+   (make-pathname (list (site-url)
+                        (pathname-strip-extension path))
+                  "index.html")))
+
+(define (page-url pg)               ; foo.html => http://site.com/foo/index.html
+  (or (page-ref pg "url")           ; memoization
+      (let ((url (*urlify (page-path pg))))
+        (page-set! pg "url" url)
+        url)))
+
+(define (*slugify url)                  ; I don't love how this is written..
+  (let-values (((_ _ dirs) (decompose-directory url)))
+    (let loop ((this (car dirs))
+               (rest (cdr dirs)))
+      (if (null? (cdr rest))
+          (make-pathname (list "/" this) #f)
+          (loop (car rest)
+                (cdr rest))))))
+
+(define (page-slug pg)                 ; http://site.com/foo/index.html => /foo/
+  (or (page-ref pg "slug")             ; memoization
+      (let ((slug (*slugify (page-url pg))))
+        (page-set! pg "slug" slug)
+        slug)))
+
+(define (read-page path)
+  (let ((pg (make-page path #f #f #f #f)))
+    (set-page-dest! pg ((apply o (page-path-transformers)) path))
+    (set-page-text! pg (with-input-from-file path slurp))
+    (set-page-sxml! pg ((apply o (page-text-transformers)) (page-text pg)))
+    (set-page-meta! pg (extract-metadata (page-sxml pg)))
+    pg))
+
+(define write-page
+  (case-lambda
+    ((pg) (call-with-output-file (page-dest pg)
+            (lambda (port) (write-page pg port))))
+    ((pg port)
+     (sxml-display-as-html ((eval/q (page-template)) pg) port))))
+
+
+
@@ -0,0 +1,50 @@
+;;; (boudin util) --- utility functions
+
+(define-library (boudin util)
+  (import (scheme base)
+          (scheme case-lambda)
+          (scheme eval))
+
+  (export identity
+          o
+          assoc-ref
+          slurp
+          eval/q)
+
+  (begin
+    (define (identity x) x)
+
+    (define (o . procs)                     ; stole from chicken core
+      (if (null? procs)
+          identity
+          (let loop ((procs procs))
+            (let ((h (car procs))
+                  (t (cdr procs)))
+              (if (null? t)
+                  h
+                  (lambda (x) (h ((loop t) x))))))))
+
+    (define assoc-ref
+      (case-lambda
+        ((key alist)
+         (assoc-ref alist
+                    key
+                    (lambda () (error "Unrecognized key." key))))
+        ((key alist failure)
+         (cond ((assoc key alist) => cdr)
+               (else (failure))))))
+
+    (define slurp
+      (case-lambda
+        (() (slurp (current-input-port)))
+        ((port)
+         (let loop ((ch (read-char))
+                    (acc '()))
+           (if (eof-object? ch)
+               (list->string (reverse acc))
+               (loop (read-char) (cons ch acc)))))))
+
+    (define (eval/q form env)           ; this is probably a bad idea
+      (eval (list 'quasiquote form) env))
+
+    ))
@@ -1,19 +0,0 @@
-<!--
-     title: foo bar
-     subtitle: uhhh: the thing
--->
-
-<h1>some html</h1>
-<h2>(without p tags)</h2>
-
-Here is a test paragraph.  <a href="#">example link</a>.
-
-Here's another. I wonder if it'll just do the thing .. or whatever. Maybe I
-should try to make it multiple lines, as well.
-
-<ul class="again!">
-  <li>
-    one plus two is #(+ 1 2).
-  </li>
-  <li>two</li>
-</ul>