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

db4
Slava Pestov 2008-11-14 20:30:22 -06:00
commit fbf26ca0eb
5 changed files with 100 additions and 185 deletions

View File

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

View File

@ -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

View File

@ -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
assocs math math.parser math.vectors math.functions math.order
lists hashtables ascii accessors ;
USING: kernel peg peg.ebnf math.parser math.private strings math math.functions sequences
arrays vectors hashtables assocs prettyprint ;
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 )
{ } make unclip [ <&> ] reduce ;
true = "true" => [[ t ]]
false = "false" => [[ f ]]
null = "null" => [[ json-null ]]
: [<|>] ( quot -- quot )
{ } make unclip [ <|> ] reduce ;
hex = [0-9a-fA-F]
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 )
" " token
"\n" token <|>
"\r" token <|>
"\t" token <|> <*> ;
sign = ("-" | "+")? => [[ "-" = "-" "" ? ]]
digits = [0-9]+ => [[ >string ]]
decimal = "." digits => [[ concat ]]
exp = ("e" | "E") sign digits => [[ concat ]]
number = sign digits decimal? exp? => [[ dup concat swap fourth [ string>float ] [ string>number ] if ]]
LAZY: spaced ( parser -- parser )
'ws' swap &> 'ws' <& ;
elements = value ("," value)* => [[ grammar-list>vector ]]
array = "[" elements?:arr "]" => [[ arr >array ]]
LAZY: 'begin-array' ( -- parser )
"[" token spaced ;
pair = ws string:key ws ":" value:val => [[ { key val } ]]
members = pair ("," pair)* => [[ grammar-list>vector ]]
object = "{" members?:hash "}" => [[ hash >hashtable ]]
LAZY: 'begin-object' ( -- parser )
"{" token spaced ;
val = true
| false
| null
| string
| number
| array
| object
LAZY: 'end-array' ( -- parser )
"]" token spaced ;
value = ws val:v ws => [[ v ]]
LAZY: 'end-object' ( -- parser )
"}" 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 ;
;EBNF

View File

@ -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

View File

@ -2,43 +2,49 @@
! 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
GENERIC: json-print ( obj -- )
: >json ( obj -- string )
#! Returns a string representing the factor object in JSON format
[ json-print ] with-string-writer ;
#! Returns a string representing the factor object in JSON format
[ json-print ] with-string-writer ;
M: f json-print ( f -- )
drop "false" write ;
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 ;
CHAR: " write1 "\"" split "\\\"" join CHAR: \r swap remove "\n" split "\\r\\n" join write CHAR: " write1 ;
M: number json-print ( num -- )
number>string write ;
number>string write ;
M: sequence json-print ( array -- )
CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ;
CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ;
TR: jsvar-encode "-" "_" ;
: tuple>fields ( object -- seq )
<mirror> [
[ swap jsvar-encode >json % " : " % >json % ] "" make
] { } assoc>map ;
<mirror> [
[ swap jsvar-encode >json % " : " % >json % ] "" make
] { } assoc>map ;
M: tuple json-print ( tuple -- )
CHAR: { write1 tuple>fields "," join write CHAR: } write1 ;
CHAR: { write1 tuple>fields "," join write CHAR: } write1 ;
M: hashtable json-print ( hashtable -- )
CHAR: { write1
[ [ swap jsvar-encode >json % CHAR: : , >json % ] "" make ]
{ } assoc>map "," join write
CHAR: } write1 ;
CHAR: { write1
[ [ swap jsvar-encode >json % CHAR: : , >json % ] "" make ]
{ } assoc>map "," join write
CHAR: } write1 ;
M: object json-print ( object -- )
unparse json-print ;