From 815e669310f5e73d13cc121bd7f6cdaec5b6ec0d Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Sun, 26 May 2024 22:49:44 -0500
Subject: Updates!

I totally forgot to actually commit things for a while, so uh

Updates!!!
---
 src/read.scm | 95 ++++++++++++++++++++++++++++++------------------------------
 1 file changed, 47 insertions(+), 48 deletions(-)

(limited to 'src/read.scm')

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 @@
 
 (import scheme (chicken base)
         (jimmy util)
-        (only (chicken condition) handle-exceptions)
         (only (chicken io) read-lines)
         (only (chicken string) string-split))
 
 (define-public line-types
-  ;; (sigil type inlines preproc)
-  '(("=>" link)
+  ;; (sigil type inlines word-select)
+  `((default para (link) ,identity) ; if nothing else matches
+    ("```" verb)
+    ("=>" link)
     (">" quot)
     ("#" hdr1)
     ("##" hdr2)
     ("###" hdr3)
     ("*" list)
-    ("```" verb)
     ;; extra!
     (":" meta)))
 
-(define-public (parse inport)
-  (parse-lines (read-lines inport) '()))
+(define-public (parse #!optional port)
+  (parse-lines (read-lines (or port (current-input-port))) '()))
 
 (define (line-type line)
-  (let ((it (assoc (car (string-split line)) line-types)))
-    (if it (cadr it)
-        'para)))
+  (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 line type exists
+     (else def))))                                 ; otherwise ...
 
-(define (parse-lines lines document)
-  (if (null? lines) (reverse document)
+(define (parse-lines lines doc)
+  (if (null? lines) (reverse doc)
       (let ((words (string-split (car lines))))
         (cond
-         ((null? words)
-          (parse-lines (cdr lines) document))
-         ((equal? (car words) "```")
-          (parse-verbatim (cdr lines) document '()))
-         ((assoc (car words) line-types)
-          => (lambda (it)
-               (apply parse-block lines document '() (cdr it))))
-         (else
-          (parse-block lines document '() 'para '(link) identity))))))
+         ((null? words)                            ; empty line
+          (parse-lines (cdr lines) doc))
+         ((equal? (car words) "```")               ; verbatim
+          (parse-verbatim (cdr lines) doc '()))
+         (else                                     ; another line type
+          (apply parse-stanza lines doc '() (line-type words)))))))
 
-(define (parse-verbatim lines document verb)
+(define (parse-verbatim lines doc block)
+  (define (close-verbatim) (cons (cons 'verb (reverse block)) doc))
   (cond
-   ((null? lines)
-    (parse-lines lines (cons (cons 'verb (reverse verb)) document)))
-   ((equal? (car lines) "```")
-    (parse-lines (cdr lines) (cons (cons 'verb (reverse verb)) document)))
-   (else
-    (parse-verbatim (cdr lines) document (cons (car lines) verb)))))
+   ((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 (car lines) block)))))
 
-(define (parse-block lines document block type #!optional inlines preproc)
-  (let ((inlines (or inlines '()))
-        (preproc (or preproc (lambda (ln) (cdr (string-split ln))))))
-    (cond
-     ((null? lines)
-      (parse-lines lines (cons (cons type (reverse block)) document)))
-     ((equal? (car lines) "")
-      (parse-lines (cdr lines) (cons (cons type (reverse block)) document)))
-     ((and (not (eq? type (line-type (car lines))))
-           (not (memq (line-type (car lines)) inlines)))
-      (parse-lines lines (cons (cons type (reverse block)) document)))
-     ((memq (line-type (car lines)) inlines)
+(define (parse-stanza lines doc stanza st-type
+                      #!optional (st-inlines '()) (st-words cdr))
+  (define (close-stanza) (cons (cons 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 (cdr (assoc (car ws) line-types))))
-        (parse-block (cdr lines) document
-                     (cons (cons (car lt)
-                                 ((or (ignore-errors (caddr lt)) cdr) ws))
-                           block)
-                     type inlines preproc)))
-     (else
-      (parse-block (cdr lines) document (cons (preproc (car lines)) block)
-                   type inlines preproc)))))
+             (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))))))
-- 
cgit 1.4.1-21-gabe81