blob: 3f6c07f6ec0a4e125e84f22516c7688cb2572a21 (
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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
;;; (boudin types) --- pages, indeces, and static files
;;
;; All paths are relative to the site directory unless otherwise noted
;;; Pages
(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) (lambda _ #f)))
(define (page-set! pg key val)
(set-page-meta! pg (cons (cons key val)
(page-meta pg))))
(define (extract-metadata sxml)
(let loop ((tree sxml)
(acc '()))
(cond
((not (pair? tree))
(reverse acc))
((and (list? (car tree))
(eq? (caar tree) '*COMMENT*))
(loop (cdr tree)
(map (lambda (ln)
(let ((kv (string-split ln ":" 'infix 1)))
(cons (string-trim-both (car kv))
(string-trim (cdr kv)))))
(string-split (cadar tree) "\n"))))
((list? (car tree))
(loop (cdr tree)
(let ((subtree (loop (car tree) '())))
(if (null? subtree)
acc
(cons subtree acc)))))
(else (loop (cdr tree) acc)))))
(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 (*page-mtime pg)
(let ((file (page-path pg)))
(and file
(file-exists? file)
(time->string (seconds->utc-time (file-modification-time file))))))
(define (page-updated pg)
(let ((meta-date (page-ref pg "date")))
(or (and meta-date
(find (lambda (fmt) (string->time meta-date fmt))
(page-date-formats)))
(*page-mtime pg)
(build-time))))
(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))))
;;; Indeces
;; These are generated pages from collections of other pages. Think index.html,
;; feed.xml, possibly tag indeces and the like. These pages don't have a source
;; file, but they have a destination and a template. Because there are
;; different file formats here and ... stuff, there's also a slot for the index
;; writer function. Finally, pages and meta are the pages and various other
;; metadata of the index.
(define-record-type index
(make-index dest ; Relative to (site-dest)
template ; Template to put pages in
writer ; Proc to write sxml out to a file
pages ; Input pages
meta ; Various other metadata
)
index?
(dest index-dest set-index-dest!)
(template index-template set-index-template!)
(writer index-writer set-index-writer!)
(pages index-pages set-index-pages!)
(meta index-meta set-index-meta!))
(define (index-ref idx key)
(assoc-ref key (index-meta idx) (lambda _ #f)))
(define (index-set! idx key val)
(set-index-meta! idx (cons (cons key val)
(index-meta idx))))
(define (index-push! idx pg)
(set-index-pages! idx (cons pg (index-pages idx))))
(define (index-for-each idx proc)
(for-each proc (index-pages idx)))
(define write-index
(case-lambda
((idx) (call-with-output-file (index-dest idx)
(lambda (port) (write-index idx (current-output-port)))))
((idx port)
((index-writer idx) ((index-template idx) (index-pages idx)) port))))
;;; Static files
;; These are simply copied from the input to the output, possibly with a changed
;; path. Because these are just files, we don't need a record type.
(define (static-copy path)
(copy-file path
(make-pathname (site-dest) path)
'clobber))
|
