;;; (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))))