about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2024-05-26 22:49:44 -0500
committerCase Duckworth2024-05-26 22:52:25 -0500
commit815e669310f5e73d13cc121bd7f6cdaec5b6ec0d (patch)
tree1d3ab042bb6ffc2302a0a03b61147e5b4a649960
parentScheme bit! (diff)
downloadjimmy-815e669310f5e73d13cc121bd7f6cdaec5b6ec0d.tar.gz
jimmy-815e669310f5e73d13cc121bd7f6cdaec5b6ec0d.zip
Updates!
I totally forgot to actually commit things for a while, so uh

Updates!!!
-rw-r--r--.gitignore1
-rw-r--r--Makefile51
-rw-r--r--src/emit.scm61
-rw-r--r--src/read.scm95
-rw-r--r--src/wrap.scm20
-rw-r--r--tests/run.scm21
-rw-r--r--tests/test.gmi37
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 @@
1NAME = jimmy 1NAME = jimmy
2 2
3LIBS = read emit util
4
5BUILD = $(PWD)/build
6SRC = $(PWD)/src
7
3CSC = /usr/bin/csc 8CSC = /usr/bin/csc
4CSI = /usr/bin/csi 9CSI = /usr/bin/csi
5CSC_OPTIONS = \ 10CSC_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
15CSC_OPTIONS_EXTRA = \ 20CSC_OPTIONS_EXTRA = \
16 -X utf8 \ 21 -X utf8 \
17 -X module-declarations 22 -X module-declarations
18 23
19BUILD = $(PWD)/build 24## Library dependency graph
25# here's a convenience macro
26lib = $(BUILD)/$(NAME).$(1).so
27# and another
28src = $(SRC)/$(1).scm
29
30LIBS_ = $(foreach l,$(LIBS),$(call lib,$(l)))
31
32## Phonies
20 33
21.PHONY: all test 34.PHONY: build test clean
22build: $(patsubst src/%.scm,$(BUILD)/%.so,$(wildcard src/*.scm)) 35build: $(LIBS_)
36 -mv *.import.scm build/
23 37
24test: build 38test: 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! 42clean:
43 -rm -rf $(BUILD)
28 44
29# Libraries! 45install:
46 chicken-install -s
47
48uninstall:
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)
37lib = $(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
75converted?" "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
77lines?*"))
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
7here is a test document.
8it has paragraphs
9=> example.com with links!
10and other things.
11
12## a code example
13```
14for (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
31ok, now for another test:
32will *strong* in-line text be converted?
33as well as `code`, _emph_ and such?
34what if *i _nest_ them*
35what if *i _nest them* wrong_ ?
36what about *breaking them
37over two lines?*