diff options
Diffstat (limited to 'src/read.scm')
-rw-r--r-- | src/read.scm | 74 |
1 files changed, 74 insertions, 0 deletions
diff --git a/src/read.scm b/src/read.scm new file mode 100644 index 0000000..00ffad4 --- /dev/null +++ b/src/read.scm | |||
@@ -0,0 +1,74 @@ | |||
1 | (declare (module (jimmy read))) | ||
2 | |||
3 | (import scheme (chicken base) | ||
4 | (jimmy util) | ||
5 | (only (chicken condition) handle-exceptions) | ||
6 | (only (chicken io) read-lines) | ||
7 | (only (chicken string) string-split)) | ||
8 | |||
9 | (define-public line-types | ||
10 | ;; (sigil type inlines preproc) | ||
11 | '(("=>" link) | ||
12 | (">" quot) | ||
13 | ("#" hdr1) | ||
14 | ("##" hdr2) | ||
15 | ("###" hdr3) | ||
16 | ("*" list) | ||
17 | ("```" verb) | ||
18 | ;; extra! | ||
19 | (":" meta))) | ||
20 | |||
21 | (define-public (parse inport) | ||
22 | (parse-lines (read-lines inport) '())) | ||
23 | |||
24 | (define (line-type line) | ||
25 | (let ((it (assoc (car (string-split line)) line-types))) | ||
26 | (if it (cadr it) | ||
27 | 'para))) | ||
28 | |||
29 | (define (parse-lines lines document) | ||
30 | (if (null? lines) (reverse document) | ||
31 | (let ((words (string-split (car lines)))) | ||
32 | (cond | ||
33 | ((null? words) | ||
34 | (parse-lines (cdr lines) document)) | ||
35 | ((equal? (car words) "```") | ||
36 | (parse-verbatim (cdr lines) document '())) | ||
37 | ((assoc (car words) line-types) | ||
38 | => (lambda (it) | ||
39 | (apply parse-block lines document '() (cdr it)))) | ||
40 | (else | ||
41 | (parse-block lines document '() 'para '(link) identity)))))) | ||
42 | |||
43 | (define (parse-verbatim lines document verb) | ||
44 | (cond | ||
45 | ((null? lines) | ||
46 | (parse-lines lines (cons (cons 'verb (reverse verb)) document))) | ||
47 | ((equal? (car lines) "```") | ||
48 | (parse-lines (cdr lines) (cons (cons 'verb (reverse verb)) document))) | ||
49 | (else | ||
50 | (parse-verbatim (cdr lines) document (cons (car lines) verb))))) | ||
51 | |||
52 | (define (parse-block lines document block type #!optional inlines preproc) | ||
53 | (let ((inlines (or inlines '())) | ||
54 | (preproc (or preproc (lambda (ln) (cdr (string-split ln)))))) | ||
55 | (cond | ||
56 | ((null? lines) | ||
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)) | ||
65 | (ws (string-split ln)) | ||
66 | (lt (cdr (assoc (car ws) line-types)))) | ||
67 | (parse-block (cdr lines) document | ||
68 | (cons (cons (car lt) | ||
69 | ((or (ignore-errors (caddr lt)) cdr) ws)) | ||
70 | block) | ||
71 | type inlines preproc))) | ||
72 | (else | ||
73 | (parse-block (cdr lines) document (cons (preproc (car lines)) block) | ||
74 | type inlines preproc))))) | ||