From 815e669310f5e73d13cc121bd7f6cdaec5b6ec0d Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sun, 26 May 2024 22:49:44 -0500 Subject: Updates! I totally forgot to actually commit things for a while, so uh Updates!!! --- .gitignore | 1 + Makefile | 51 ++++++++++++++++++++++--------- src/emit.scm | 61 ++++++++++++++++++++++--------------- src/read.scm | 95 +++++++++++++++++++++++++++++----------------------------- src/wrap.scm | 20 +++++++++---- tests/run.scm | 21 ++++++++++++- tests/test.gmi | 37 +++++++++++++++++++++++ 7 files changed, 194 insertions(+), 92 deletions(-) create mode 100644 .gitignore create mode 100644 tests/test.gmi 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 @@ 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! 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 @@ (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 "*" "" "") @@ -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)))))) 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 @@ (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)))))) 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 @@ (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))) 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 ;;; 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) 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 @@ +: 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?* -- cgit 1.4.1-21-gabe81