commit 04e8a0d5ae677cf374c0c598dca57c57fe37384f Author: Daniel Ziltener Date: Wed Feb 19 01:29:52 2020 +0100 In the beginning there was darkness diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..381df36 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*~ +*.c \ No newline at end of file diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..0d49488 --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +Copyright (c) 2013, Daniel Ziltener +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + + Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + + Redistributions in binary form must reproduce the above copyright notice, this + list of conditions and the following disclaimer in the documentation and/or + other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..a4c160b --- /dev/null +++ b/README.md @@ -0,0 +1,51 @@ +[![License](//img.shields.io/badge/license-BSD-blue.svg?style=flat)]() +[![Boot](//img.shields.io/badge/Chicken-Scheme-ECC42F.svg?style=flat)](http://www.call-cc.org/) +[![Clojars](//img.shields.io/badge/Eggversion-0.5.1-blue.svg?style=flat)](http://wiki.call-cc.org/eggref/4/edn) +[![Gratipay](//img.shields.io/gratipay/zilti.svg?style=flat)](//gratipay.com/zilti) +[![Flattr this](//api.flattr.com/button/flattr-badge-small.png)](https://flattr.com/submit/auto?user_id=zilti&url=https%3A%2F%2Fbitbucket.org%2Fzilti%2Fedn) + +chicken-edn +=========== + +An [EDN](https://github.com/edn-format/edn) reader and writer for chicken scheme. + +Installation: `chicken-install edn` + +Data type conversions +--------------------- + + * All kinds of numbers get converted to Scheme numbers, precision suffixes (N and M) get ignored. + * Keywords :keyword get converted to chicken scheme keywords keyword:. + * Maps get converted to SRFI 69 hashtables. + * Vectors are srfi-4 vectors. + * true = #t, false = #f, nil = '() + +Missing reader functionality +---------------------------- +Should you notice missing functionality of the reader, plesase use [the issues page](https://bitbucket.org/zilti/edn/issues?status=new&status=open) to report +it and, if possible, provide a minimal test case. + +API +--- + +* Transforming EDN into Chicken: `(with-input-from-port read-edn)` +* Transforming Chicken into EDN: `(with-output-to-port (write-edn ))` +* Using reader tags: the library contains a public a-list `tag-handlers`. To register a handler, add an a-list entry where the key is the tag without `\#` and as a keyword, and the value a one-argument procedure. + +Releases +-------- + + * **0.5.1**: Small compatibility improvements: "/" now starts a symbol as well, and "," is treated as whitespace. + * **0.5**: Reader tag support. + * **0.4**: Complete rewrite. Only relies on R7RS, and SRFI 1, 4, 69 and 88. Uses ports. Reads and writes EDN. + * **0.3**: EDN tags, including special forms, work. #inst and #uuid both get read as strings. Add nil. Add number prefixes. Add no-space-required to #_ tag. + * **0.2.1**: Can read EDN-files and -strings. EDN tags are not working yet. + * **0.2**: Can read EDN-strings with one top-level data structure. + +Roadmap +------- + + +About +----- +Written by Daniel Ziltener. EDN written by Rich Hickey. The EDN specification is available at [https://github.com/edn-format/edn](https://github.com/edn-format/edn). diff --git a/edn-impl.scm b/edn-impl.scm new file mode 100644 index 0000000..5fd0c8b --- /dev/null +++ b/edn-impl.scm @@ -0,0 +1,322 @@ +(import scheme + srfi-69 + srfi-1 + (chicken keyword) + (chicken port)) +;; EDN Reading +;; =========== + +(define (is-char? a) + (lambda (b) + (and (char? b) + (char=? a b)))) + +(define (is-number? c) + (or (char-numeric? c) + (char=? #\+ c) + (char=? #\- c))) + +(define (is-whitespace? c) + (or (char-whitespace? c) + (char=? #\, c))) + +(define (is-endingchar? c) + (or (char=? #\# c) + (char=? #\) c) + (char=? #\] c) + (char=? #\} c))) + +(define (is-symbolstarter? c) + (or (char-alphabetic? c) + (char=? #\/ c))) + +(define edn->atom + (case-lambda + ((skip-fn end-fn finalizer) (lambda (subparser input) + (edn->atom subparser skip-fn end-fn finalizer '() '() input))) + ((subparser skip-fn end-fn finalizer result pile input) + (cond ((or (eq? #!eof (peek-char input)) + (end-fn result pile input)) + (cons (finalizer (reverse result)) + (if (or (not (char-ready? input)) + (is-endingchar? (peek-char input))) + input + (begin (read-char input) input)))) + ((skip-fn result pile input) + (edn->atom subparser skip-fn end-fn finalizer result (cons (read-char input) pile) input)) + (else (edn->atom subparser skip-fn end-fn finalizer (cons (peek-char input) result) (cons (peek-char input) pile) + (if (null? input) input (begin (read-char input) input)))))))) + +(define edn->string + (edn->atom (lambda (result pile input) + (or (char=? #\\ (peek-char input)) + (and (null? result) + (char=? #\" (peek-char input))))) + (lambda (result pile input) + (and (char=? #\" (peek-char input)) + (not (null? pile)) + (or (not (char=? #\\ (car pile))) + (char=? #\" (car pile))))) + list->string)) + +(define edn->keyword + (edn->atom (lambda (result pile input) + (char=? #\: (peek-char input))) + (lambda (result pile input) + (or (is-whitespace? (peek-char input)) + (is-endingchar? (peek-char input)))) + (lambda (in) (string->keyword (list->string in))))) + +(define edn->symbol + (edn->atom (lambda (result pile input) #f) + (lambda (result pile input) + (or (is-whitespace? (peek-char input)) + (is-endingchar? (peek-char input)))) + (lambda (in) (let ((res-string (list->string in))) + (cond + ((equal? "true" res-string) #t) + ((equal? "false" res-string) #f) + ((equal? "nil" res-string) '()) + (else (string->symbol res-string))))))) + +(define edn->number + (edn->atom (lambda (result pile input) #f) + (lambda (result pile input) + (or (is-whitespace? (peek-char input)) + (is-endingchar? (peek-char input)) + (char=? #\M (peek-char input)) + (char=? #\N (peek-char input)))) + (lambda (in) (string->number (list->string in))))) + +(define edn->rtag + (edn->atom (lambda (result pile input) + (char=? #\# (peek-char input))) + (lambda (result pile input) + (or (is-whitespace? (peek-char input)) + (char=? #\( (peek-char input)) + (char=? #\[ (peek-char input)) + (and (not (null? pile)) + (char=? #\{ (car pile))))) + (lambda (in) (cons edn/tag: (string->keyword (list->string in)))))) + +(define edn->coll + (case-lambda + ((ld rd finalize) (lambda (subparser input) (edn->coll subparser ld rd finalize '() input #t))) + ((subparser ld rd finalize result input fresh?) + (cond + ;; End of sequence + ((or (eq? #!eof (peek-char input)) + (char=? rd (peek-char input))) + (cons (finalize (reverse result)) (begin (read-char input) input))) + ;; First character of sequence + ((and (char=? ld (peek-char input)) + fresh?) + (edn->coll subparser ld rd finalize result (begin (read-char input) input) #f)) + ;; Sub-sequence of same type + ((char=? ld (peek-char input)) + (let ((sub-result (subparser input))) + (edn->coll subparser ld rd finalize (cons (cadr sub-result) result) (caddr sub-result) #f))) + ;; Stuff in the data! + (else (let ((compiled (subparser input))) + (edn->coll (first compiled) + ld rd finalize + (if (equal? (second compiled) edn/omit:) + result + (cons (second compiled) result)) + (third compiled) #f))))))) + +(define edn->list (edn->coll #\( #\) (lambda (x) x))) +(define edn->vector (edn->coll #\[ #\] (lambda (x) (list->vector x)))) + +(define edn->htable + (case-lambda + ((subparser input) (edn->htable subparser (make-hash-table) '() input #t)) + ((subparser result key input fresh?) + (cond ((or (eq? #!eof (peek-char input)) + (char=? #\} (peek-char input))) + (cons result (begin (read-char input) input))) + ((and (char=? #\{ (peek-char input)) + fresh?) + (edn->htable subparser result key (begin (read-char input) input) #f)) + (else (let ((compiled (subparser input))) + (cond + ((eq? edn/omit: (second compiled)) + (edn->htable (first compiled) result key (third compiled) #f)) + ((null? key) + (edn->htable (first compiled) result (second compiled) (third compiled) #f)) + (else + (edn->htable (first compiled) (begin (hash-table-set! result key (second compiled)) result) + '() (third compiled) #f))))))))) + +(define (edn->whitespace subparser input) + (if (char-whitespace? (peek-char input)) + (cons edn/omit: (begin (read-char input) input)) + (cons (read-char input) input))) + +(define (guard-charcheck fun) + (lambda (x) + (and (char? x) + (fun x)))) + +@(heading "Reading EDN") + +(define tag-handlers @("An a-list containing the handlers for reader tags. You can register your own reader tags by simply adding a new a-list entry. + +Example for a tag \"#keywordify\": add the entry `(cons keywordify: keywordify-procedure)`.") + (list (cons _: (lambda (input) edn/omit:)))) + +(define reader-handlers + (list (cons (is-char? #\() edn->list) + (cons (is-char? #\)) edn->list) + (cons (is-char? #\[) edn->vector) + (cons (is-char? #\]) edn->vector) + (cons (is-char? #\{) edn->htable) + (cons (is-char? #\}) edn->htable) + (cons (is-char? #\#) edn->rtag) + (cons (is-char? #\:) edn->keyword) + (cons (is-char? #\") edn->string) + (cons (guard-charcheck is-symbolstarter?) edn->symbol) + (cons (guard-charcheck is-number?) edn->number) + (cons (guard-charcheck is-whitespace?) edn->whitespace))) + +(define (is-tag? in) + (and (pair? in) + (pair? (car in)) + (equal? (caar in) edn/tag:) + (contains-tag-handler? (car in)))) + +(define (contains-tag-handler? tag) + (assoc (cdr tag) tag-handlers)) + +(define (call-tag tag data) + ((cdr (assoc (cdr tag) tag-handlers)) data)) + +(define (parse-edn state) + (lambda (in-port) + (let* ((struct-handler (cdr + (find (lambda (item) ((car item) (peek-char in-port))) + reader-handlers))) + (result (struct-handler (parse-edn state) in-port))) + (list (if (is-tag? result) + (parse-edn result) + (parse-edn '())) + (cond ((is-tag? state) + (call-tag (car state) (car result))) + ((is-tag? result) + edn/omit:) + (else (car result))) + (cdr result))))) + +(define (read-edn) + @("Reads EDN data from the `current-input-port`, converts it to Chicken data and returns it. Precision suffixes for numbers get ignored, maps get converted to SRFI-69 hashtables, vectors to SRFI-4 vectors.") + (second ((parse-edn '()) (current-input-port)))) + +;; EDN writing +;; =========== + +(define (pair->reader-tag subparser in) + (string-append "#" (keyword->string (cdr in)))) + +(define (scm-kw->edn-kw subparser in) + (string-append ":" (keyword->string in))) + +(define (boolean->edn subparser in) + (case in + ((#t) "true") + ((#f) "false") + (else "nil"))) + +(define (char->edn subparser in) + (string #\\ in)) + +(define (string->edn subparser in) + (string-append "\"" in "\"")) + +(define (number->edn subparser in) + (number->string in)) + +(define (sequential->edn subparser ld rd in) + (string-append ld + (foldr (lambda (elem init) + (string-append (subparser elem) + (if (equal? "" init) "" " ") + init)) + "" in) + rd)) + +(define (list->edn subparser in) + (sequential->edn subparser "(" ")" in)) + +(define (vector->edn subparser in) + (sequential->edn subparser "[" "]" (vector->list in))) + +(define (map->edn subparser in) + (string-append "{" + (foldr (lambda (elem init) + (string-append (subparser (car elem)) + " " + (subparser (cdr elem)) + (if (equal? "" init) "" " ") + init)) + "" in) + "}")) + +(define (htable->edn subparser in) + (string-append "{" + (hash-table-fold in + (lambda (hkey hval folded) + (string-append (subparser hkey) + " " + (subparser hval) + (if (equal? "" folded) "" " ") + folded)) + "") + "}")) + +(define (nil->edn subparser in) + "nil") + +(define (symbol->edn subparser in) + (symbol->string in)) + +(define (edn-readertag? in) + (and + (not (list? in)) + (pair? in) + (equal? edn/reader-tag: (car in)))) + +(define (edn-alist? in) + (and (list? in) + (any (lambda (item) (and (not (list? item)) (pair? item))) + in))) + +(define (edn-htable? in) + (hash-table? in)) + +(define writer-handlers + (list (cons null? nil->edn) + (cons string? string->edn) + (cons char? char->edn) + (cons boolean? boolean->edn) + (cons number? number->edn) + (cons keyword? scm-kw->edn-kw) + (cons symbol? symbol->edn) + (cons vector? vector->edn) + (cons edn-alist? map->edn) + (cons edn-htable? htable->edn) + (cons edn-readertag? pair->reader-tag) + (cons list? list->edn))) + +(define (parse-entry in) + ((cdr + (find (lambda (item) ((car item) in)) + writer-handlers)) + parse-entry in)) + +@(heading "Writing EDN") + +(define (write-edn struct) + @("Converts Chicken data structures to EDN and writes it to the `current-output-port`." + (struct "A Chicken data structure consisting of atoms, lists, vectors and hashtables.")) + (lambda () + (display (parse-entry struct) (current-output-port)))) diff --git a/edn.egg b/edn.egg new file mode 100644 index 0000000..0d6a834 --- /dev/null +++ b/edn.egg @@ -0,0 +1,11 @@ +;;; -*- scheme -*- + +((author "Daniel Ziltener") + (synopsis "EDN data reader/writer.") + (category parsing) + (license "BSD") + (dependencies hahn srfi-69 srfi-1) + (test-dependencies srfi-64) + (components (extension edn + (modules edn) + (csc-options "-X" "hahn")))) diff --git a/edn.scm b/edn.scm new file mode 100644 index 0000000..3128da0 --- /dev/null +++ b/edn.scm @@ -0,0 +1,10 @@ +@(heading "EDN") + +@(text "This egg provides a parser and a writer for the [[https://github.com/edn-format/edn|Extensible Data Notation]].") + +@(heading "Documentation") +@(noop) + +(use srfi-1 srfi-69 srfi-88) +(module edn (parse-entry tag-handlers write-edn read-edn) + "edn-impl.scm") diff --git a/tests/run.scm b/tests/run.scm new file mode 100644 index 0000000..4a582e9 --- /dev/null +++ b/tests/run.scm @@ -0,0 +1,52 @@ +(require-extension r7rs srfi-69 srfi-64 srfi-88 srfi-1 hahn) +(include "../edn-impl.scm") +;; (run-hahn -o edn.wiki edn.scm edn-impl.scm) + +(define s->k string->keyword) + +(test-begin "EDN writing") + +(test-equal (parse-entry keyword:) ":keyword") +(test-equal (parse-entry #t) "true") +(test-equal (parse-entry #f) "false") +(test-equal (parse-entry '()) "nil") +(test-equal (parse-entry #\a) "\\a") +(test-equal (parse-entry "String") "\"String\"") +(test-equal (parse-entry (cons edn/reader-tag: neat:)) "#neat") + + +(test-equal (list->edn parse-entry '(1 2 3 4)) "(1 2 3 4)") +(test-equal (vector->edn parse-entry #(a: b: c: d:)) "[:a :b :c :d]") +(test-equal (parse-entry '((a: . "Hi") + (b: . i-am:) + (c: . (a list)))) "{:a \"Hi\" :b :i-am :c (a list)}") +(test-end "EDN writing") + +(test-begin "EDN reading") +(define wifs with-input-from-string) + +(test-equal (wifs "(:keyword)" read-edn) '(keyword:)) +(test-equal (wifs "(123)" read-edn) '(123)) +(test-equal (wifs "(\"Hello World!\")" read-edn) '("Hello World!")) +(test-equal (wifs "(false)" read-edn) '(#f)) +(test-equal (wifs "(true)" read-edn) '(#t)) +(test-equal (wifs "(:Hello \"World\" 1)" read-edn) '(Hello: "World" 1)) +(test-equal (wifs "[:a :b :c :d]" read-edn) #(a: b: c: d:)) +(test-assert + ((lambda (a b) + (and (equal? (hash-table-ref b a:) "Hi") + (equal? (hash-table-ref b b:) i-am:) + (equal? (hash-table-ref b c:) `(a list)))) + (alist->hash-table '((a: . "Hi") (b: . i-am:) (c: . (a list)))) + (wifs "{:a \"Hi\" :b :i-am :c (a list)}" read-edn))) +(test-end "EDN reading") + +(test-begin "Tag handling") +(test-equal (wifs "(1 2 #_ 3 4)" read-edn) '(1 2 4)) + +(set! tag-handlers (cons (cons keywordify: + (lambda (input) + (string->keyword (symbol->string input)))) + tag-handlers)) +(test-equal (wifs "(asdf #keywordify qwertz)" read-edn) '(asdf qwertz:)) +(test-end "Tag handling")