From 727995a409632d4c143ba4b6b088c7df40f074e7 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Sat, 18 May 2024 21:15:54 -0500
Subject: Scheme bit!
---
Makefile | 40 +++++++++++++++++++++
jimmy.egg | 17 +++++++++
src/emit.scm | 109 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/html.scm | 3 ++
src/read.scm | 74 +++++++++++++++++++++++++++++++++++++++
src/util.scm | 37 ++++++++++++++++++++
src/wrap.scm | 13 +++++++
tests/run.scm | 61 ++++++++++++++++++++++++++++++++
8 files changed, 354 insertions(+)
create mode 100644 Makefile
create mode 100644 jimmy.egg
create mode 100644 src/emit.scm
create mode 100644 src/html.scm
create mode 100644 src/read.scm
create mode 100644 src/util.scm
create mode 100644 src/wrap.scm
create mode 100644 tests/run.scm
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..0b8e141
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,40 @@
+NAME = jimmy
+
+CSC = /usr/bin/csc
+CSI = /usr/bin/csi
+CSC_OPTIONS = \
+ -host \
+ -D compiling-extension \
+ -emit-all-import-libraries \
+ -dynamic \
+ -regenerate-import-libraries \
+ -setup-mode \
+ -I $(PWD) \
+ -C -I$(PWD) \
+
+CSC_OPTIONS_EXTRA = \
+ -X utf8 \
+ -X module-declarations
+
+BUILD = $(PWD)/build
+
+.PHONY: all test
+build: $(patsubst src/%.scm,$(BUILD)/%.so,$(wildcard src/*.scm))
+
+test: build
+ $(CSI) -s $(PWD)/tests/run.scm $(NAME)
+
+# Program!
+
+# Libraries!
+
+$(BUILD)/%.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
+
+$(call lib,read): $(call lib,util)
+$(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 @@
+((author "Case Duckworth")
+ (synopsis "The ssg king")
+ (dependencies (chicken "5.3.0")
+ module-declarations
+ utf8)
+ (test-dependencies test)
+ (component-options
+ (csc-options -X utf8 -X module-declarations))
+ (components
+ (extension jimmy.util
+ (source src/util.scm))
+ (extension jimmy.read
+ (source src/read.scm)
+ (component-dependencies jimmy.util))
+ (extension jimmy.emit
+ (source src/emit.scm)
+ (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 @@
+(declare (module (jimmy emit)))
+
+(import scheme (chicken base)
+ (jimmy util)
+ (chicken format)
+ (chicken irregex)
+ (chicken string))
+
+(define-public (emit document)
+ (for-each display
+ (map format-block document)))
+
+(define-public formats
+ ;;; (type line-format block-format [line-in-block-format])
+ ;; these default to gemtext
+ '((para (line . "~A ")
+ (block . "~A~%~%"))
+ (verb (line . "~A~%")
+ (block . "```~%~A```~%~%"))
+ (link (line . "=> ~A ~A~%")
+ (block . "~A~%")
+ (inline . "~%=> ~A ~A~%")) ;TODO: have 2 args to format
+ (list (line . "* ~A~%")
+ (block . "~A~%"))
+ (quot (line . "~A ")
+ (block . "> ~A~%~%"))
+ (hdr1 (line . "# ~A~%")
+ (block . "~A~%"))
+ (hdr2 (line . "## ~A~%")
+ (block . "~A~%"))
+ (hdr3 (line . "### ~A~%")
+ (block . "~A~%"))
+ (default
+ (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 "*" "" "")
+ (char->tag "_" "" "")
+ (char->tag "`" "" "")
+ string-join))
+ (block . ,(lambda (ln)
+ (irregex-replace/all '(: bol (* " ")) ln ""))))
+ (link
+ (line . ,(lambda (ln)
+ (let ((ws (cond ((list? ln) ln)
+ ((string? ln) (string-split ln)))))
+ (list (car ws) (string-join (cdr ws)))))))
+ (default
+ (line . ,list)
+ (block . ,identity))))
+
+(define (get-from from type subtype)
+ (or (alist-walk from type subtype)
+ (if (eq? subtype 'inline)
+ (alist-walk from type 'list)
+ (lambda _ '("")))))
+
+(define (get-format type subtype) (get-from formats type subtype))
+(define (get-filter type subtype) (get-from filters type subtype))
+
+(define (format-line fmt line type)
+ (cond
+ ;; if LINE is a string, wrap it in a list
+ ((string? line)
+ (set! line (list 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)))
+ ;; 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))
+
+(define (format-block block)
+ (if (assq (car block) formats)
+ (let* ((type (car block))
+ (data (cdr block))
+ (text (cond
+ ((string? data) data)
+ ((list? data)
+ (apply string-append
+ (map (lambda (ln)
+ (format-line (get-format type 'line)
+ ln
+ type))
+ data)))
+ (else (error "Malformed block" block)))))
+ (sprintf (get-format type 'block)
+ ((get-filter type 'block) text)))
+ ""))
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 @@
+(declare (module (jimmy html)))
+
+
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 @@
+(declare (module (jimmy read)))
+
+(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)
+ (">" quot)
+ ("#" hdr1)
+ ("##" hdr2)
+ ("###" hdr3)
+ ("*" list)
+ ("```" verb)
+ ;; extra!
+ (":" meta)))
+
+(define-public (parse inport)
+ (parse-lines (read-lines inport) '()))
+
+(define (line-type line)
+ (let ((it (assoc (car (string-split line)) line-types)))
+ (if it (cadr it)
+ 'para)))
+
+(define (parse-lines lines document)
+ (if (null? lines) (reverse document)
+ (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))))))
+
+(define (parse-verbatim lines document verb)
+ (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)))))
+
+(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)
+ (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)))))
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 @@
+(module (jimmy util) *
+
+ (import scheme (chicken base)
+ (chicken condition))
+
+ (define-syntax define-public
+ (syntax-rules ()
+ ((define-public (name . arg) forms ...)
+ (begin (export name)
+ (define (name . arg) forms ...)))
+ ((define-public (name args ...) forms ...)
+ (begin (export name)
+ (define (name args ...) forms ...)))
+ ((define-public name value)
+ (begin (export name)
+ (define name value)))))
+
+ (define-syntax ignore-errors
+ (syntax-rules ()
+ ((ignore-errors x)
+ (handle-exceptions e #f x))))
+
+ (define (alist-walk lis . keys)
+ (if (null? keys)
+ lis
+ (let ((kv (assoc (car keys) lis)))
+ (cond
+ ((not kv) #f)
+ ((atom? (cdr kv))
+ (and (null? (cdr keys)) ; this shouldn't error...
+ (cdr kv)))
+ ((list? (cdr kv))
+ (apply alist-walk (cdr kv) (cdr keys)))))))
+
+ )
+
+
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 @@
+(declare (module (jimmy wrap)))
+
+(import scheme (chicken base)
+ (jimmy util)
+ (chicken format))
+
+;;; open question: how to do templating?
+
+(define-public (wrap document template)
+ #f)
+
+(define (meta-get key document)
+ (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 @@
+(import scheme
+ (chicken base)
+ (chicken load)
+ (chicken port)
+ (chicken process-context)
+ test)
+
+;;; Setup
+
+(import (jimmy emit)
+ (jimmy read)
+ #;(jimmy wrap))
+
+(define test-doc #< 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?*
+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?*"))
+ (call-with-input-string test-doc parse))
+
+(test-exit)
--
cgit 1.4.1-21-gabe81