7 files changed, 194 insertions, 92 deletions

@@ -0,0 +1 @@
+build/
\ No newline at end of file
@@ -1,40 +1,63 @@
 NAME = jimmy
 
+LIBS = read emit util
+
+BUILD = $(PWD)/build
+SRC = $(PWD)/src
+
 CSC = /usr/bin/csc
 CSI = /usr/bin/csi
 CSC_OPTIONS = \
+        -setup-mode \
         -host \
         -D compiling-extension \
         -emit-all-import-libraries \
         -dynamic \
         -regenerate-import-libraries \
-        -setup-mode \
         -I $(PWD) \
-        -C -I$(PWD) \
+        -C -I$(PWD)
 
 CSC_OPTIONS_EXTRA = \
         -X utf8 \
         -X module-declarations
 
-BUILD = $(PWD)/build
+## Library dependency graph
+# here's a convenience macro
+lib = $(BUILD)/$(NAME).$(1).so
+# and another
+src = $(SRC)/$(1).scm
+
+LIBS_ = $(foreach l,$(LIBS),$(call lib,$(l)))
+
+## Phonies
 
-.PHONY: all test
-build: $(patsubst src/%.scm,$(BUILD)/%.so,$(wildcard src/*.scm))
+.PHONY: build test clean
+build: $(LIBS_)
+        -mv *.import.scm build/
 
 test: build
-        $(CSI) -s $(PWD)/tests/run.scm $(NAME)
+        cd $(BUILD) && \
+        $(CSI) -setup-mode -s tests/run.scm $(NAME)
 
-# Program!
+clean:
+        -rm -rf $(BUILD)
 
-# Libraries!
+install:
+        chicken-install -s
+
+uninstall:
+        chicken-uninstall -s
 
-$(BUILD)/%.so: src/%.scm
+# Scm -> So
+
+$(BUILD)/$(NAME).%.so: src/%.scm
         mkdir -p "$(dir $@)"
         $(CSC) $(CSC_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@
 
-## Library dependency graph
-# here's a convenience macro
-lib = $(BUILD)/$(NAME).$(1).so
+# Libraries!
+$(call lib,util): $(call src,util)
 
-$(call lib,read): $(call lib,util)
-$(call lib,emit): $(call lib,util)
+$(call lib,read): $(call src,read) $(call lib,util)
+$(call lib,emit): $(call src,emit) $(call lib,util)
+
+# Program!
@@ -34,18 +34,6 @@
       (line . "~A")
       (block . "~A~%~%"))))
 
-(define (string-join ss #!optional sep)
-  (if (string? ss) ss
-      (string-intersperse ss (or sep " "))))
-
-(define (char->tag char beg end)
-  (lambda (str)
-    (irregex-replace/all `(: ($ (or bos space))
-                             ,char ($ (+ (~ ,char))) ,char
-                             ($ (or space eos)))
-                         str
-                         1 beg 2 end 3)))
-
 (define-public filters
   `((para
      (line . ,(o (char->tag "*" "<strong>" "</strong>")
@@ -58,16 +46,27 @@
      (line . ,(lambda (ln)
                 (let ((ws (cond ((list? ln) ln)
                                 ((string? ln) (string-split ln)))))
-                  (list (car ws) (string-join (cdr ws)))))))
+                  (let ((x (list (car ws) (string-join (cdr ws)))))
+                    x)))))
     (default
-      (line . ,list)
+      (line . ,(lambda (x) (print x) (if (list? x) x (list x))))
       (block . ,identity))))
 
+(define (string-join ss #!optional sep)
+  (if (string? ss) ss
+      (string-intersperse ss (or sep " "))))
+
+(define (char->tag char beg end)
+  (lambda (str)
+    (irregex-replace/all `(: ($ (or bos space))
+                             ,char ($ (+ (~ ,char))) ,char
+                             ($ (or space eos)))
+                         str
+                         1 beg 2 end 3)))
+
 (define (get-from from type subtype)
   (or (alist-walk from type subtype)
-      (if (eq? subtype 'inline)
-          (alist-walk from type 'list)
-          (lambda _ '("")))))
+      (get-from from 'default subtype)))
 
 (define (get-format type subtype) (get-from formats type subtype))
 (define (get-filter type subtype) (get-from filters type subtype))
@@ -76,19 +75,19 @@
   (cond
    ;; if LINE is a string, wrap it in a list
    ((string? line)
-    (set! line (list line)))
+    (sprintf (get-format type 'line)
+             ((get-filter type 'line) line)))
    ;; if it's a list of strings, join them together and filter them
    ((and (list? line)
          (string? (car line)))
-    (set! line ((get-filter type 'line) line)))
+    (sprintf (get-format type 'line)
+             (apply string-append ((get-filter type 'line) line))))
    ;; if the car of LINE is a symbol, it's an inline thing.
    ((and (list? line)
          (symbol? (car line)))
-    (set! line (format-line (get-format (car line) 'inline)
-                            ((get-filter (car line) 'line) (cdr line))
-                            type)))
-   (else (error "Malformed line" line)))
-  (apply sprintf fmt line))
+    (sprintf* (get-format (car line) 'inline)
+              ((get-filter (car line) 'line) (cdr line))))
+   (else (error "Malformed line" line))))
 
 (define (format-block block)
   (if (assq (car block) formats)
@@ -107,3 +106,17 @@
         (sprintf (get-format type 'block)
                  ((get-filter type 'block) text)))
       ""))
+
+(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))))))
@@ -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))))))
@@ -1,13 +1,23 @@
 (declare (module (jimmy wrap)))
 
 (import scheme (chicken base)
+        (jimmy emit)
         (jimmy util)
-        (chicken format))
+        (only (chicken io) read-string)
+        (only (chicken port) with-output-to-string)
+        (only (chicken string) string-translate*))
 
-;;; open question: how to do templating?
+;; templates are strings with variables interpolated with "{{variables}}"
 
 (define-public (wrap document template)
-  #f)
+  (let* ((meta (map (lambda (el)
+                      (cons (string-append "{{" (car el) "}}")
+                            (string-intersperse (cdr el) " ")))
+                    (alist-walk document 'meta)))
+         (body (cons "{{body}}"
+                     (with-output-to-string
+                       (lambda () (emit document))))))
+    (string-translate* template (cons body meta))))
 
-(define (meta-get key document)
-  (alist-walk document 'meta key))
+(define-public (wrap-with document file)
+  (wrap document (with-input-from-file file read-string)))
@@ -55,7 +55,26 @@ end-document
 ;;; Tests
 
 (test "read"
-      '((meta ("title" "a" "test" "document") ("date" "2024-05-13T03:02:45Z") ("uuid" "b3daebf1-440b-4828-a4d9-9089c7bd7c61")) (hdr1 ("a" "test" "document" "of" "some" "kind")) (para "here is a test document." "it has paragraphs" (link "example.com" "with" "links!") "and other things.") (hdr2 ("a" "code" "example")) (verb "for (a=1;a<=4;a++) {" "\tprintf(\"%d\\n\", a);" "}") (hdr3 ("other" "examples")) (quot ("a" "blockquote" "is" "a" "quote") ("that" "is" "blocky.")) (list ("list" "1") ("list" "2") ("list" "3")) (link ("example.com" "link" "list" "1") ("example.com" "link" "list" "2") ("example.com" "link" "list" "3")) (para "ok, now for another test:" "will *strong* in-line text be converted?" "as well as `code`, _emph_ and such?" "what if *i _nest_ them*" "what if *i _nest them* wrong_ ?" "what about *breaking them" "over two lines?*"))
+      '((meta ("title" "a" "test" "document")
+              ("date" "2024-05-13T03:02:45Z")
+              ("uuid" "b3daebf1-440b-4828-a4d9-9089c7bd7c61"))
+        (hdr1 ("a" "test" "document" "of" "some" "kind"))
+        (para "here is a test document." "it has paragraphs" (link "example.com"
+                                                                   "with"
+                                                                   "links!")
+              "and other things.")
+        (hdr2 ("a" "code" "example"))
+        (verb "for (a=1;a<=4;a++) {" "\tprintf(\"%d\\n\", a);" "}")
+        (hdr3 ("other" "examples"))
+        (quot ("a" "blockquote" "is" "a" "quote") ("that" "is" "blocky."))
+        (list ("list" "1") ("list" "2") ("list" "3"))
+        (link ("example.com" "link" "list" "1") ("example.com" "link" "list"
+                                                 "2") ("example.com" "link"
+                                                       "list" "3"))
+        (para "ok, now for another test:" "will *strong* in-line text be
+converted?" "as well as `code`, _emph_ and such?" "what if *i _nest_ them*"
+"what if *i _nest them* wrong_ ?" "what about *breaking them" "over two
+lines?*"))
       (call-with-input-string test-doc parse))
 
 (test-exit)
@@ -0,0 +1,37 @@
+: title a test document
+: date 2024-05-13T03:02:45Z
+: uuid b3daebf1-440b-4828-a4d9-9089c7bd7c61
+
+# a test document of some kind
+
+here is a test document.
+it has paragraphs
+=> example.com with links!
+and other things.
+
+## a code example
+```
+for (a=1;a<=4;a++) {
+        printf("%d\n", a);
+}
+```
+
+### other examples
+
+> a blockquote is a quote
+> that is blocky.
+
+* list 1
+* list 2
+* list 3
+=> example.com link list 1
+=> example.com link list 2
+=> example.com link list 3
+
+ok, now for another test:
+will *strong* in-line text be converted?
+as well as `code`, _emph_ and such?
+what if *i _nest_ them*
+what if *i _nest them* wrong_ ?
+what about *breaking them
+over two lines?*