blob: e57e4370ea6329af86e8c59292473e46e1e92478 (
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
|
(import scheme (chicken base)
(chicken format)
(chicken irregex)
(chicken string)
(only utf8-srfi-13 string-join)
(jimmy util))
(define-public (emit doc)
(for-each display (map format-stanza doc)))
(define-public formats
;;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT))
'((para (line . "~A")
(stanza . "~A~%~%"))
(verb (line . "~A~%")
(stanza . "```~%~A```~%~%"))
(link (line . "=> ~A ~A~%") ; Note: link has 2 format arguments
(stanza . "~A~%")
(inline . "~%=> ~A ~A~%"))
(list (line . "* ~A~%")
(stanza . "~A~%"))
(quot (line . "~A")
(stanza . "> ~A~%~%"))
(hdr1 (line . "# ~A~%")
(stanza . "~A~%"))
(hdr2 (line . "## ~A~%")
(stanza . "~A~%"))
(hdr3 (line . "### ~A~%")
(stanza . "~A~%"))
(meta (line . "")
(stanza . ""))
(default
(line . "~A")
(stanza . "~A~%~%"))))
(define-public filters
;;; (TYPE (line . LINE-FILTER) (stanza . STANZA-FILTER))
;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format)
;; stanza-filter : (lambda (list-of-strs) ...) -> str
`((verb (line . ,identity)
(stanza . ,(lambda (lines) (apply string-append lines))))
(default
(line . ,identity)
(stanza . ,(lambda (lines)
(irregex-replace/all '(: bol (* space))
(string-join lines) ""))))))
(define (format-line line el)
(cond
((string? (car line)) ; regular stanza line
(sprintf* (get-format el 'line)
((get-filter el 'line) line)))
((symbol? (car line)) ; inline element
(sprintf* (get-format (car line) 'inline)
((get-filter (car line) 'line) (cdr line))))
(else (error "Malformed line" line))))
(define (format-stanza stanza)
(let* ((type (car stanza))
(data (cdr stanza))
(text (map (lambda (ln)
(format-line ln type))
data)))
(sprintf (get-format type 'stanza)
((get-filter type 'stanza) text))))
;;; Utilities
(define (get-from alist el scope)
(or (alist-walk alist el scope)
(alist-walk alist 'default scope)
(and (eq? scope 'inline)
(alist-walk alist 'default 'line))))
(define (get-format el scope) (get-from formats el scope))
(define (get-filter el scope) (get-from filters el scope))
(define (sprintf* fmt lis)
(let loop ((num (length (irregex-extract "~[aA]" fmt)))
(lis lis)
(out '()))
(cond
((null? lis)
(apply sprintf fmt (reverse out)))
((= 1 num)
(loop 0 '() (cons (string-join lis) out)))
(else
(loop (- num 1)
(cdr lis)
(cons (car lis) out))))))
|
