1 files changed, 94 insertions, 0 deletions

@@ -0,0 +1,94 @@
+(declare (module (jimmy emit)))
+
+(import scheme (chicken base)
+        (chicken format)
+        (chicken irregex)
+        (chicken port)
+        (chicken string)
+        (only utf8-srfi-13 string-join)
+        (jimmy util))
+
+(define-public (emit doc)
+  (for-each display (map format-stanza doc)))
+
+(define-public (emit-string doc)
+  (with-output-to-string
+    (lambda () (emit doc))))
+
+(define-public formats
+  (make-parameter
+   ;; (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~%")))))
+
+(define-public filters
+  (make-parameter
+   ;; (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 . ,join-lines))
+     (default
+       (line . ,identity)
+       (stanza . ,flush-lines-left)))))
+
+(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)
+  (or (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))))))