Browse Source

In the beginning there was darkness

master
Daniel Ziltener 2 years ago
commit
04e8a0d5ae
7 changed files with 471 additions and 0 deletions
  1. +2
    -0
      .gitignore
  2. +23
    -0
      LICENSE
  3. +51
    -0
      README.md
  4. +322
    -0
      edn-impl.scm
  5. +11
    -0
      edn.egg
  6. +10
    -0
      edn.scm
  7. +52
    -0
      tests/run.scm

+ 2
- 0
.gitignore View File

@ -0,0 +1,2 @@
*~
*.c

+ 23
- 0
LICENSE View 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
- 0
README.md View File

@ -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 <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
- 0
edn-impl.scm View 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
- 0
edn.egg View 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
- 0
edn.scm View 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
- 0
tests/run.scm View 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…
Cancel
Save