(import r7rs chalk)
(require-extension srfi-69 srfi-64 srfi-88 srfi-1)
;;(import (chicken port))
(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
    (let ((port (open-output-string)))
      (write-edn port '((a: . "Hi")
			(b: . i-am:)
			(c: . (a list))))
      (get-output-string port))
  "{:a \"Hi\" :b :i-am :c (a list)}")
(test-end "EDN writing")

(test-begin "EDN reading")
(define (wifs str proc)
  (call-with-port (open-input-string str) proc))

(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))

(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")