steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

json.writer: Currified jsvar-encode. Removed whitespace in tuple>fields json output. Added tests to json.writer-tests.

db4
otoburb 2011-07-04 23:14:51 -04:00
parent 210228b911
commit fb95a19352
2 changed files with 20 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/json/writer/writer-tests.factor
View File

@ -1,4 +1,4 @@
USING: hashtables json.writer tools.test json.reader json namespaces ; USING: hashtables json.writer tools.test json.reader json kernel namespaces ;
IN: json.writer.tests IN: json.writer.tests
{ "false" } [ f >json ] unit-test { "false" } [ f >json ] unit-test
@ -20,7 +20,17 @@ SYMBOL: testSymbol
[ { 0.5 } ] [ { 1/2 } >json json> ] unit-test [ { 0.5 } ] [ { 1/2 } >json json> ] unit-test
[ "{\"b-b\":\"asdf\"}" ] [ "{\"b-b\":\"asdf\"}" ]
[ "asdf" "b-b" associate f jsvar-encode? [ >json ] with-variable ] unit-test [ f jsvar-encode? [ "asdf" "b-b" associate >json ] with-variable ] unit-test
[ "{\"b_b\":\"asdf\"}" ] [ "{\"b_b\":\"asdf\"}" ]
[ "asdf" "b-b" associate >json ] unit-test [ t jsvar-encode? [ "asdf" "b-b" associate >json ] with-variable ] unit-test
TUPLE: person name age a-a ;
[ "{\"name\":\"David-David\",\"age\":32,\"a_a\":{\"b_b\":\"asdf\"}}" ]
[ t jsvar-encode?
[ "David-David" 32 H{ { "b-b" "asdf" } } person boa >json ]
with-variable ] unit-test
[ "{\"name\":\"Alpha-Beta\",\"age\":32,\"a-a\":{\"b-b\":\"asdf\"}}" ]
[ f jsvar-encode?
[ "Alpha-Beta" 32 H{ { "b-b" "asdf" } } person boa >json ]
with-variable ] unit-test

14
basis/json/writer/writer.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel io.streams.string io strings splitting USING: accessors kernel io.streams.string io strings splitting
sequences math math.parser assocs classes words namespaces make sequences math math.parser assocs classes words namespaces make
prettyprint hashtables mirrors tr json ; prettyprint hashtables mirrors tr json fry ;
IN: json.writer IN: json.writer
#! Writes the object out to a stream in JSON format #! Writes the object out to a stream in JSON format
@ -33,23 +33,23 @@ M: real json-print ( num -- )
M: sequence json-print ( array -- ) M: sequence json-print ( array -- )
CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ; CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ;
! if jsvar-encode? is true, then implement jsvar-encode
SYMBOL: jsvar-encode? SYMBOL: jsvar-encode?
t jsvar-encode? set-global t jsvar-encode? set-global
TR: jsvar-encode "-" "_" ; TR: jsvar-encode "-" "_" ;
: tuple>fields ( object -- seq ) : tuple>fields ( object -- seq )
<mirror> [ <mirror>
[ swap jsvar-encode >json % " : " % >json % ] "" make jsvar-encode? get
] { } assoc>map ; '[ [ swap _ [ jsvar-encode ] when >json % ":" % >json % ] "" make ] { } assoc>map ;
M: tuple json-print ( tuple -- ) M: tuple json-print ( tuple -- )
CHAR: { write1 tuple>fields "," join write CHAR: } write1 ; CHAR: { write1 tuple>fields "," join write CHAR: } write1 ;
M: hashtable json-print ( hashtable -- ) M: hashtable json-print ( hashtable -- )
CHAR: { write1 CHAR: { write1
[ [ swap jsvar-encode? get [ jsvar-encode ] when >json % CHAR: : , >json % ] "" make ] jsvar-encode? get
{ } assoc>map "," join write '[ [ swap _ [ jsvar-encode ] when >json % CHAR: : , >json % ] "" make ] { } assoc>map
"," join write
CHAR: } write1 ; CHAR: } write1 ;
M: word json-print name>> json-print ; M: word json-print name>> json-print ;