In the beginning there was darkness
This commit is contained in:
commit
04e8a0d5ae
7 changed files with 471 additions and 0 deletions
2
.gitignore
vendored
Normal file
2
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
*~
|
||||
*.c
|
||||
23
LICENSE
Normal file
23
LICENSE
Normal file
|
|
@ -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.
|
||||
51
README.md
Normal file
51
README.md
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
[]()
|
||||
[](http://www.call-cc.org/)
|
||||
[](http://wiki.call-cc.org/eggref/4/edn)
|
||||
[](//gratipay.com/zilti)
|
||||
[](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 <port> read-edn)`
|
||||
* Transforming Chicken into EDN: `(with-output-to-port <port> (write-edn <datastructure>))`
|
||||
* 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).
|
||||
322
edn-impl.scm
Normal file
322
edn-impl.scm
Normal file
|
|
@ -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))))
|
||||
11
edn.egg
Normal file
11
edn.egg
Normal file
|
|
@ -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"))))
|
||||
10
edn.scm
Normal file
10
edn.scm
Normal file
|
|
@ -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")
|
||||
52
tests/run.scm
Normal file
52
tests/run.scm
Normal file
|
|
@ -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")
|
||||
Loading…
Reference in a new issue