blob: ea43b0661e4d461f8a316d1a9a5198bb087f711d (
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
|
(declare (module (jimmy read)))
(import scheme (chicken base)
(jimmy util)
(only (chicken io) read-lines)
(only (chicken string) string-split))
(define-public line-types
;; (sigil type inlines word-select)
`((default para (link) ,identity) ; if nothing else matches
("```" verb)
("=>" link)
(">" quot)
("#" hdr1)
("##" hdr2)
("###" hdr3)
("*" list)
;; extra!
(":" meta)))
(define-public (parse #!optional port)
(parse-lines (read-lines (or port (current-input-port))) '()))
(define (line-type line)
(let ((lin (if (string? line) (string-split line) line))
(def (cdr (assoc 'default line-types))))
(cond
((null? lin) def) ; empty line
((assoc (car lin) line-types) => cdr) ; a known line type
(else def)))) ; otherwise ...
(define (parse-lines lines doc)
(if (null? lines) (reverse doc)
(let ((words (string-split (car lines))))
(cond
((null? words) ; empty line
(parse-lines (cdr lines) doc))
((equal? (car words) "```") ; verbatim
(parse-verbatim (cdr lines) doc '()
;;; FIXME
(cons 'verb (cdr words))))
(else ; another line type
(apply parse-stanza lines doc '() (line-type words)))))))
(define (parse-verbatim lines doc block bhead)
(define (close-verbatim) (cons (cons bhead (reverse block)) doc))
(cond
((null? lines) ; end of document
(parse-lines lines (close-verbatim)))
((equal? (car lines) "```") ; end of verbatim block
(parse-lines (cdr lines) (close-verbatim)))
(else ; verbatim block continues
(parse-verbatim (cdr lines) doc (cons (list (car lines)) block) bhead))))
(define (parse-stanza lines doc stanza st-type
#!optional (st-inlines '()) (st-words cdr))
(define (close-stanza) (cons (cons (list st-type) (reverse stanza)) doc))
(if (null? lines) ; end of document
(parse-lines lines (close-stanza))
(let* ((ln (car lines))
(ws (string-split ln))
(lt (line-type ln)))
(cond
((null? ws) ; end of stanza (blank line)
(parse-lines (cdr lines) (close-stanza)))
((memq (car lt) st-inlines) ; in-line for *this* stanza
(parse-stanza (cdr lines) doc
(cons (cons (car lt) (cdr ws)) stanza)
st-type st-inlines st-words))
((not (eq? st-type (car (line-type ws)))) ; beginning of a new stanza
(parse-lines lines (close-stanza)))
(else ; continue this stanza
(parse-stanza (cdr lines) doc
(cons (st-words ws) stanza)
st-type st-inlines st-words))))))
|
