diff options
author | Case Duckworth | 2024-05-26 22:49:44 -0500 |
---|---|---|
committer | Case Duckworth | 2024-05-26 22:52:25 -0500 |
commit | 815e669310f5e73d13cc121bd7f6cdaec5b6ec0d (patch) | |
tree | 1d3ab042bb6ffc2302a0a03b61147e5b4a649960 | |
parent | Scheme bit! (diff) | |
download | jimmy-815e669310f5e73d13cc121bd7f6cdaec5b6ec0d.tar.gz jimmy-815e669310f5e73d13cc121bd7f6cdaec5b6ec0d.zip |
Updates!
I totally forgot to actually commit things for a while, so uh Updates!!!
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | Makefile | 51 | ||||
-rw-r--r-- | src/emit.scm | 61 | ||||
-rw-r--r-- | src/read.scm | 95 | ||||
-rw-r--r-- | src/wrap.scm | 20 | ||||
-rw-r--r-- | tests/run.scm | 21 | ||||
-rw-r--r-- | tests/test.gmi | 37 |
7 files changed, 194 insertions, 92 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d163863 --- /dev/null +++ b/.gitignore | |||
@@ -0,0 +1 @@ | |||
build/ \ No newline at end of file | |||
diff --git a/Makefile b/Makefile index 0b8e141..2be0ca1 100644 --- a/Makefile +++ b/Makefile | |||
@@ -1,40 +1,63 @@ | |||
1 | NAME = jimmy | 1 | NAME = jimmy |
2 | 2 | ||
3 | LIBS = read emit util | ||
4 | |||
5 | BUILD = $(PWD)/build | ||
6 | SRC = $(PWD)/src | ||
7 | |||
3 | CSC = /usr/bin/csc | 8 | CSC = /usr/bin/csc |
4 | CSI = /usr/bin/csi | 9 | CSI = /usr/bin/csi |
5 | CSC_OPTIONS = \ | 10 | CSC_OPTIONS = \ |
11 | -setup-mode \ | ||
6 | -host \ | 12 | -host \ |
7 | -D compiling-extension \ | 13 | -D compiling-extension \ |
8 | -emit-all-import-libraries \ | 14 | -emit-all-import-libraries \ |
9 | -dynamic \ | 15 | -dynamic \ |
10 | -regenerate-import-libraries \ | 16 | -regenerate-import-libraries \ |
11 | -setup-mode \ | ||
12 | -I $(PWD) \ | 17 | -I $(PWD) \ |
13 | -C -I$(PWD) \ | 18 | -C -I$(PWD) |
14 | 19 | ||
15 | CSC_OPTIONS_EXTRA = \ | 20 | CSC_OPTIONS_EXTRA = \ |
16 | -X utf8 \ | 21 | -X utf8 \ |
17 | -X module-declarations | 22 | -X module-declarations |
18 | 23 | ||
19 | BUILD = $(PWD)/build | 24 | ## Library dependency graph |
25 | # here's a convenience macro | ||
26 | lib = $(BUILD)/$(NAME).$(1).so | ||
27 | # and another | ||
28 | src = $(SRC)/$(1).scm | ||
29 | |||
30 | LIBS_ = $(foreach l,$(LIBS),$(call lib,$(l))) | ||
31 | |||
32 | ## Phonies | ||
20 | 33 | ||
21 | .PHONY: all test | 34 | .PHONY: build test clean |
22 | build: $(patsubst src/%.scm,$(BUILD)/%.so,$(wildcard src/*.scm)) | 35 | build: $(LIBS_) |
36 | -mv *.import.scm build/ | ||
23 | 37 | ||
24 | test: build | 38 | test: build |
25 | $(CSI) -s $(PWD)/tests/run.scm $(NAME) | 39 | cd $(BUILD) && \ |
40 | $(CSI) -setup-mode -s tests/run.scm $(NAME) | ||
26 | 41 | ||
27 | # Program! | 42 | clean: |
43 | -rm -rf $(BUILD) | ||
28 | 44 | ||
29 | # Libraries! | 45 | install: |
46 | chicken-install -s | ||
47 | |||
48 | uninstall: | ||
49 | chicken-uninstall -s | ||
30 | 50 | ||
31 | $(BUILD)/%.so: src/%.scm | 51 | # Scm -> So |
52 | |||
53 | $(BUILD)/$(NAME).%.so: src/%.scm | ||
32 | mkdir -p "$(dir $@)" | 54 | mkdir -p "$(dir $@)" |
33 | $(CSC) $(CSC_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@ | 55 | $(CSC) $(CSC_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@ |
34 | 56 | ||
35 | ## Library dependency graph | 57 | # Libraries! |
36 | # here's a convenience macro | 58 | $(call lib,util): $(call src,util) |
37 | lib = $(BUILD)/$(NAME).$(1).so | ||
38 | 59 | ||
39 | $(call lib,read): $(call lib,util) | 60 | $(call lib,read): $(call src,read) $(call lib,util) |
40 | $(call lib,emit): $(call lib,util) | 61 | $(call lib,emit): $(call src,emit) $(call lib,util) |
62 | |||
63 | # Program! | ||
diff --git a/src/emit.scm b/src/emit.scm index aa36eb5..d6fe19e 100644 --- a/src/emit.scm +++ b/src/emit.scm | |||
@@ -34,18 +34,6 @@ | |||
34 | (line . "~A") | 34 | (line . "~A") |
35 | (block . "~A~%~%")))) | 35 | (block . "~A~%~%")))) |
36 | 36 | ||
37 | (define (string-join ss #!optional sep) | ||
38 | (if (string? ss) ss | ||
39 | (string-intersperse ss (or sep " ")))) | ||
40 | |||
41 | (define (char->tag char beg end) | ||
42 | (lambda (str) | ||
43 | (irregex-replace/all `(: ($ (or bos space)) | ||
44 | ,char ($ (+ (~ ,char))) ,char | ||
45 | ($ (or space eos))) | ||
46 | str | ||
47 | 1 beg 2 end 3))) | ||
48 | |||
49 | (define-public filters | 37 | (define-public filters |
50 | `((para | 38 | `((para |
51 | (line . ,(o (char->tag "*" "<strong>" "</strong>") | 39 | (line . ,(o (char->tag "*" "<strong>" "</strong>") |
@@ -58,16 +46,27 @@ | |||
58 | (line . ,(lambda (ln) | 46 | (line . ,(lambda (ln) |
59 | (let ((ws (cond ((list? ln) ln) | 47 | (let ((ws (cond ((list? ln) ln) |
60 | ((string? ln) (string-split ln))))) | 48 | ((string? ln) (string-split ln))))) |
61 | (list (car ws) (string-join (cdr ws))))))) | 49 | (let ((x (list (car ws) (string-join (cdr ws))))) |
50 | x))))) | ||
62 | (default | 51 | (default |
63 | (line . ,list) | 52 | (line . ,(lambda (x) (print x) (if (list? x) x (list x)))) |
64 | (block . ,identity)))) | 53 | (block . ,identity)))) |
65 | 54 | ||
55 | (define (string-join ss #!optional sep) | ||
56 | (if (string? ss) ss | ||
57 | (string-intersperse ss (or sep " ")))) | ||
58 | |||
59 | (define (char->tag char beg end) | ||
60 | (lambda (str) | ||
61 | (irregex-replace/all `(: ($ (or bos space)) | ||
62 | ,char ($ (+ (~ ,char))) ,char | ||
63 | ($ (or space eos))) | ||
64 | str | ||
65 | 1 beg 2 end 3))) | ||
66 | |||
66 | (define (get-from from type subtype) | 67 | (define (get-from from type subtype) |
67 | (or (alist-walk from type subtype) | 68 | (or (alist-walk from type subtype) |
68 | (if (eq? subtype 'inline) | 69 | (get-from from 'default subtype))) |
69 | (alist-walk from type 'list) | ||
70 | (lambda _ '(""))))) | ||
71 | 70 | ||
72 | (define (get-format type subtype) (get-from formats type subtype)) | 71 | (define (get-format type subtype) (get-from formats type subtype)) |
73 | (define (get-filter type subtype) (get-from filters type subtype)) | 72 | (define (get-filter type subtype) (get-from filters type subtype)) |
@@ -76,19 +75,19 @@ | |||
76 | (cond | 75 | (cond |
77 | ;; if LINE is a string, wrap it in a list | 76 | ;; if LINE is a string, wrap it in a list |
78 | ((string? line) | 77 | ((string? line) |
79 | (set! line (list line))) | 78 | (sprintf (get-format type 'line) |
79 | ((get-filter type 'line) line))) | ||
80 | ;; if it's a list of strings, join them together and filter them | 80 | ;; if it's a list of strings, join them together and filter them |
81 | ((and (list? line) | 81 | ((and (list? line) |
82 | (string? (car line))) | 82 | (string? (car line))) |
83 | (set! line ((get-filter type 'line) line))) | 83 | (sprintf (get-format type 'line) |
84 | (apply string-append ((get-filter type 'line) line)))) | ||
84 | ;; if the car of LINE is a symbol, it's an inline thing. | 85 | ;; if the car of LINE is a symbol, it's an inline thing. |
85 | ((and (list? line) | 86 | ((and (list? line) |
86 | (symbol? (car line))) | 87 | (symbol? (car line))) |
87 | (set! line (format-line (get-format (car line) 'inline) | 88 | (sprintf* (get-format (car line) 'inline) |
88 | ((get-filter (car line) 'line) (cdr line)) | 89 | ((get-filter (car line) 'line) (cdr line)))) |
89 | type))) | 90 | (else (error "Malformed line" line)))) |
90 | (else (error "Malformed line" line))) | ||
91 | (apply sprintf fmt line)) | ||
92 | 91 | ||
93 | (define (format-block block) | 92 | (define (format-block block) |
94 | (if (assq (car block) formats) | 93 | (if (assq (car block) formats) |
@@ -107,3 +106,17 @@ | |||
107 | (sprintf (get-format type 'block) | 106 | (sprintf (get-format type 'block) |
108 | ((get-filter type 'block) text))) | 107 | ((get-filter type 'block) text))) |
109 | "")) | 108 | "")) |
109 | |||
110 | (define (sprintf* fmt lis) | ||
111 | (let loop ((num (length (irregex-extract "~[aA]" fmt))) | ||
112 | (lis lis) | ||
113 | (out '())) | ||
114 | (cond | ||
115 | ((null? lis) | ||
116 | (apply sprintf fmt (reverse out))) | ||
117 | ((= 1 num) | ||
118 | (loop 0 '() (cons (string-join lis) out))) | ||
119 | (else | ||
120 | (loop (- num 1) | ||
121 | (cdr lis) | ||
122 | (cons (car lis) out)))))) | ||
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)))))) | ||
diff --git a/src/wrap.scm b/src/wrap.scm index 3537dea..0ed8868 100644 --- a/src/wrap.scm +++ b/src/wrap.scm | |||
@@ -1,13 +1,23 @@ | |||
1 | (declare (module (jimmy wrap))) | 1 | (declare (module (jimmy wrap))) |
2 | 2 | ||
3 | (import scheme (chicken base) | 3 | (import scheme (chicken base) |
4 | (jimmy emit) | ||
4 | (jimmy util) | 5 | (jimmy util) |
5 | (chicken format)) | 6 | (only (chicken io) read-string) |
7 | (only (chicken port) with-output-to-string) | ||
8 | (only (chicken string) string-translate*)) | ||
6 | 9 | ||
7 | ;;; open question: how to do templating? | 10 | ;; templates are strings with variables interpolated with "{{variables}}" |
8 | 11 | ||
9 | (define-public (wrap document template) | 12 | (define-public (wrap document template) |
10 | #f) | 13 | (let* ((meta (map (lambda (el) |
14 | (cons (string-append "{{" (car el) "}}") | ||
15 | (string-intersperse (cdr el) " "))) | ||
16 | (alist-walk document 'meta))) | ||
17 | (body (cons "{{body}}" | ||
18 | (with-output-to-string | ||
19 | (lambda () (emit document)))))) | ||
20 | (string-translate* template (cons body meta)))) | ||
11 | 21 | ||
12 | (define (meta-get key document) | 22 | (define-public (wrap-with document file) |
13 | (alist-walk document 'meta key)) | 23 | (wrap document (with-input-from-file file read-string))) |
diff --git a/tests/run.scm b/tests/run.scm index aa5dab1..1ec4ffe 100644 --- a/tests/run.scm +++ b/tests/run.scm | |||
@@ -55,7 +55,26 @@ end-document | |||
55 | ;;; Tests | 55 | ;;; Tests |
56 | 56 | ||
57 | (test "read" | 57 | (test "read" |
58 | '((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?*")) | 58 | '((meta ("title" "a" "test" "document") |
59 | ("date" "2024-05-13T03:02:45Z") | ||
60 | ("uuid" "b3daebf1-440b-4828-a4d9-9089c7bd7c61")) | ||
61 | (hdr1 ("a" "test" "document" "of" "some" "kind")) | ||
62 | (para "here is a test document." "it has paragraphs" (link "example.com" | ||
63 | "with" | ||
64 | "links!") | ||
65 | "and other things.") | ||
66 | (hdr2 ("a" "code" "example")) | ||
67 | (verb "for (a=1;a<=4;a++) {" "\tprintf(\"%d\\n\", a);" "}") | ||
68 | (hdr3 ("other" "examples")) | ||
69 | (quot ("a" "blockquote" "is" "a" "quote") ("that" "is" "blocky.")) | ||
70 | (list ("list" "1") ("list" "2") ("list" "3")) | ||
71 | (link ("example.com" "link" "list" "1") ("example.com" "link" "list" | ||
72 | "2") ("example.com" "link" | ||
73 | "list" "3")) | ||
74 | (para "ok, now for another test:" "will *strong* in-line text be | ||
75 | converted?" "as well as `code`, _emph_ and such?" "what if *i _nest_ them*" | ||
76 | "what if *i _nest them* wrong_ ?" "what about *breaking them" "over two | ||
77 | lines?*")) | ||
59 | (call-with-input-string test-doc parse)) | 78 | (call-with-input-string test-doc parse)) |
60 | 79 | ||
61 | (test-exit) | 80 | (test-exit) |
diff --git a/tests/test.gmi b/tests/test.gmi new file mode 100644 index 0000000..38af5ea --- /dev/null +++ b/tests/test.gmi | |||
@@ -0,0 +1,37 @@ | |||
1 | : title a test document | ||
2 | : date 2024-05-13T03:02:45Z | ||
3 | : uuid b3daebf1-440b-4828-a4d9-9089c7bd7c61 | ||
4 | |||
5 | # a test document of some kind | ||
6 | |||
7 | here is a test document. | ||
8 | it has paragraphs | ||
9 | => example.com with links! | ||
10 | and other things. | ||
11 | |||
12 | ## a code example | ||
13 | ``` | ||
14 | for (a=1;a<=4;a++) { | ||
15 | printf("%d\n", a); | ||
16 | } | ||
17 | ``` | ||
18 | |||
19 | ### other examples | ||
20 | |||
21 | > a blockquote is a quote | ||
22 | > that is blocky. | ||
23 | |||
24 | * list 1 | ||
25 | * list 2 | ||
26 | * list 3 | ||
27 | => example.com link list 1 | ||
28 | => example.com link list 2 | ||
29 | => example.com link list 3 | ||
30 | |||
31 | ok, now for another test: | ||
32 | will *strong* in-line text be converted? | ||
33 | as well as `code`, _emph_ and such? | ||
34 | what if *i _nest_ them* | ||
35 | what if *i _nest them* wrong_ ? | ||
36 | what about *breaking them | ||
37 | over two lines?* | ||