blob: bd776957b6169c4aa48c91985f02c1a77c8181c8 (
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
|
(declare (module (boudin page post))
(export make-post
post-path-transformers
post-text-transformers
post-template
post-writer))
(import (boudin page)
(boudin page write)
(boudin site)
(boudin util)
(chicken pathname)
(html-parser)
(except (schmaltz)
render-specials
render-unprintables)
(schmaltz chicken)
(srfi 1)
(srfi 152))
(define (make-post path)
(let ((sxml ((apply o (post-text-transformers))
(with-input-from-file path slurp))))
(make-page sxml
((apply o (post-path-transformers)) path)
(post-template)
(post-writer)
(cons (cons "source" path)
(*extract-metadata sxml)))))
(define (*extract-metadata sxml)
(let loop ((tree sxml)
(acc '()))
;;; CONSIDER: using `read' to simplify this crazy logic
(cond
((null? tree)
(reverse acc))
((and (list? (car tree))
(eq? (caar tree) '*COMMENT*))
(loop (cdr tree)
(filter-map (lambda (ln)
(let ((kv (string-split ln ":" 'infix 1)))
(and (pair? kv)
(cons (string-trim-both (car kv))
(apply string-append
(map 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 post-text-transformers
(make-parameter
(list html->sxml
wrap-paragraphs
render-string->string)))
(define post-path-transformers
(make-parameter
(list (lambda (path)
(make-pathname (list (site-output)
(pathname-strip-extension path))
"index.html")))))
(define post-template
(make-parameter
(lambda (pg)
(let ((title (page-ref pg "title")))
`(html (@ (lang "en-us"))
(head ,@(html-head)
(title ,(or title "[untitled]")))
(body ,(if title `(h1 ,title) "")
,@(cdr (page-content pg))))))))
(define post-writer
(make-parameter
sxml-display-as-html))
|
