From 54c4b37f0edfd4480752eb431f47fad932433ccf Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 26 Jul 2020 23:15:53 +0900 Subject: [PATCH] adding make-json-reader --- Makefile | 2 +- doc/chibi.scrbl | 2 ++ lib/chibi/highlight.scm | 2 +- lib/chibi/json-test.sld | 47 +++++++++++++++++++++++++++++++++++++ lib/chibi/json.sld | 19 ++++++--------- lib/chibi/scribble-test.sld | 2 +- lib/chibi/scribble.scm | 26 +++++++++++++------- 7 files changed, 76 insertions(+), 24 deletions(-) diff --git a/Makefile b/Makefile index c74b0186..9e333871 100644 --- a/Makefile +++ b/Makefile @@ -48,7 +48,7 @@ INCLUDES = $(BASE_INCLUDES) include/chibi/eval.h include/chibi/gc_heap.h MODULE_DOCS := app ast base64 bytevector config crypto/md5 crypto/rsa \ crypto/sha2 diff disasm doc edit-distance equiv filesystem generic \ - heap-stats io iset/base iset/constructors iset/iterators loop \ + heap-stats io iset/base iset/constructors iset/iterators json loop \ match math/prime memoize mime modules net net/http-server net/servlet \ parse pathname process repl scribble string stty sxml system temp-file \ test time trace type-inference uri weak monad/environment crypto/sha2 diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index f996c499..ec581cb1 100755 --- a/doc/chibi.scrbl +++ b/doc/chibi.scrbl @@ -1323,6 +1323,8 @@ namespace. \item{\hyperlink["lib/chibi/iset/iterators.html"]{(chibi iset iterators) - Iterating over compact integer sets}} +\item{\hyperlink["lib/chibi/json.html"]{(chibi json) - JSON reading and writing}} + \item{\hyperlink["lib/chibi/loop.html"]{(chibi loop) - Fast and extensible loop syntax}} \item{\hyperlink["lib/chibi/match.html"]{(chibi match) - Intuitive and widely supported pattern matching syntax}} diff --git a/lib/chibi/highlight.scm b/lib/chibi/highlight.scm index d86c9ca3..fe4785c2 100644 --- a/lib/chibi/highlight.scm +++ b/lib/chibi/highlight.scm @@ -124,7 +124,7 @@ ((eqv? c #\<) (read-escaped in term `(#\; #\t #\l #\& ,@ls))) ;;((eqv? c #\>) (read-escaped in term `(#\; #\t #\g #\& ,@ls))) ((eqv? c #\&) (read-escaped in term `(#\; #\p #\m #\a #\& ,@ls))) - ;;((eqv? c #\\) (read-escaped in term (cons (read-char in) (cons c ls)))) + ((eqv? c #\\) (read-escaped in term (cons (read-char in) (cons c ls)))) (else (read-escaped in term (cons c ls)))))) (define (read-to-eol in ls) diff --git a/lib/chibi/json-test.sld b/lib/chibi/json-test.sld index e3f22631..2e572126 100644 --- a/lib/chibi/json-test.sld +++ b/lib/chibi/json-test.sld @@ -69,6 +69,52 @@ } }}")) (test-end) + (test-begin "make-json-reader") + (let () + (define-record-type Employee + (make-employee name id title department) + employee? + (name employee-name) + (id employee-id) + (title employee-title) + (department employee-department)) + (define-record-type Team + (make-team name lead devs) + team? + (name team-name) + (lead team-lead) + (devs team-devs)) + (define read-employee (make-json-reader Employee)) + (define read-team + (make-json-reader + `(,Team + (lead . ,Employee) + (name . ,string?) + (devs . #(,Employee))))) + (define (string->employee str) + (read-employee (open-input-string str))) + (define (string->team str) + (read-team (open-input-string str))) + (let ((emp1 (string->employee + "{\"name\": \"Bob\", \"id\": 3, \"title\": \"CEO\"}"))) + (test-assert (employee? emp1)) + (test "Bob" (employee-name emp1)) + (test 3 (employee-id emp1)) + (test "CEO" (employee-title emp1))) + (test-assert (employee? (string->employee "{\"unknown\": \"foo\"}"))) + (test-error ((make-json-reader Employee #t) + (open-input-string "{\"unknown\": \"foo\"}"))) + (test-error (string->team "{\"name\": 3}")) + (let ((team1 (string->team + "{\"name\": \"Tiger Cats\", \"lead\": {\"name\": \"House\", \"id\": 321}, \"devs\": [{\"name\": \"Cameron\", \"id\": 7}, {\"name\": \"Thirteen\", \"id\": 13}]}"))) + (test-assert (team? team1)) + (test-assert (employee? (team-lead team1))) + (test "House" (employee-name (team-lead team1))) + (test-assert (vector? (team-devs team1))) + (test 2 (vector-length (team-devs team1))) + (test "Cameron" (employee-name (vector-ref (team-devs team1) 0))) + (test "Thirteen" (employee-name (vector-ref (team-devs team1) 1))))) + (test-end) (test-begin "json->string") (test "1" (json->string 1)) (test "1.5" (json->string 1.5)) @@ -104,3 +150,4 @@ (test-end) (test-end) ))) + diff --git a/lib/chibi/json.sld b/lib/chibi/json.sld index e378ad94..d63b41d3 100644 --- a/lib/chibi/json.sld +++ b/lib/chibi/json.sld @@ -1,15 +1,10 @@ (define-library (chibi json) - (import (scheme base)) - (export string->json json->string json-read json-write) + (import (scheme base) + (except (srfi 99 records) define-record-type) + (only (chibi ast) type-name) + (only (chibi) make-constructor)) + (export string->json json->string json-read json-write + make-json-reader) (include-shared "json") - (begin - (define (string->json str) - (let* ((in (open-input-string str)) - (res (json-read in))) - (close-input-port in) - res)) - (define (json->string json) - (let ((out (open-output-string))) - (json-write json out) - (get-output-string out))))) + (include "json.scm")) diff --git a/lib/chibi/scribble-test.sld b/lib/chibi/scribble-test.sld index d4760077..5742091c 100644 --- a/lib/chibi/scribble-test.sld +++ b/lib/chibi/scribble-test.sld @@ -72,7 +72,7 @@ (test-scribble '((foo "x " y " z")) "\\foo{x \\y z}") (test-scribble '((foo "x " (* y 2) " z")) "\\foo{x \\(* y 2) z}") (test-scribble '((foo " bar")) "\\{\\foo bar}") - (test-scribble '(((foo "bar") "baz")) "\\\\foo{bar}{baz}") + ;;(test-scribble '(((foo "bar") "baz")) "\\\\foo{bar}{baz}") (test-scribble '((foo 1 (* 2 3) "bar")) "\\foo[1 (* 2 3)]{bar}") (test-scribble '((foo (bar "...") "blah")) "\\foo[\\bar{...}]{blah}") diff --git a/lib/chibi/scribble.scm b/lib/chibi/scribble.scm index 703f5c54..48168b7d 100644 --- a/lib/chibi/scribble.scm +++ b/lib/chibi/scribble.scm @@ -171,15 +171,23 @@ (define (scribble-parse-escape in ec) (define bracket-char #\[) (define brace-char #\{) - (let* ((wrap (read-prefix-wrapper in)) - (c (peek-char in)) - (cmd (if (or (eqv? c bracket-char) (eqv? c brace-char)) '() (list (scribble-read in ec)))) - (data? (eqv? (peek-char in) bracket-char)) - (data (if data? (scribble-read in ec) '())) - (punc (read-punctuation in)) - (body? (eqv? (peek-char in) brace-char)) - (body (cond (body? (read-char in) (scribble-parse in punc ec)) (else '())))) - (wrap (if (or data? body?) (append cmd data body) (car cmd))))) + (cond + ((eqv? #\" (peek-char in)) + (scribble-read in)) + ((eqv? #\\ (peek-char in)) + ;; not compatible with racket + (read-char in) + "\\") + (else + (let* ((wrap (read-prefix-wrapper in)) + (c (peek-char in)) + (cmd (if (or (eqv? c bracket-char) (eqv? c brace-char)) '() (list (scribble-read in ec)))) + (data? (eqv? (peek-char in) bracket-char)) + (data (if data? (scribble-read in ec) '())) + (punc (read-punctuation in)) + (body? (eqv? (peek-char in) brace-char)) + (body (cond (body? (read-char in) (scribble-parse in punc ec)) (else '())))) + (wrap (if (or data? body?) (append cmd data body) (car cmd))))))) (define (scribble-parse in . o) (define init-punc (if (pair? o) (car o) '()))