--- /dev/null
+USING: arrays json.reader kernel multiline strings tools.test ;
+IN: json.reader.tests
+
+{ f } [ "false" json> ] unit-test
+{ t } [ "true" json> ] unit-test
+{ json-null } [ "null" json> ] unit-test
+{ 0 } [ "0" json> ] unit-test
+{ 0 } [ "0000" json> ] unit-test
+{ 102 } [ "102" 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
+{ 102.5 } [ "102.50" json> ] unit-test
+{ -10250 } [ "-102.5e2" json> ] unit-test
+{ -10250 } [ "-102.5E+2" json> ] unit-test
+{ 10.25 } [ "1025e-2" json> ] unit-test
+
+{ "fuzzy pickles" } [ <" "fuzzy pickles" "> json> ] unit-test
+{ "while 1:\n\tpass" } [ <" "while 1:\n\tpass" "> 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
+{ "\"scare\" quotes" } [ <" "\"scare\" quotes" "> json> ] unit-test
+
+{ { 1 "two" 3.0 } } [ <" [1, "two", 3.0] "> json> ] 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" } } } }
+ { "prime" { 2 3 5 7 11 13 } }
+} } [ <" {
+ "fib": [1, 1, 2, 3, 5, 8,
+ { "etc":"etc" } ],
+ "prime":
+ [ 2,3, 5,7,
+11,
+13
+] }
+"> json> ] unit-test
+
+{ 0 } [ " 0" json> ] unit-test
+{ 0 } [ "0 " json> ] unit-test
+{ 0 } [ " 0 " json> ] unit-test
+
! Grammar for JSON from RFC 4627
+SYMBOL: json-null
+
: [<&>] ( quot -- quot )
{ } make unclip [ <&> ] reduce ;
" " token
"\n" token <|>
"\r" token <|>
- "\t" token <|>
- "" token <|> ;
+ "\t" token <|> <*> ;
LAZY: spaced ( parser -- parser )
'ws' swap &> 'ws' <& ;
"," token spaced ;
LAZY: 'false' ( -- parser )
- "false" token ;
+ "false" token [ drop f ] <@ ;
LAZY: 'null' ( -- parser )
- "null" token ;
+ "null" token [ drop json-null ] <@ ;
LAZY: 'true' ( -- parser )
- "true" token ;
+ "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'
- [
- [ quotable? ] keep
- [ CHAR: \\ = or ] keep
- CHAR: " = not and
- ] satisfy <*> &>
+ 'string-char' <*> &>
'quot' <& [ >string ] <@ ;
DEFER: 'value'
LAZY: 'plus' ( -- parser )
"+" token ;
+LAZY: 'sign' ( -- parser )
+ 'minus' 'plus' <|> ;
+
LAZY: 'zero' ( -- parser )
"0" token [ drop 0 ] <@ ;
: sign-number ( pair -- number )
#! Pair is { minus? num }
#! Convert the json number value to a factor number
- dup second swap first [ -1 * ] when ;
+ dup second swap first [ first "-" = [ -1 * ] when ] when* ;
LAZY: 'exp' ( -- parser )
'e'
- 'minus' 'plus' <|> <?> &>
+ 'sign' <?> &>
'digit0-9' <+> [ decimal>integer ] <@ <&> [ sign-number ] <@ ;
: sequence>frac ( seq -- num )
dup second dup [ 10 swap first ^ swap first * ] [ drop first ] if ;
LAZY: 'number' ( -- parser )
- 'minus' <?>
+ 'sign' <?>
[ 'int' , 'frac' 0 succeed <|> , ] [<&>] [ sum ] <@
'exp' <?> <&> [ raise-to-power ] <@ <&> [ sign-number ] <@ ;
'object' ,
'array' ,
'number' ,
- ] [<|>] ;
+ ] [<|>] spaced ;
: json> ( string -- object )
#! Parse a json formatted string to a factor object