diff --git a/basis/json/authors.txt b/basis/json/authors.txt index 44b06f94bc..914f818278 100755 --- a/basis/json/authors.txt +++ b/basis/json/authors.txt @@ -1 +1,2 @@ Chris Double +Peter Burns \ No newline at end of file diff --git a/basis/json/reader/reader-tests.factor b/basis/json/reader/reader-tests.factor index 995ae0e0b8..fbd91601bf 100644 --- a/basis/json/reader/reader-tests.factor +++ b/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 - diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index dd1ab8d5d8..858c9ed4de 100644 --- a/basis/json/reader/reader.factor +++ b/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 - 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 \ No newline at end of file diff --git a/basis/json/writer/writer-tests.factor b/basis/json/writer/writer-tests.factor new file mode 100644 index 0000000000..1b29bac824 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/basis/json/writer/writer.factor b/basis/json/writer/writer.factor index cbcf426545..d50a4de8f5 100644 --- a/basis/json/writer/writer.factor +++ b/basis/json/writer/writer.factor @@ -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 ) - [ - [ swap jsvar-encode >json % " : " % >json % ] "" make - ] { } assoc>map ; + [ + [ 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 ;