A new start (again)

1 files changed, 72 insertions, 0 deletions

@@ -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))))
+
+
+