blob: 2b4da5d039d82c841e3d5f52204a333bd068a3f8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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))))
|
