json.writer: Allow more objects to be keys in >json. Not completely sure about -Infinity being a key when ``jsvar-encode?`` is true. See #1189, this might solve it but we need more stress testing it.

db4
Doug Coleman 2014-11-23 04:02:52 -08:00
parent 339c73737b
commit 1451c8c157
2 changed files with 45 additions and 10 deletions

View File

@ -34,3 +34,30 @@ TUPLE: person name age a-a ;
[ f jsvar-encode? [ f jsvar-encode?
[ "Alpha-Beta" 32 H{ { "b-b" "asdf" } } person boa >json ] [ "Alpha-Beta" 32 H{ { "b-b" "asdf" } } person boa >json ]
with-variable ] unit-test with-variable ] unit-test
{ """{"1":2,"3":4}""" }
[ H{ { "1" 2 } { "3" 4 } } >json ] unit-test
{ """{"1":2,"3":4}""" }
[ H{ { 1 2 } { 3 4 } } >json ] unit-test
{ """{"":4}""" }
[ H{ { "" 2 } { "" 4 } } >json ] unit-test
{ """{"":5,"false":2,"true":4}""" }
[ H{ { f 2 } { t 4 } { "" 5 } } >json ] unit-test
{ """{"3.1":3}""" }
[ H{ { 3.1 3 } } >json ] unit-test
{ """{"Infinity":1}""" }
[ H{ { 1/0. 1 } } >json ] unit-test
{ """{"-Infinity":1}""" }
[ H{ { -1/0. 1 } } >json ] unit-test
{ """{"null":1}""" }
[ H{ { json-null 1 } } >json ] unit-test
{ """{"NaN":1}""" }
[ H{ { NAN: 333 1 } } >json ] unit-test

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 fry combinators ; prettyprint hashtables mirrors tr json fry combinators present ;
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
@ -37,15 +37,16 @@ M: string stream-json-print
M: integer stream-json-print M: integer stream-json-print
[ number>string ] [ stream-write ] bi* ; [ number>string ] [ stream-write ] bi* ;
M: float stream-json-print : float>json ( float -- string )
[
{ {
{ [ dup fp-nan? ] [ drop "NaN" ] } { [ dup fp-nan? ] [ drop "NaN" ] }
{ [ dup 1/0. = ] [ drop "Infinity" ] } { [ dup 1/0. = ] [ drop "Infinity" ] }
{ [ dup -1/0. = ] [ drop "-Infinity" ] } { [ dup -1/0. = ] [ drop "-Infinity" ] }
[ number>string ] [ number>string ]
} cond } cond ;
] dip stream-write ;
M: float stream-json-print
[ float>json ] dip stream-write ;
M: real stream-json-print M: real stream-json-print
[ >float number>string ] [ stream-write ] bi* ; [ >float number>string ] [ stream-write ] bi* ;
@ -60,6 +61,13 @@ SYMBOL: jsvar-encode?
t jsvar-encode? set-global t jsvar-encode? set-global
TR: jsvar-encode "-" "_" ; TR: jsvar-encode "-" "_" ;
GENERIC: >js-key ( obj -- str )
M: boolean >js-key "true" "false" ? ;
M: string >js-key jsvar-encode ;
M: number >js-key number>string ;
M: float >js-key float>json ;
M: json-null >js-key drop "null" ;
<PRIVATE <PRIVATE
: json-print-assoc ( assoc stream -- ) : json-print-assoc ( assoc stream -- )
@ -68,7 +76,7 @@ TR: jsvar-encode "-" "_" ;
over '[ CHAR: , _ stream-write1 ] over '[ CHAR: , _ stream-write1 ]
pick dup '[ pick dup '[
first2 first2
[ jsvar-encode _ stream-json-print ] [ >js-key _ stream-json-print ]
[ _ CHAR: : over stream-write1 stream-json-print ] [ _ CHAR: : over stream-write1 stream-json-print ]
bi* bi*
] interleave ] interleave