json.writer: Allow more objects to be keys in >json. Not completely sure about -Infin...

diff --git a/basis/json/writer/writer-tests.factor b/basis/json/writer/writer-tests.factor
index 7f99456cf227d40198bfe6fa9ce508755fd301d2..0ddf77474a9c0b44d596f77bb4f9fd2a36b4b841 100644 (file)
--- a/basis/json/writer/writer-tests.factor
+++ b/basis/json/writer/writer-tests.factor
@@ -34,3 +34,30 @@ TUPLE: person name age a-a ;
     [ f jsvar-encode? 
         [ "Alpha-Beta" 32 H{ { "b-b" "asdf" } } person boa >json ] 
         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

diff --git a/basis/json/writer/writer.factor b/basis/json/writer/writer.factor
index 7f030fc21467b4d2d6da7682455c2649e69277ec..aa45d2f75533913e81d5669f027c7e01989b0992 100644 (file)
--- a/basis/json/writer/writer.factor
+++ b/basis/json/writer/writer.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel io.streams.string io strings splitting
 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
 
 #! Writes the object out to a stream in JSON format
@@ -37,15 +37,16 @@ M: string stream-json-print
 M: integer stream-json-print
     [ number>string ] [ stream-write ] bi* ;
 
+: float>json ( float -- string )
+    {
+        { [ dup fp-nan? ] [ drop "NaN" ] }
+        { [ dup 1/0. = ] [ drop "Infinity" ] }
+        { [ dup -1/0. = ] [ drop "-Infinity" ] }
+        [ number>string ]
+    } cond ;
+
 M: float stream-json-print
-    [
-        {
-            { [ dup fp-nan? ] [ drop "NaN" ] }
-            { [ dup 1/0. = ] [ drop "Infinity" ] }
-            { [ dup -1/0. = ] [ drop "-Infinity" ] }
-            [ number>string ]
-        } cond
-    ] dip stream-write ;
+    [ float>json ] dip stream-write ;
 
 M: real stream-json-print
     [ >float number>string ] [ stream-write ] bi* ;
@@ -60,6 +61,13 @@ SYMBOL: jsvar-encode?
 t jsvar-encode? set-global
 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
 
 : json-print-assoc ( assoc stream -- )
@@ -68,7 +76,7 @@ TR: jsvar-encode "-" "_" ;
             over '[ CHAR: , _ stream-write1 ]
             pick dup '[
                 first2
-                [ jsvar-encode _ stream-json-print ]
+                [ >js-key _ stream-json-print ]
                 [ _ CHAR: : over stream-write1 stream-json-print ]
                 bi*
             ] interleave