From 1451c8c157d7f1641b8638acd0a43ec1c53c11e3 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 23 Nov 2014 04:02:52 -0800
Subject: [PATCH] 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.

---
 basis/json/writer/writer-tests.factor | 27 ++++++++++++++++++++++++++
 basis/json/writer/writer.factor       | 28 +++++++++++++++++----------
 2 files changed, 45 insertions(+), 10 deletions(-)

diff --git a/basis/json/writer/writer-tests.factor b/basis/json/writer/writer-tests.factor
index 7f99456cf2..0ddf77474a 100644
--- 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 7f030fc214..aa45d2f755 100644
--- 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