diff options
Diffstat (limited to 'src/read.scm')
-rw-r--r-- | src/read.scm | 95 |
1 files changed, 47 insertions, 48 deletions
diff --git a/src/read.scm b/src/read.scm index 00ffad4..5e655a7 100644 --- a/src/read.scm +++ b/src/read.scm | |||
@@ -2,73 +2,72 @@ | |||
2 | 2 | ||
3 | (import scheme (chicken base) | 3 | (import scheme (chicken base) |
4 | (jimmy util) | 4 | (jimmy util) |
5 | (only (chicken condition) handle-exceptions) | ||
6 | (only (chicken io) read-lines) | 5 | (only (chicken io) read-lines) |
7 | (only (chicken string) string-split)) | 6 | (only (chicken string) string-split)) |
8 | 7 | ||
9 | (define-public line-types | 8 | (define-public line-types |
10 | ;; (sigil type inlines preproc) | 9 | ;; (sigil type inlines word-select) |
11 | '(("=>" link) | 10 | `((default para (link) ,identity) ; if nothing else matches |
11 | ("```" verb) | ||
12 | ("=>" link) | ||
12 | (">" quot) | 13 | (">" quot) |
13 | ("#" hdr1) | 14 | ("#" hdr1) |
14 | ("##" hdr2) | 15 | ("##" hdr2) |
15 | ("###" hdr3) | 16 | ("###" hdr3) |
16 | ("*" list) | 17 | ("*" list) |
17 | ("```" verb) | ||
18 | ;; extra! | 18 | ;; extra! |
19 | (":" meta))) | 19 | (":" meta))) |
20 | 20 | ||
21 | (define-public (parse inport) | 21 | (define-public (parse #!optional port) |
22 | (parse-lines (read-lines inport) '())) | 22 | (parse-lines (read-lines (or port (current-input-port))) '())) |
23 | 23 | ||
24 | (define (line-type line) | 24 | (define (line-type line) |
25 | (let ((it (assoc (car (string-split line)) line-types))) | 25 | (let ((lin (if (string? line) (string-split line) line)) |
26 | (if it (cadr it) | 26 | (def (cdr (assoc 'default line-types)))) |
27 | 'para))) | 27 | (cond |
28 | ((null? lin) def) ; empty line | ||
29 | ((assoc (car lin) line-types) => cdr) ; a line type exists | ||
30 | (else def)))) ; otherwise ... | ||
28 | 31 | ||
29 | (define (parse-lines lines document) | 32 | (define (parse-lines lines doc) |
30 | (if (null? lines) (reverse document) | 33 | (if (null? lines) (reverse doc) |
31 | (let ((words (string-split (car lines)))) | 34 | (let ((words (string-split (car lines)))) |
32 | (cond | 35 | (cond |
33 | ((null? words) | 36 | ((null? words) ; empty line |
34 | (parse-lines (cdr lines) document)) | 37 | (parse-lines (cdr lines) doc)) |
35 | ((equal? (car words) "```") | 38 | ((equal? (car words) "```") ; verbatim |
36 | (parse-verbatim (cdr lines) document '())) | 39 | (parse-verbatim (cdr lines) doc '())) |
37 | ((assoc (car words) line-types) | 40 | (else ; another line type |
38 | => (lambda (it) | 41 | (apply parse-stanza lines doc '() (line-type words))))))) |
39 | (apply parse-block lines document '() (cdr it)))) | ||
40 | (else | ||
41 | (parse-block lines document '() 'para '(link) identity)))))) | ||
42 | 42 | ||
43 | (define (parse-verbatim lines document verb) | 43 | (define (parse-verbatim lines doc block) |
44 | (define (close-verbatim) (cons (cons 'verb (reverse block)) doc)) | ||
44 | (cond | 45 | (cond |
45 | ((null? lines) | 46 | ((null? lines) ; end of document |
46 | (parse-lines lines (cons (cons 'verb (reverse verb)) document))) | 47 | (parse-lines lines (close-verbatim))) |
47 | ((equal? (car lines) "```") | 48 | ((equal? (car lines) "```") ; end of verbatim block |
48 | (parse-lines (cdr lines) (cons (cons 'verb (reverse verb)) document))) | 49 | (parse-lines (cdr lines) (close-verbatim))) |
49 | (else | 50 | (else ; verbatim block continues |
50 | (parse-verbatim (cdr lines) document (cons (car lines) verb))))) | 51 | (parse-verbatim (cdr lines) doc (cons (car lines) block))))) |
51 | 52 | ||
52 | (define (parse-block lines document block type #!optional inlines preproc) | 53 | (define (parse-stanza lines doc stanza st-type |
53 | (let ((inlines (or inlines '())) | 54 | #!optional (st-inlines '()) (st-words cdr)) |
54 | (preproc (or preproc (lambda (ln) (cdr (string-split ln)))))) | 55 | (define (close-stanza) (cons (cons st-type (reverse stanza)) doc)) |
55 | (cond | 56 | (if (null? lines) ; end of document |
56 | ((null? lines) | 57 | (parse-lines lines (close-stanza)) |
57 | (parse-lines lines (cons (cons type (reverse block)) document))) | ||
58 | ((equal? (car lines) "") | ||
59 | (parse-lines (cdr lines) (cons (cons type (reverse block)) document))) | ||
60 | ((and (not (eq? type (line-type (car lines)))) | ||
61 | (not (memq (line-type (car lines)) inlines))) | ||
62 | (parse-lines lines (cons (cons type (reverse block)) document))) | ||
63 | ((memq (line-type (car lines)) inlines) | ||
64 | (let* ((ln (car lines)) | 58 | (let* ((ln (car lines)) |
65 | (ws (string-split ln)) | 59 | (ws (string-split ln)) |
66 | (lt (cdr (assoc (car ws) line-types)))) | 60 | (lt (line-type ln))) |
67 | (parse-block (cdr lines) document | 61 | (cond |
68 | (cons (cons (car lt) | 62 | ((null? ws) ; end of stanza (blank line) |
69 | ((or (ignore-errors (caddr lt)) cdr) ws)) | 63 | (parse-lines (cdr lines) (close-stanza))) |
70 | block) | 64 | ((memq (car lt) st-inlines) ; in-line for *this* stanza |
71 | type inlines preproc))) | 65 | (parse-stanza (cdr lines) doc |
72 | (else | 66 | (cons (cons (car lt) (cdr ws)) stanza) |
73 | (parse-block (cdr lines) document (cons (preproc (car lines)) block) | 67 | st-type st-inlines st-words)) |
74 | type inlines preproc))))) | 68 | ((not (eq? st-type (car (line-type ws)))) ; beginning of a new stanza |
69 | (parse-lines lines (close-stanza))) | ||
70 | (else ; continue this stanza | ||
71 | (parse-stanza (cdr lines) doc | ||
72 | (cons (st-words ws) stanza) | ||
73 | st-type st-inlines st-words)))))) | ||