Merge branch 'json' of git://github.com/rictic/factor

basis/json/authors.txt

@@ -1 +1,2 @@
 Chris Double
+Peter Burns

basis/json/reader/reader-tests.factor

@@ -1,4 +1,4 @@
-USING: arrays json.reader kernel multiline strings tools.test ;
+USING: arrays json.reader kernel multiline strings tools.test hashtables ;
 IN: json.reader.tests
 
 { f } [ "false" json> ] unit-test
@@ -8,21 +8,35 @@ IN: json.reader.tests
 { 102 } [ "102" json> ] unit-test
 { -102 } [ "-102" json> ] unit-test
 { 102 } [ "+102" json> ] unit-test
+{ 1000.0 } [ "1.0e3" json> ] unit-test
+{ 1000.0 } [ "10e2" json> ] unit-test
 { 102.0 } [ "102.0" json> ] unit-test
 { 102.5 } [ "102.5" json> ] unit-test
 { 102.5 } [ "102.50" json> ] unit-test
 { -10250.0 } [ "-102.5e2" json> ] unit-test
 { -10250.0 } [ "-102.5E+2" json> ] unit-test
-{ 10+1/4 } [ "1025e-2" json> ] unit-test
+{ 10.25 } [ "1025e-2" json> ] unit-test
 { 0.125 } [ "0.125" json> ] unit-test
 { -0.125 } [ "-0.125" json> ] unit-test
 
+! not widely supported by javascript, but allowed in the grammar, and a nice
+! feature to get
+{ -0.0 } [ "-0.0" json> ] unit-test
+
 { " fuzzy  pickles " } [ <" " fuzzy  pickles " "> json> ] unit-test
 { "while 1:\n\tpass" } [ <" "while 1:\n\tpass" "> json> ] unit-test
+! unicode is allowed in json
+{ "ß∂¬ƒ˚∆" } [ <" "ß∂¬ƒ˚∆""> json> ] unit-test
 { 8 9 10 12 13 34 47 92 } >string 1array [ <" "\b\t\n\f\r\"\/\\" "> json> ] unit-test
 { HEX: abcd } >string 1array [ <" "\uaBCd" "> json> ] unit-test
 
+{ { } } [ "[]" json> ] unit-test 
 { { 1 "two" 3.0 } } [ <" [1, "two", 3.0] "> json> ] unit-test
+{ H{ } } [ "{}" json> ] unit-test
+
+! the returned hashtable should be different every time
+{ H{ } } [ "key" "value" "{}" json> ?set-at "{}" json> nip ] unit-test
+
 { H{ { "US$" 1.0 } { "EU€" 1.5 } } } [ <" { "US$":1.00, "EU\u20AC":1.50 } "> json> ] unit-test
 { H{
     { "fib" { 1 1 2 3 5 8 H{ { "etc" "etc" } } } }
@@ -40,4 +54,3 @@ IN: json.reader.tests
 { 0 } [ "      0" json> ] unit-test
 { 0 } [ "0      " json> ] unit-test
 { 0 } [ "   0   " json> ] unit-test
-

basis/json/reader/reader.factor

@@ -1,180 +1,57 @@
-! Copyright (C) 2006 Chris Double.
+! Copyright (C) 2008 Peter Burns.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel parser-combinators namespaces make sequences promises strings 
+USING: kernel peg peg.ebnf math.parser math.private strings math math.functions sequences
-       assocs math math.parser math.vectors math.functions math.order
+       arrays vectors hashtables assocs prettyprint ;
-       lists hashtables ascii accessors ;
 IN: json.reader
 
+SINGLETON: json-null
+
+
+: grammar-list>vector ( seq -- vec ) first2 values swap prefix ;
+
 ! Grammar for JSON from RFC 4627
+EBNF: json>
 
-SYMBOL: json-null
+ws = (" " | "\r" | "\t" | "\n")*
 
-: [<&>] ( quot -- quot )
+true = "true" => [[ t ]]
-  { } make unclip [ <&> ] reduce ;
+false = "false" => [[ f ]]
+null = "null" => [[ json-null ]]
 
-: [<|>] ( quot -- quot )
+hex = [0-9a-fA-F]
-  { } make unclip [ <|> ] reduce ;
+char = '\\"'  [[ CHAR: "  ]]
+     | "\\\\" [[ CHAR: \  ]]
+     | "\\/"  [[ CHAR: /  ]]
+     | "\\b"  [[ 8        ]]
+     | "\\f"  [[ 12       ]]
+     | "\\n"  [[ CHAR: \n ]]
+     | "\\r"  [[ CHAR: \r ]]
+     | "\\t"  [[ CHAR: \t ]]
+     | "\\u" (hex hex hex hex) [[ hex> ]] => [[ second ]]
+     | [^"\]
+string = '"' char*:cs '"' => [[ cs >string ]]
 
-LAZY: 'ws' ( -- parser )
+sign = ("-" | "+")? => [[ "-" = "-" "" ? ]]
-  " " token 
+digits = [0-9]+     => [[ >string ]]
-  "\n" token <|>
+decimal = "." digits  => [[ concat ]]
-  "\r" token <|>
+exp = ("e" | "E") sign digits => [[ concat ]]
-  "\t" token <|> <*> ;
+number = sign digits decimal? exp? => [[ dup concat swap fourth [ string>float ] [ string>number ] if ]]
 
-LAZY: spaced ( parser -- parser )
+elements = value ("," value)* => [[ grammar-list>vector ]]
-  'ws' swap &> 'ws' <& ;
+array = "[" elements?:arr "]" => [[ arr >array ]]
 
-LAZY: 'begin-array' ( -- parser )
+pair = ws string:key ws ":" value:val => [[ { key val } ]]
-  "[" token spaced ;
+members = pair ("," pair)* => [[ grammar-list>vector ]]
+object = "{" members?:hash "}" => [[ hash >hashtable ]]
 
-LAZY: 'begin-object' ( -- parser )
+val = true
-  "{" token spaced ;
+    | false
+    | null
+    | string
+    | number
+    | array
+    | object
 
-LAZY: 'end-array' ( -- parser )
+value = ws val:v ws => [[ v ]]
-  "]" token spaced ;
 
-LAZY: 'end-object' ( -- parser )
+;EBNF
-  "}" token spaced ;
-
-LAZY: 'name-separator' ( -- parser )
-  ":" token spaced ;
-
-LAZY: 'value-separator' ( -- parser )
-  "," token spaced ;
-
-LAZY: 'false' ( -- parser )
-  "false" token [ drop f ] <@ ;
-
-LAZY: 'null' ( -- parser )
-  "null" token [ drop json-null ] <@ ;
-
-LAZY: 'true' ( -- parser )
-  "true" token [ drop t ] <@ ;
-
-LAZY: 'quot' ( -- parser )
-  "\"" token ;
-
-LAZY: 'hex-digit' ( -- parser )
-  [ digit> ] satisfy [ digit> ] <@ ;
-
-: hex-digits>ch ( digits -- ch )
-    0 [ swap 16 * + ] reduce ;
-
-LAZY: 'string-char' ( -- parser )
-  [ quotable? ] satisfy
-  "\\b" token [ drop 8 ] <@ <|>
-  "\\t" token [ drop CHAR: \t ] <@ <|>
-  "\\n" token [ drop CHAR: \n ] <@ <|>
-  "\\f" token [ drop 12 ] <@ <|>
-  "\\r" token [ drop CHAR: \r ] <@ <|>
-  "\\\"" token [ drop CHAR: " ] <@ <|>
-  "\\/" token [ drop CHAR: / ] <@ <|>
-  "\\\\" token [ drop CHAR: \\ ] <@ <|>
-  "\\u" token 'hex-digit' 4 exactly-n &>
-  [ hex-digits>ch ] <@ <|> ;
-
-LAZY: 'string' ( -- parser )
-  'quot' 
-  'string-char' <*> &> 
-  'quot' <& [ >string ] <@  ;
-
-DEFER: 'value'
-
-LAZY: 'member' ( -- parser )
-  'string'
-  'name-separator' <&  
-  'value' <&> ;
-
-USE: prettyprint 
-LAZY: 'object' ( -- parser )
-  'begin-object' 
-  'member' 'value-separator' list-of &>
-  'end-object' <& [ >hashtable ] <@ ;
-
-LAZY: 'array' ( -- parser )
-  'begin-array' 
-  'value' 'value-separator' list-of &>
-  'end-array' <&  ;
-  
-LAZY: 'minus' ( -- parser )
-  "-" token ;
-
-LAZY: 'plus' ( -- parser )
-  "+" token ;
-
-LAZY: 'sign' ( -- parser )
-  'minus' 'plus' <|> ;
-
-LAZY: 'zero' ( -- parser )
-  "0" token [ drop 0 ] <@ ;
-
-LAZY: 'decimal-point' ( -- parser )
-  "." token ;
-
-LAZY: 'digit1-9' ( -- parser )
-  [ 
-    dup integer? [ 
-      CHAR: 1 CHAR: 9 between? 
-    ] [ 
-      drop f 
-    ] if 
-  ] satisfy [ digit> ] <@ ;
-
-LAZY: 'digit0-9' ( -- parser )
-  [ digit? ] satisfy [ digit> ] <@ ;
-
-: decimal>integer ( seq -- num ) 10 digits>integer ;
-
-LAZY: 'int' ( -- parser )
-  'zero' 
-  'digit1-9' 'digit0-9' <*> <&:> [ decimal>integer ] <@ <|>  ;
-
-LAZY: 'e' ( -- parser )
-  "e" token "E" token <|> ;
-
-: sign-number ( pair -- number )
-  #! Pair is { minus? num }
-  #! Convert the json number value to a factor number
-  dup second swap first [ first "-" = [ -1 * ] when ] when* ;
-
-LAZY: 'exp' ( -- parser )
-    'e' 
-    'sign' <?> &>
-    'digit0-9' <+> [ decimal>integer ] <@ <&> [ sign-number ] <@ ;
-
-: sequence>frac ( seq -- num ) 
-  #! { 1 2 3 } => 0.123
-  reverse 0 [ swap 10 / + ] reduce 10 / >float ;
-
-LAZY: 'frac' ( -- parser )
-  'decimal-point' 'digit0-9' <+> &> [ sequence>frac ] <@ ;
-
-: raise-to-power ( pair -- num )
-  #! Pair is { num exp }.
-  #! Multiply 'num' by 10^exp
-  dup second dup [ 10 swap first ^ swap first * ] [ drop first ] if ;
-
-LAZY: 'number' ( -- parser )
-  'sign' <?>
-  [ 'int' , 'frac' 0 succeed <|> , ] [<&>] [ sum ] <@ 
-  'exp' <?> <&> [ raise-to-power ] <@ <&> [ sign-number ] <@ ;
-
-LAZY: 'value' ( -- parser )
-  [
-    'false' ,
-    'null' ,
-    'true' ,
-    'string' ,
-    'object' ,
-    'array' ,
-    'number' ,
-  ] [<|>] spaced ;
-ERROR: could-not-parse-json ;
-
-: json> ( string -- object )
-  #! Parse a json formatted string to a factor object
-  'value' parse dup nil? [ 
-      could-not-parse-json
-  ] [ 
-    car parsed>> 
-  ] if ;

basis/json/writer/writer-tests.factor

@@ -0,0 +1,18 @@
+USING: json.writer tools.test multiline json.reader ;
+IN: json.writer.tests
+
+{ "false" } [ f >json ] unit-test
+{ "true" } [ t >json ] unit-test
+{ "null" } [ json-null >json ] unit-test
+{ "0" } [ 0 >json ] unit-test
+{ "102" } [ 102 >json ] unit-test
+{ "-102" } [ -102 >json ] unit-test
+{ "102.0" } [ 102.0 >json ] unit-test
+{ "102.5" } [ 102.5 >json ] unit-test
+
+{ "[1,\"two\",3.0]" } [ { 1 "two" 3.0 } >json ] unit-test
+{ <" {"US$":1.0,"EU€":1.5}"> } [ H{ { "US$" 1.0 } { "EU€" 1.5 } } >json ] unit-test
+
+! Random symbols are written simply as strings
+SYMBOL: testSymbol
+{ <" "testSymbol""> } [ testSymbol >json ] unit-test

basis/json/writer/writer.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel io.streams.string io strings splitting sequences
 math math.parser assocs classes words namespaces make
-prettyprint hashtables mirrors tr ;
+prettyprint hashtables mirrors tr json.reader ;
 IN: json.writer
 
 #! Writes the object out to a stream in JSON format
@@ -15,6 +15,12 @@ GENERIC: json-print ( obj -- )
 M: f json-print ( f -- )
     drop "false" write ;
 
+M: t json-print ( t -- )
+    drop "true" write ;
+
+M: json-null json-print ( null -- )
+    drop "null" write ;
+
 M: string json-print ( obj -- )
     CHAR: " write1 "\"" split "\\\"" join CHAR: \r swap remove "\n" split "\\r\\n" join write CHAR: " write1 ;