about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2024-05-18 21:15:54 -0500
committerCase Duckworth2024-05-18 21:15:54 -0500
commit727995a409632d4c143ba4b6b088c7df40f074e7 (patch)
tree3b2f291b2353314971288c0c3ad86d3825c6f825
parentRemove old code (diff)
downloadjimmy-727995a409632d4c143ba4b6b088c7df40f074e7.tar.gz
jimmy-727995a409632d4c143ba4b6b088c7df40f074e7.zip
Scheme bit!
-rw-r--r--Makefile40
-rw-r--r--jimmy.egg17
-rw-r--r--src/emit.scm109
-rw-r--r--src/html.scm3
-rw-r--r--src/read.scm74
-rw-r--r--src/util.scm37
-rw-r--r--src/wrap.scm13
-rw-r--r--tests/run.scm61
8 files changed, 354 insertions, 0 deletions
diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..0b8e141 --- /dev/null +++ b/Makefile
@@ -0,0 +1,40 @@
1NAME = jimmy
2
3CSC = /usr/bin/csc
4CSI = /usr/bin/csi
5CSC_OPTIONS = \
6 -host \
7 -D compiling-extension \
8 -emit-all-import-libraries \
9 -dynamic \
10 -regenerate-import-libraries \
11 -setup-mode \
12 -I $(PWD) \
13 -C -I$(PWD) \
14
15CSC_OPTIONS_EXTRA = \
16 -X utf8 \
17 -X module-declarations
18
19BUILD = $(PWD)/build
20
21.PHONY: all test
22build: $(patsubst src/%.scm,$(BUILD)/%.so,$(wildcard src/*.scm))
23
24test: build
25 $(CSI) -s $(PWD)/tests/run.scm $(NAME)
26
27# Program!
28
29# Libraries!
30
31$(BUILD)/%.so: src/%.scm
32 mkdir -p "$(dir $@)"
33 $(CSC) $(CSC_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@
34
35## Library dependency graph
36# here's a convenience macro
37lib = $(BUILD)/$(NAME).$(1).so
38
39$(call lib,read): $(call lib,util)
40$(call lib,emit): $(call lib,util)
diff --git a/jimmy.egg b/jimmy.egg new file mode 100644 index 0000000..108cf7d --- /dev/null +++ b/jimmy.egg
@@ -0,0 +1,17 @@
1((author "Case Duckworth")
2 (synopsis "The ssg king")
3 (dependencies (chicken "5.3.0")
4 module-declarations
5 utf8)
6 (test-dependencies test)
7 (component-options
8 (csc-options -X utf8 -X module-declarations))
9 (components
10 (extension jimmy.util
11 (source src/util.scm))
12 (extension jimmy.read
13 (source src/read.scm)
14 (component-dependencies jimmy.util))
15 (extension jimmy.emit
16 (source src/emit.scm)
17 (component-dependencies jimmy.util))))
diff --git a/src/emit.scm b/src/emit.scm new file mode 100644 index 0000000..aa36eb5 --- /dev/null +++ b/src/emit.scm
@@ -0,0 +1,109 @@
1(declare (module (jimmy emit)))
2
3(import scheme (chicken base)
4 (jimmy util)
5 (chicken format)
6 (chicken irregex)
7 (chicken string))
8
9(define-public (emit document)
10 (for-each display
11 (map format-block document)))
12
13(define-public formats
14 ;;; (type line-format block-format [line-in-block-format])
15 ;; these default to gemtext
16 '((para (line . "~A ")
17 (block . "~A~%~%"))
18 (verb (line . "~A~%")
19 (block . "```~%~A```~%~%"))
20 (link (line . "=> ~A ~A~%")
21 (block . "~A~%")
22 (inline . "~%=> ~A ~A~%")) ;TODO: have 2 args to format
23 (list (line . "* ~A~%")
24 (block . "~A~%"))
25 (quot (line . "~A ")
26 (block . "> ~A~%~%"))
27 (hdr1 (line . "# ~A~%")
28 (block . "~A~%"))
29 (hdr2 (line . "## ~A~%")
30 (block . "~A~%"))
31 (hdr3 (line . "### ~A~%")
32 (block . "~A~%"))
33 (default
34 (line . "~A")
35 (block . "~A~%~%"))))
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
50 `((para
51 (line . ,(o (char->tag "*" "<strong>" "</strong>")
52 (char->tag "_" "<em>" "</em>")
53 (char->tag "`" "<code>" "</code>")
54 string-join))
55 (block . ,(lambda (ln)
56 (irregex-replace/all '(: bol (* " ")) ln ""))))
57 (link
58 (line . ,(lambda (ln)
59 (let ((ws (cond ((list? ln) ln)
60 ((string? ln) (string-split ln)))))
61 (list (car ws) (string-join (cdr ws)))))))
62 (default
63 (line . ,list)
64 (block . ,identity))))
65
66(define (get-from from type subtype)
67 (or (alist-walk from type subtype)
68 (if (eq? subtype 'inline)
69 (alist-walk from type 'list)
70 (lambda _ '("")))))
71
72(define (get-format type subtype) (get-from formats type subtype))
73(define (get-filter type subtype) (get-from filters type subtype))
74
75(define (format-line fmt line type)
76 (cond
77 ;; if LINE is a string, wrap it in a list
78 ((string? line)
79 (set! line (list line)))
80 ;; if it's a list of strings, join them together and filter them
81 ((and (list? line)
82 (string? (car line)))
83 (set! line ((get-filter type 'line) line)))
84 ;; if the car of LINE is a symbol, it's an inline thing.
85 ((and (list? line)
86 (symbol? (car line)))
87 (set! line (format-line (get-format (car line) 'inline)
88 ((get-filter (car line) 'line) (cdr line))
89 type)))
90 (else (error "Malformed line" line)))
91 (apply sprintf fmt line))
92
93(define (format-block block)
94 (if (assq (car block) formats)
95 (let* ((type (car block))
96 (data (cdr block))
97 (text (cond
98 ((string? data) data)
99 ((list? data)
100 (apply string-append
101 (map (lambda (ln)
102 (format-line (get-format type 'line)
103 ln
104 type))
105 data)))
106 (else (error "Malformed block" block)))))
107 (sprintf (get-format type 'block)
108 ((get-filter type 'block) text)))
109 ""))
diff --git a/src/html.scm b/src/html.scm new file mode 100644 index 0000000..371d407 --- /dev/null +++ b/src/html.scm
@@ -0,0 +1,3 @@
1(declare (module (jimmy html)))
2
3
diff --git a/src/read.scm b/src/read.scm new file mode 100644 index 0000000..00ffad4 --- /dev/null +++ b/src/read.scm
@@ -0,0 +1,74 @@
1(declare (module (jimmy read)))
2
3(import scheme (chicken base)
4 (jimmy util)
5 (only (chicken condition) handle-exceptions)
6 (only (chicken io) read-lines)
7 (only (chicken string) string-split))
8
9(define-public line-types
10 ;; (sigil type inlines preproc)
11 '(("=>" link)
12 (">" quot)
13 ("#" hdr1)
14 ("##" hdr2)
15 ("###" hdr3)
16 ("*" list)
17 ("```" verb)
18 ;; extra!
19 (":" meta)))
20
21(define-public (parse inport)
22 (parse-lines (read-lines inport) '()))
23
24(define (line-type line)
25 (let ((it (assoc (car (string-split line)) line-types)))
26 (if it (cadr it)
27 'para)))
28
29(define (parse-lines lines document)
30 (if (null? lines) (reverse document)
31 (let ((words (string-split (car lines))))
32 (cond
33 ((null? words)
34 (parse-lines (cdr lines) document))
35 ((equal? (car words) "```")
36 (parse-verbatim (cdr lines) document '()))
37 ((assoc (car words) line-types)
38 => (lambda (it)
39 (apply parse-block lines document '() (cdr it))))
40 (else
41 (parse-block lines document '() 'para '(link) identity))))))
42
43(define (parse-verbatim lines document verb)
44 (cond
45 ((null? lines)
46 (parse-lines lines (cons (cons 'verb (reverse verb)) document)))
47 ((equal? (car lines) "```")
48 (parse-lines (cdr lines) (cons (cons 'verb (reverse verb)) document)))
49 (else
50 (parse-verbatim (cdr lines) document (cons (car lines) verb)))))
51
52(define (parse-block lines document block type #!optional inlines preproc)
53 (let ((inlines (or inlines '()))
54 (preproc (or preproc (lambda (ln) (cdr (string-split ln))))))
55 (cond
56 ((null? lines)
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))
65 (ws (string-split ln))
66 (lt (cdr (assoc (car ws) line-types))))
67 (parse-block (cdr lines) document
68 (cons (cons (car lt)
69 ((or (ignore-errors (caddr lt)) cdr) ws))
70 block)
71 type inlines preproc)))
72 (else
73 (parse-block (cdr lines) document (cons (preproc (car lines)) block)
74 type inlines preproc)))))
diff --git a/src/util.scm b/src/util.scm new file mode 100644 index 0000000..7bf89ac --- /dev/null +++ b/src/util.scm
@@ -0,0 +1,37 @@
1(module (jimmy util) *
2
3 (import scheme (chicken base)
4 (chicken condition))
5
6 (define-syntax define-public
7 (syntax-rules ()
8 ((define-public (name . arg) forms ...)
9 (begin (export name)
10 (define (name . arg) forms ...)))
11 ((define-public (name args ...) forms ...)
12 (begin (export name)
13 (define (name args ...) forms ...)))
14 ((define-public name value)
15 (begin (export name)
16 (define name value)))))
17
18 (define-syntax ignore-errors
19 (syntax-rules ()
20 ((ignore-errors x)
21 (handle-exceptions e #f x))))
22
23 (define (alist-walk lis . keys)
24 (if (null? keys)
25 lis
26 (let ((kv (assoc (car keys) lis)))
27 (cond
28 ((not kv) #f)
29 ((atom? (cdr kv))
30 (and (null? (cdr keys)) ; this shouldn't error...
31 (cdr kv)))
32 ((list? (cdr kv))
33 (apply alist-walk (cdr kv) (cdr keys)))))))
34
35 )
36
37
diff --git a/src/wrap.scm b/src/wrap.scm new file mode 100644 index 0000000..3537dea --- /dev/null +++ b/src/wrap.scm
@@ -0,0 +1,13 @@
1(declare (module (jimmy wrap)))
2
3(import scheme (chicken base)
4 (jimmy util)
5 (chicken format))
6
7;;; open question: how to do templating?
8
9(define-public (wrap document template)
10 #f)
11
12(define (meta-get key document)
13 (alist-walk document 'meta key))
diff --git a/tests/run.scm b/tests/run.scm new file mode 100644 index 0000000..aa5dab1 --- /dev/null +++ b/tests/run.scm
@@ -0,0 +1,61 @@
1(import scheme
2 (chicken base)
3 (chicken load)
4 (chicken port)
5 (chicken process-context)
6 test)
7
8;;; Setup
9
10(import (jimmy emit)
11 (jimmy read)
12 #;(jimmy wrap))
13
14(define test-doc #<<end-document
15: title a test document
16: date 2024-05-13T03:02:45Z
17: uuid b3daebf1-440b-4828-a4d9-9089c7bd7c61
18
19# a test document of some kind
20
21here is a test document.
22it has paragraphs
23=> example.com with links!
24and other things.
25
26## a code example
27```
28for (a=1;a<=4;a++) {
29 printf("%d\n", a);
30}
31```
32
33### other examples
34
35> a blockquote is a quote
36> that is blocky.
37
38* list 1
39* list 2
40* list 3
41=> example.com link list 1
42=> example.com link list 2
43=> example.com link list 3
44
45ok, now for another test:
46will *strong* in-line text be converted?
47as well as `code`, _emph_ and such?
48what if *i _nest_ them*
49what if *i _nest them* wrong_ ?
50what about *breaking them
51over two lines?*
52end-document
53)
54
55;;; Tests
56
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?*"))
59 (call-with-input-string test-doc parse))
60
61(test-exit)