summary refs log tree commit diff stats
path: root/lib/types.sls
diff options
context:
space:
mode:
Diffstat (limited to 'lib/types.sls')
-rw-r--r--lib/types.sls72
1 files changed, 0 insertions, 72 deletions
diff --git a/lib/types.sls b/lib/types.sls deleted file mode 100644 index 2b4da5d..0000000 --- a/lib/types.sls +++ /dev/null
@@ -1,72 +0,0 @@
1;;; (boudin types) --- pages, indeces, and static files
2
3;; All paths are relative to the site directory unless otherwise noted
4
5(define-record-type page
6 (make-page path ; Input path
7 dest ; Output path (rel. to output directory)
8 text ; Input text
9 sxml ; Rendered sxml
10 meta ; Metadata (title, etc.)
11 )
12 page?
13 (path page-path)
14 (dest page-dest set-page-dest!)
15 (text page-text set-page-text!)
16 (sxml page-sxml set-page-sxml!)
17 (meta page-meta set-page-meta!))
18
19(define (page-ref pg key)
20 (assoc-ref key (page-meta pg) (identity #f)))
21
22(define (page-set! pg key val)
23 (set-page-meta! pg (cons (cons key val)
24 (page-meta pg))))
25
26(define (extract-metadata sxml)
27 #f)
28
29(define (*urlify path)
30 (normalize-pathname
31 (make-pathname (list (site-url)
32 (pathname-strip-extension path))
33 "index.html")))
34
35(define (page-url pg) ; foo.html => http://site.com/foo/index.html
36 (or (page-ref pg "url") ; memoization
37 (let ((url (*urlify (page-path pg))))
38 (page-set! pg "url" url)
39 url)))
40
41(define (*slugify url) ; I don't love how this is written..
42 (let-values (((_ _ dirs) (decompose-directory url)))
43 (let loop ((this (car dirs))
44 (rest (cdr dirs)))
45 (if (null? (cdr rest))
46 (make-pathname (list "/" this) #f)
47 (loop (car rest)
48 (cdr rest))))))
49
50(define (page-slug pg) ; http://site.com/foo/index.html => /foo/
51 (or (page-ref pg "slug") ; memoization
52 (let ((slug (*slugify (page-url pg))))
53 (page-set! pg "slug" slug)
54 slug)))
55
56(define (read-page path)
57 (let ((pg (make-page path #f #f #f #f)))
58 (set-page-dest! pg ((apply o (page-path-transformers)) path))
59 (set-page-text! pg (with-input-from-file path slurp))
60 (set-page-sxml! pg ((apply o (page-text-transformers)) (page-text pg)))
61 (set-page-meta! pg (extract-metadata (page-sxml pg)))
62 pg))
63
64(define write-page
65 (case-lambda
66 ((pg) (call-with-output-file (page-dest pg)
67 (lambda (port) (write-page pg port))))
68 ((pg port)
69 (sxml-display-as-html ((eval/q (page-template)) pg) port))))
70
71
72