From 260862603cceb858ba85d818e75c30d9695158e7 Mon Sep 17 00:00:00 2001 From: Peter Burns Date: Thu, 6 Nov 2008 04:26:49 -0800 Subject: [PATCH 01/22] Added some tests for json.writer, fixed a bug with t >json and json-null >json --- basis/json/writer/writer-tests.factor | 18 ++++++++++++++++++ basis/json/writer/writer.factor | 7 +++++-- 2 files changed, 23 insertions(+), 2 deletions(-) create mode 100644 basis/json/writer/writer-tests.factor 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..4a61aa3438 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: 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,9 @@ GENERIC: json-print ( obj -- ) M: f json-print ( f -- ) drop "false" write ; +M: t json-print ( t -- ) + drop "true" write + M: string json-print ( obj -- ) CHAR: " write1 "\"" split "\\\"" join CHAR: \r swap remove "\n" split "\\r\\n" join write CHAR: " write1 ; @@ -41,4 +44,4 @@ M: hashtable json-print ( hashtable -- ) CHAR: } write1 ; M: object json-print ( object -- ) - unparse json-print ; + dup json-null = [ "null" write drop ] [ unparse json-print ] if ; From 986ea40835f8e4e1bcb55e873125dc20456e7181 Mon Sep 17 00:00:00 2001 From: Peter Burns Date: Thu, 6 Nov 2008 04:38:12 -0800 Subject: [PATCH 02/22] Changed json-null to a SINGLETON for method dispatch --- basis/json/reader/reader.factor | 2 +- basis/json/writer/writer.factor | 7 +++++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index dd1ab8d5d8..476eefbf95 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -7,7 +7,7 @@ IN: json.reader ! Grammar for JSON from RFC 4627 -SYMBOL: json-null +SINGLETON: json-null : [<&>] ( quot -- quot ) { } make unclip [ <&> ] reduce ; diff --git a/basis/json/writer/writer.factor b/basis/json/writer/writer.factor index 4a61aa3438..d572295c3a 100644 --- a/basis/json/writer/writer.factor +++ b/basis/json/writer/writer.factor @@ -16,7 +16,10 @@ M: f json-print ( f -- ) drop "false" write ; M: t json-print ( t -- ) - drop "true" write + 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 ; @@ -44,4 +47,4 @@ M: hashtable json-print ( hashtable -- ) CHAR: } write1 ; M: object json-print ( object -- ) - dup json-null = [ "null" write drop ] [ unparse json-print ] if ; + unparse json-print ; From e631e1ca0828b61766954418f7d6489491bedf77 Mon Sep 17 00:00:00 2001 From: Peter Burns Date: Thu, 6 Nov 2008 04:41:53 -0800 Subject: [PATCH 03/22] Normalized spacing to 4 space tabs in json modules --- basis/json/reader/reader.factor | 168 ++++++++++++++++---------------- basis/json/writer/writer.factor | 32 +++--- 2 files changed, 100 insertions(+), 100 deletions(-) diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index 476eefbf95..132cf9ea73 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -10,132 +10,132 @@ IN: json.reader SINGLETON: json-null : [<&>] ( quot -- quot ) - { } make unclip [ <&> ] reduce ; + { } make unclip [ <&> ] reduce ; : [<|>] ( quot -- quot ) - { } make unclip [ <|> ] reduce ; + { } make unclip [ <|> ] reduce ; LAZY: 'ws' ( -- parser ) - " " token - "\n" token <|> - "\r" token <|> - "\t" token <|> <*> ; + " " token + "\n" token <|> + "\r" token <|> + "\t" token <|> <*> ; LAZY: spaced ( parser -- parser ) - 'ws' swap &> 'ws' <& ; + 'ws' swap &> 'ws' <& ; LAZY: 'begin-array' ( -- parser ) - "[" token spaced ; + "[" token spaced ; LAZY: 'begin-object' ( -- parser ) - "{" token spaced ; + "{" token spaced ; LAZY: 'end-array' ( -- parser ) - "]" token spaced ; + "]" token spaced ; LAZY: 'end-object' ( -- parser ) - "}" token spaced ; + "}" token spaced ; LAZY: 'name-separator' ( -- parser ) - ":" token spaced ; + ":" token spaced ; LAZY: 'value-separator' ( -- parser ) - "," token spaced ; + "," token spaced ; LAZY: 'false' ( -- parser ) - "false" token [ drop f ] <@ ; + "false" token [ drop f ] <@ ; LAZY: 'null' ( -- parser ) - "null" token [ drop json-null ] <@ ; + "null" token [ drop json-null ] <@ ; LAZY: 'true' ( -- parser ) - "true" token [ drop t ] <@ ; + "true" token [ drop t ] <@ ; LAZY: 'quot' ( -- parser ) - "\"" token ; + "\"" token ; LAZY: 'hex-digit' ( -- parser ) - [ digit> ] satisfy [ digit> ] <@ ; + [ 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 ] <@ <|> ; + [ 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 ] <@ ; + 'quot' + 'string-char' <*> &> + 'quot' <& [ >string ] <@ ; DEFER: 'value' LAZY: 'member' ( -- parser ) - 'string' - 'name-separator' <& - 'value' <&> ; + 'string' + 'name-separator' <& + 'value' <&> ; USE: prettyprint LAZY: 'object' ( -- parser ) - 'begin-object' - 'member' 'value-separator' list-of &> - 'end-object' <& [ >hashtable ] <@ ; + 'begin-object' + 'member' 'value-separator' list-of &> + 'end-object' <& [ >hashtable ] <@ ; LAZY: 'array' ( -- parser ) - 'begin-array' - 'value' 'value-separator' list-of &> - 'end-array' <& ; + 'begin-array' + 'value' 'value-separator' list-of &> + 'end-array' <& ; LAZY: 'minus' ( -- parser ) - "-" token ; + "-" token ; LAZY: 'plus' ( -- parser ) - "+" token ; + "+" token ; LAZY: 'sign' ( -- parser ) - 'minus' 'plus' <|> ; + 'minus' 'plus' <|> ; LAZY: 'zero' ( -- parser ) - "0" token [ drop 0 ] <@ ; + "0" token [ drop 0 ] <@ ; LAZY: 'decimal-point' ( -- parser ) - "." token ; + "." token ; LAZY: 'digit1-9' ( -- parser ) - [ - dup integer? [ - CHAR: 1 CHAR: 9 between? - ] [ - drop f - ] if - ] satisfy [ digit> ] <@ ; + [ + dup integer? [ + CHAR: 1 CHAR: 9 between? + ] [ + drop f + ] if + ] satisfy [ digit> ] <@ ; LAZY: 'digit0-9' ( -- parser ) - [ digit? ] satisfy [ digit> ] <@ ; + [ digit? ] satisfy [ digit> ] <@ ; : decimal>integer ( seq -- num ) 10 digits>integer ; LAZY: 'int' ( -- parser ) - 'zero' - 'digit1-9' 'digit0-9' <*> <&:> [ decimal>integer ] <@ <|> ; + 'zero' + 'digit1-9' 'digit0-9' <*> <&:> [ decimal>integer ] <@ <|> ; LAZY: 'e' ( -- parser ) - "e" token "E" token <|> ; + "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* ; + #! 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' @@ -143,38 +143,38 @@ LAZY: 'exp' ( -- parser ) 'digit0-9' <+> [ decimal>integer ] <@ <&> [ sign-number ] <@ ; : sequence>frac ( seq -- num ) - #! { 1 2 3 } => 0.123 - reverse 0 [ swap 10 / + ] reduce 10 / >float ; + #! { 1 2 3 } => 0.123 + reverse 0 [ swap 10 / + ] reduce 10 / >float ; LAZY: 'frac' ( -- parser ) - 'decimal-point' 'digit0-9' <+> &> [ sequence>frac ] <@ ; + '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 ; + #! 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 ] <@ ; + 'sign' + [ 'int' , 'frac' 0 succeed <|> , ] [<&>] [ sum ] <@ + 'exp' <&> [ raise-to-power ] <@ <&> [ sign-number ] <@ ; LAZY: 'value' ( -- parser ) - [ - 'false' , - 'null' , - 'true' , - 'string' , - 'object' , - 'array' , - 'number' , - ] [<|>] spaced ; + [ + '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 ; + #! Parse a json formatted string to a factor object + 'value' parse dup nil? [ + could-not-parse-json + ] [ + car parsed>> + ] if ; diff --git a/basis/json/writer/writer.factor b/basis/json/writer/writer.factor index d572295c3a..d50a4de8f5 100644 --- a/basis/json/writer/writer.factor +++ b/basis/json/writer/writer.factor @@ -9,42 +9,42 @@ IN: json.writer 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 ; + drop "true" write ; M: json-null json-print ( null -- ) - drop "null" write ; + 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 ; From 6e22f39f469747f309522e63338375a54bd43284 Mon Sep 17 00:00:00 2001 From: Peter Burns Date: Thu, 6 Nov 2008 21:45:24 -0800 Subject: [PATCH 04/22] Rewrote json.reader to use peg.ebnf --- basis/json/reader/reader.factor | 198 ++++++-------------------------- 1 file changed, 37 insertions(+), 161 deletions(-) diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index 132cf9ea73..0feed3750d 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -1,180 +1,56 @@ -! 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 strings math math.functions sequences + arrays vectors hashtables ; IN: json.reader ! Grammar for JSON from RFC 4627 SINGLETON: json-null -: [<&>] ( quot -- quot ) - { } make unclip [ <&> ] reduce ; +EBNF: json> -: [<|>] ( quot -- quot ) - { } make unclip [ <|> ] reduce ; +ws = (" " | "\r" | "\t" | "\n")* -LAZY: 'ws' ( -- parser ) - " " token - "\n" token <|> - "\r" token <|> - "\t" token <|> <*> ; +hex = [0-9a-fA-F] -LAZY: spaced ( parser -- parser ) - 'ws' swap &> 'ws' <& ; +char = '\\"' [[ drop CHAR: " ]] + | "\\\\" [[ drop CHAR: \ ]] + | "\\/" [[ drop CHAR: / ]] + | "\\b" [[ drop 8 ]] + | "\\f" [[ drop 12 ]] + | "\\n" [[ drop CHAR: \n ]] + | "\\r" [[ drop CHAR: \r ]] + | "\\t" [[ drop CHAR: \t ]] + | "\\u" (hex hex hex hex) [[ hex> ]] => [[ 1 swap nth ]] + | [^"\] -LAZY: 'begin-array' ( -- parser ) - "[" token spaced ; +string = '"' char*:cs '"' => [[ cs >string ]] -LAZY: 'begin-object' ( -- parser ) - "{" token spaced ; +number = base:base exp?:exp => [[ base exp [ exp * ] when ]] +base = sign?:s float:f => [[ f s "-" = [ neg ] when ]] +float = digits:int ("." digits)?:frac => [[ int frac [ frac concat append ] when string>number ]] +digits = [0-9]+ => [[ >string ]] -LAZY: 'end-array' ( -- parser ) - "]" token spaced ; +exp = ("e" | "E") (sign)?:s digits:ex => [[ ex string>number s "-" = [ neg ] when 10 swap ^ ]] +sign = "-" | "+" -LAZY: 'end-object' ( -- parser ) - "}" token spaced ; -LAZY: 'name-separator' ( -- parser ) - ":" token spaced ; +array = "[" elements*:vec "]" => [[ 0 vec nth >array ]] +elements = value:head ("," elements)?:tail => [[ head tail [ 1 tail nth ?push ] [ f ?push ] if ]] -LAZY: 'value-separator' ( -- parser ) - "," token spaced ; +object = "{" (members)*:assoc "}" => [[ 0 assoc nth >hashtable ]] +members = pair:head ("," members)?:tail => [[ head tail [ 1 tail nth ?push ] [ f ?push ] if ]] +pair = ws string:key ws ":" value:val => [[ { key val } ]] -LAZY: 'false' ( -- parser ) - "false" token [ drop f ] <@ ; +val = string + | number + | object + | array + | "true" [[ drop t ]] + | "false" [[ drop f ]] + | "null" [[ drop json-null ]] -LAZY: 'null' ( -- parser ) - "null" token [ drop json-null ] <@ ; +value = ws val:v ws => [[ v ]] -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 From 706da24b8c58d2617be46c500174799608a5d73b Mon Sep 17 00:00:00 2001 From: Peter Burns Date: Fri, 7 Nov 2008 20:00:19 -0800 Subject: [PATCH 05/22] Refactored json.reader, added a couple more unit tests, no more rationals --- basis/json/reader/reader-tests.factor | 6 ++- basis/json/reader/reader.factor | 60 +++++++++++++-------------- 2 files changed, 34 insertions(+), 32 deletions(-) diff --git a/basis/json/reader/reader-tests.factor b/basis/json/reader/reader-tests.factor index 995ae0e0b8..84f22f9282 100644 --- a/basis/json/reader/reader-tests.factor +++ b/basis/json/reader/reader-tests.factor @@ -8,12 +8,14 @@ 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 @@ -22,7 +24,9 @@ IN: json.reader.tests { 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 { 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" } } } } diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index 0feed3750d..9b50a6bf38 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -1,55 +1,53 @@ ! Copyright (C) 2008 Peter Burns. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel peg peg.ebnf math.parser strings math math.functions sequences - arrays vectors hashtables ; +USING: kernel peg peg.ebnf math.parser math.private strings math math.functions sequences + arrays vectors hashtables prettyprint ; IN: json.reader -! Grammar for JSON from RFC 4627 - SINGLETON: json-null +! Grammar for JSON from RFC 4627 EBNF: json> ws = (" " | "\r" | "\t" | "\n")* -hex = [0-9a-fA-F] +true = "true" => [[ t ]] +false = "false" => [[ f ]] +null = "null" => [[ json-null ]] -char = '\\"' [[ drop CHAR: " ]] - | "\\\\" [[ drop CHAR: \ ]] - | "\\/" [[ drop CHAR: / ]] - | "\\b" [[ drop 8 ]] - | "\\f" [[ drop 12 ]] - | "\\n" [[ drop CHAR: \n ]] - | "\\r" [[ drop CHAR: \r ]] - | "\\t" [[ drop CHAR: \t ]] +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> ]] => [[ 1 swap nth ]] | [^"\] - string = '"' char*:cs '"' => [[ cs >string ]] -number = base:base exp?:exp => [[ base exp [ exp * ] when ]] -base = sign?:s float:f => [[ f s "-" = [ neg ] when ]] -float = digits:int ("." digits)?:frac => [[ int frac [ frac concat append ] when string>number ]] -digits = [0-9]+ => [[ >string ]] +sign = ("-" | "+")? => [[ "-" = [ "-" ] [ "" ] if ]] +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 ]] -exp = ("e" | "E") (sign)?:s digits:ex => [[ ex string>number s "-" = [ neg ] when 10 swap ^ ]] -sign = "-" | "+" +elements = value ("," value)* => [[ first2 [ second ] map swap prefix >array ]] +array = "[" elements?:arr "]" => [[ arr { } or ]] - -array = "[" elements*:vec "]" => [[ 0 vec nth >array ]] -elements = value:head ("," elements)?:tail => [[ head tail [ 1 tail nth ?push ] [ f ?push ] if ]] - -object = "{" (members)*:assoc "}" => [[ 0 assoc nth >hashtable ]] -members = pair:head ("," members)?:tail => [[ head tail [ 1 tail nth ?push ] [ f ?push ] if ]] pair = ws string:key ws ":" value:val => [[ { key val } ]] +members = pair ("," pair)* => [[ first2 [ second ] map swap prefix >hashtable ]] +object = "{" (members)?:hash "}" => [[ hash H{ } or ]] -val = string +val = true + | false + | null + | string | number - | object | array - | "true" [[ drop t ]] - | "false" [[ drop f ]] - | "null" [[ drop json-null ]] + | object value = ws val:v ws => [[ v ]] From 64cdabf57a386e89520edd20809103be6d10544a Mon Sep 17 00:00:00 2001 From: Peter Burns Date: Sat, 8 Nov 2008 12:08:58 -0800 Subject: [PATCH 06/22] A bit more refactoring and testing of json.reader --- basis/json/authors.txt | 1 + basis/json/reader/reader-tests.factor | 12 +++++++++++- basis/json/reader/reader.factor | 17 ++++++++++------- 3 files changed, 22 insertions(+), 8 deletions(-) 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 84f22f9282..ed444948a7 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 @@ -19,14 +19,24 @@ IN: json.reader.tests { 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> swap drop ] 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" } } } } diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index 9b50a6bf38..858c9ed4de 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -1,11 +1,14 @@ ! Copyright (C) 2008 Peter Burns. ! See http://factorcode.org/license.txt for BSD license. USING: kernel peg peg.ebnf math.parser math.private strings math math.functions sequences - arrays vectors hashtables prettyprint ; + 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> @@ -24,22 +27,22 @@ char = '\\"' [[ CHAR: " ]] | "\\n" [[ CHAR: \n ]] | "\\r" [[ CHAR: \r ]] | "\\t" [[ CHAR: \t ]] - | "\\u" (hex hex hex hex) [[ hex> ]] => [[ 1 swap nth ]] + | "\\u" (hex hex hex hex) [[ hex> ]] => [[ second ]] | [^"\] string = '"' char*:cs '"' => [[ cs >string ]] -sign = ("-" | "+")? => [[ "-" = [ "-" ] [ "" ] if ]] +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 ]] -elements = value ("," value)* => [[ first2 [ second ] map swap prefix >array ]] -array = "[" elements?:arr "]" => [[ arr { } or ]] +elements = value ("," value)* => [[ grammar-list>vector ]] +array = "[" elements?:arr "]" => [[ arr >array ]] pair = ws string:key ws ":" value:val => [[ { key val } ]] -members = pair ("," pair)* => [[ first2 [ second ] map swap prefix >hashtable ]] -object = "{" (members)?:hash "}" => [[ hash H{ } or ]] +members = pair ("," pair)* => [[ grammar-list>vector ]] +object = "{" members?:hash "}" => [[ hash >hashtable ]] val = true | false From a4cecaaf40974238b31dad5804e26cbe48c7ecf6 Mon Sep 17 00:00:00 2001 From: Peter Burns Date: Sat, 8 Nov 2008 13:45:45 -0800 Subject: [PATCH 07/22] swap drop === nip --- basis/json/reader/reader-tests.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/json/reader/reader-tests.factor b/basis/json/reader/reader-tests.factor index ed444948a7..fbd91601bf 100644 --- a/basis/json/reader/reader-tests.factor +++ b/basis/json/reader/reader-tests.factor @@ -35,7 +35,7 @@ IN: json.reader.tests { H{ } } [ "{}" json> ] unit-test ! the returned hashtable should be different every time -{ H{ } } [ "key" "value" "{}" json> ?set-at "{}" json> swap drop ] unit-test +{ 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{ @@ -54,4 +54,3 @@ IN: json.reader.tests { 0 } [ " 0" json> ] unit-test { 0 } [ "0 " json> ] unit-test { 0 } [ " 0 " json> ] unit-test - From ff95802c460e54e140e934e7a6c0c2bf45739984 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 14 Nov 2008 20:17:27 -0600 Subject: [PATCH 08/22] Change tags a bit --- basis/sorting/human/tags.txt | 1 + basis/sorting/insertion/tags.txt | 1 + core/sorting/tags.txt | 1 + extra/advice/tags.txt | 4 +--- 4 files changed, 4 insertions(+), 3 deletions(-) diff --git a/basis/sorting/human/tags.txt b/basis/sorting/human/tags.txt index 3ab2d731fe..93a2a0fa14 100644 --- a/basis/sorting/human/tags.txt +++ b/basis/sorting/human/tags.txt @@ -1,2 +1,3 @@ collections text +algorithms diff --git a/basis/sorting/insertion/tags.txt b/basis/sorting/insertion/tags.txt index 42d711b32b..1e3d675068 100644 --- a/basis/sorting/insertion/tags.txt +++ b/basis/sorting/insertion/tags.txt @@ -1 +1,2 @@ collections +algorithms diff --git a/core/sorting/tags.txt b/core/sorting/tags.txt index 42d711b32b..1e3d675068 100644 --- a/core/sorting/tags.txt +++ b/core/sorting/tags.txt @@ -1 +1,2 @@ collections +algorithms diff --git a/extra/advice/tags.txt b/extra/advice/tags.txt index a87b65d938..f4274299b1 100644 --- a/extra/advice/tags.txt +++ b/extra/advice/tags.txt @@ -1,3 +1 @@ -advice -aspect -annotations +extensions From 9099b126035c99cd146774052fba2d1a534eb351 Mon Sep 17 00:00:00 2001 From: jao Date: Sat, 15 Nov 2008 03:52:20 +0100 Subject: [PATCH 09/22] factor.el: fix for empty strings font lock. --- misc/factor.el | 1 + 1 file changed, 1 insertion(+) diff --git a/misc/factor.el b/misc/factor.el index 72fdf64159..2afb5a7b7f 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -103,6 +103,7 @@ (" !.*$" . font-lock-comment-face) ("( .* )" . font-lock-comment-face) ("\"[^ ][^\"]*\"" . font-lock-string-face) + ("\"\"" . font-lock-string-face) ("\\(P\\|SBUF\\)\"" 1 font-lock-keyword-face) ,@(mapcar #'(lambda (w) (cons (concat "\\(^\\| \\)\\(" w "\\)\\($\\| \\)") '(2 font-lock-keyword-face))) From df3853262424cc7e253ad50674c789a2fb638e16 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 14 Nov 2008 21:21:10 -0600 Subject: [PATCH 10/22] Document furnace.boilerplate --- basis/furnace/actions/actions-docs.factor | 4 +-- .../boilerplate/boilerplate-docs.factor | 36 ++++++++++++------- 2 files changed, 25 insertions(+), 15 deletions(-) diff --git a/basis/furnace/actions/actions-docs.factor b/basis/furnace/actions/actions-docs.factor index 509e0bcdee..dd453ae16d 100644 --- a/basis/furnace/actions/actions-docs.factor +++ b/basis/furnace/actions/actions-docs.factor @@ -19,7 +19,7 @@ HELP: { $description "Creates a new action which serves a Chloe template when servicing a GET request." } ; HELP: action -{ $description "The class of Furnace actions. New instances are created with " { $link } ". New instances of subclasses can be created with " { $link new-action } ". The " { $link page-action } " class is a useful subclass." +{ $class-description "The class of Furnace actions. New instances are created with " { $link } ". New instances of subclasses can be created with " { $link new-action } ". The " { $link page-action } " class is a useful subclass." $nl "Action slots are documented in " { $link "furnace.actions.config" } "." } ; @@ -31,7 +31,7 @@ HELP: new-action { $description "Constructs a subclass of " { $link action } "." } ; HELP: page-action -{ $description "The class of Chloe page actions. These are actions whose " { $slot "display" } " slot is pre-set to serve the Chloe template stored in the " { $slot "page" } " slot." } ; +{ $class-description "The class of Chloe page actions. These are actions whose " { $slot "display" } " slot is pre-set to serve the Chloe template stored in the " { $slot "page" } " slot." } ; HELP: param { $values diff --git a/basis/furnace/boilerplate/boilerplate-docs.factor b/basis/furnace/boilerplate/boilerplate-docs.factor index 5594928082..f8054c8d16 100644 --- a/basis/furnace/boilerplate/boilerplate-docs.factor +++ b/basis/furnace/boilerplate/boilerplate-docs.factor @@ -1,27 +1,37 @@ ! Copyright (C) 2008 Your name. ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax io.streams.string ; +USING: help.markup help.syntax io.streams.string +http.server.dispatchers ; IN: furnace.boilerplate HELP: { $values - { "responder" null } - { "boilerplate" null } + { "responder" "a responder" } + { "boilerplate" "a new boilerplate responder" } } -{ $description "" } ; +{ $description "Wraps a responder in a boilerplate responder. The boilerplate responder needs to be configured before use; see " { $link "furnace.boilerplate.config" } "." } ; HELP: boilerplate -{ $description "" } ; +{ $class-description "The class of boilerplate responders. Slots are documented in " { $link "furnace.boilerplate.config" } "." } ; -HELP: wrap-boilerplate? -{ $values - { "response" null } - { "?" "a boolean" } -} -{ $description "" } ; +ARTICLE: "furnace.boilerplate.config" "Boilerplate configuration" +"The " { $link boilerplate } " tuple has two slots which can be set:" +{ $table + { { $slot "template" } { "A pair with shape " { $snippet "{ responder name }" } ", where " { $snippet "responder" } " is a responder class, usually a subclass of " { $link dispatcher } ", and " { $snippet "name" } " is the name of a template file, without the " { $snippet ".xml" } " extension, relative to the directory containing the responder's vocabulary source file." } } + { { $slot "init" } { "A quotation run before the boilerplate template is rendered. This quotation can set values which the template can then display." } } +} ; + +ARTICLE: "furnace.boilerplate.example" "Boilerplate example" +"The " { $vocab-link "webapps.wiki" } " vocabulary uses boilerplate to add a footer and sidebar to every page. Since the footer and sidebar are themselves dynamic content, it sets the " { $slot "init" } " quotation as well as the " { $slot "template" } " slot:" +{ $code "" +" [ init-sidebars init-relative-link-prefix ] >>init" +" { wiki \"wiki-common\" } >>template" } ; ARTICLE: "furnace.boilerplate" "Furnace boilerplate support" -{ $vocab-link "furnace.boilerplate" } -; +"The " { $vocab-link "furnace.boilerplate" } " vocabulary implements a facility for sharing a common header and footer between different pages on a web site. It builds on top of " { $link "html.templates.boilerplate" } "." +{ $subsection } +{ $subsection "furnace.boilerplate.config" } +{ $subsection "furnace.boilerplate.example" } +{ $see-also "html.templates.chloe.tags.boilerplate" } ; ABOUT: "furnace.boilerplate" From e6da3dc638551d3aac55c6476e82b5e19e1cd3e6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 14 Nov 2008 21:59:15 -0600 Subject: [PATCH 11/22] Document furnace.conversations --- basis/furnace/asides/asides-docs.factor | 4 +- .../boilerplate/boilerplate-docs.factor | 2 - .../conversations/conversations-docs.factor | 53 ++++++++- basis/furnace/furnace-docs.factor | 6 +- basis/furnace/sessions/sessions-docs.factor | 110 +----------------- .../syndication/syndication-docs.factor | 2 - 6 files changed, 58 insertions(+), 119 deletions(-) diff --git a/basis/furnace/asides/asides-docs.factor b/basis/furnace/asides/asides-docs.factor index b977474b5f..c5b7bdd537 100644 --- a/basis/furnace/asides/asides-docs.factor +++ b/basis/furnace/asides/asides-docs.factor @@ -5,7 +5,7 @@ IN: furnace.asides HELP: { $values { "responder" "a responder" } - { "responder'" asides } + { "responder'" "a new responder" } } { $description "Creates a new " { $link asides } " responder wrapping an existing responder." } ; @@ -22,7 +22,7 @@ ARTICLE: "furnace.asides" "Furnace asides" $nl "To use asides, wrap your responder in an aside responder:" { $subsection } -"The aside responder must be wrapped inside a session responder (" { $link } "), which in turn must be wrapped inside a database persistence responder (" { $link } "). The " { $vocab-link "furnace.alloy" } " vocabulary combines all of these responders into one." +"The asides responder must be wrapped inside a session responder (" { $link } "), which in turn must be wrapped inside a database persistence responder (" { $link } "). The " { $vocab-link "furnace.alloy" } " vocabulary combines all of these responders into one." $nl "Saving the current page in an aside which propagates through " { $link } " responses:" { $subsection begin-aside } diff --git a/basis/furnace/boilerplate/boilerplate-docs.factor b/basis/furnace/boilerplate/boilerplate-docs.factor index f8054c8d16..ad983c8dc1 100644 --- a/basis/furnace/boilerplate/boilerplate-docs.factor +++ b/basis/furnace/boilerplate/boilerplate-docs.factor @@ -1,5 +1,3 @@ -! Copyright (C) 2008 Your name. -! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax io.streams.string http.server.dispatchers ; IN: furnace.boilerplate diff --git a/basis/furnace/conversations/conversations-docs.factor b/basis/furnace/conversations/conversations-docs.factor index 5e161f2457..60844fadae 100644 --- a/basis/furnace/conversations/conversations-docs.factor +++ b/basis/furnace/conversations/conversations-docs.factor @@ -1,6 +1,53 @@ -USING: help.markup help.syntax ; +USING: help.markup help.syntax urls http words kernel +furnace.sessions furnace.db ; IN: furnace.conversations -ARTICLE: "furnace.conversations" "Furnace conversation scope" +HELP: +{ $values + { "responder" "a responder" } + { "responder'" "a new responder" } +} +{ $description "Creates a new " { $link conversations } " responder wrapping an existing responder." } ; -; +HELP: begin-conversation +{ $description "Starts a new conversation scope. Values can be stored in the conversation scope with " { $link cset } ", and the conversation can be continued with " { $link } "." } ; + +HELP: end-conversation +{ $description "Ends the current conversation scope." } ; + +HELP: +{ $values { "url" url } { "response" response } } +{ $description "Creates an HTTP response which redirects the client to the specified URL while continuing the conversation. Any values set in the current conversation scope will be visible to the resonder handling the URL." } ; + +HELP: cget +{ $values { "key" symbol } { "value" object } } +{ $description "Outputs the value of a conversation variable." } ; + +HELP: cset +{ $values { "value" object } { "key" symbol } } +{ $description "Sets the value of a conversation variable." } ; + +HELP: cchange +{ $values { "key" symbol } { "quot" "a quotation with stack effect " { $snippet "( old -- new )" } } } +{ $description "Applies the quotation to the old value of the conversation variable, and assigns the resulting value back to the variable." } ; + +ARTICLE: "furnace.conversations" "Furnace conversation scope" +"The " { $vocab-link "furnace.conversations" } " vocabulary implements conversation scope, which allows data to be passed between requests on a finer level of granularity than session scope." +$nl +"Conversation scope is used by form validation to pass validation errors between requests." +$nl +"To use conversation scope, wrap your responder in an conversation responder:" +{ $subsection } +"The conversations responder must be wrapped inside a session responder (" { $link } "), which in turn must be wrapped inside a database persistence responder (" { $link } "). The " { $vocab-link "furnace.alloy" } " vocabulary combines all of these responders into one." +$nl +"Managing conversation scopes:" +{ $subsection begin-conversation } +{ $subsection end-conversation } +{ $subsection } +"Reading and writing conversation variables:" +{ $subsection cget } +{ $subsection cset } +{ $subsection cchange } +"Note that conversation scope is serialized as part of the session, which means that only serializable objects can be stored there. See " { $link "furnace.sessions.serialize" } " for details." ; + +ABOUT: "furnace.conversations" diff --git a/basis/furnace/furnace-docs.factor b/basis/furnace/furnace-docs.factor index 0e2e6c1f40..c49940cc74 100644 --- a/basis/furnace/furnace-docs.factor +++ b/basis/furnace/furnace-docs.factor @@ -166,10 +166,8 @@ ARTICLE: "furnace" "Furnace web framework" } "Major functionality:" { $subsection "furnace.actions" } -{ $subsection "furnace.syndication" } -{ $subsection "furnace.boilerplate" } -{ $subsection "furnace.db" } "Server-side state:" +{ $subsection "furnace.db" } { $subsection "furnace.sessions" } { $subsection "furnace.conversations" } { $subsection "furnace.asides" } @@ -180,8 +178,10 @@ ARTICLE: "furnace" "Furnace web framework" { $subsection "html.templates" } { $subsection "html.templates.chloe" } { $subsection "html.templates.fhtml" } +{ $subsection "furnace.boilerplate" } "Utilities:" { $subsection "furnace.alloy" } +{ $subsection "furnace.syndication" } { $subsection "furnace.json" } { $subsection "furnace.redirection" } { $subsection "furnace.referrer" } ; diff --git a/basis/furnace/sessions/sessions-docs.factor b/basis/furnace/sessions/sessions-docs.factor index 6ec77e00f5..f7aac7e2e9 100644 --- a/basis/furnace/sessions/sessions-docs.factor +++ b/basis/furnace/sessions/sessions-docs.factor @@ -1,22 +1,6 @@ -! Copyright (C) 2008 Your name. -! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax io.streams.string quotations strings ; IN: furnace.sessions -HELP: -{ $values - - { "cookie" null } -} -{ $description "" } ; - -HELP: -{ $values - { "id" null } - { "session" null } -} -{ $description "" } ; - HELP: { $values { "responder" null } @@ -24,98 +8,18 @@ HELP: } { $description "" } ; -HELP: begin-session -{ $values - - { "session" null } -} -{ $description "" } ; - -HELP: check-session -{ $values - { "state/f" null } - { "state/f" null } -} -{ $description "" } ; - -HELP: empty-session -{ $values - - { "session" null } -} -{ $description "" } ; - -HELP: existing-session -{ $values - { "path" "a pathname string" } { "session" null } - { "response" null } -} -{ $description "" } ; - -HELP: get-session -{ $values - { "id" null } - { "session" null } -} -{ $description "" } ; - -HELP: init-session -{ $values - { "session" null } -} -{ $description "" } ; - HELP: init-session* { $values { "responder" null } } { $description "" } ; -HELP: put-session-cookie -{ $values - { "response" null } - { "response'" null } -} -{ $description "" } ; - -HELP: remote-host -{ $values - - { "string" string } -} -{ $description "" } ; - -HELP: request-session -{ $values - - { "session/f" null } -} -{ $description "" } ; - -HELP: save-session-after -{ $values - { "session" null } -} -{ $description "" } ; - HELP: schange { $values { "key" null } { "quot" quotation } } { $description "" } ; -HELP: session -{ $description "" } ; - -HELP: session-changed -{ $description "" } ; - -HELP: session-id-key -{ $description "" } ; - -HELP: sessions -{ $description "" } ; - HELP: sget { $values { "key" null } @@ -129,21 +33,13 @@ HELP: sset } { $description "" } ; -HELP: touch-session -{ $values - { "session" null } -} -{ $description "" } ; +ARTICLE: "furnace.sessions.serialize" "Session state serialization" -HELP: verify-session -{ $values - { "session" null } - { "session" null } -} -{ $description "" } ; +; ARTICLE: "furnace.sessions" "Furnace sessions" { $vocab-link "furnace.sessions" } + ; ABOUT: "furnace.sessions" diff --git a/basis/furnace/syndication/syndication-docs.factor b/basis/furnace/syndication/syndication-docs.factor index 7a9ec57468..e68a5a2965 100644 --- a/basis/furnace/syndication/syndication-docs.factor +++ b/basis/furnace/syndication/syndication-docs.factor @@ -1,5 +1,3 @@ -! Copyright (C) 2008 Your name. -! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax io.streams.string kernel sequences strings urls ; IN: furnace.syndication From 3d83ed07fdcd52d927caa07170b0b04c0d08d154 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 14 Nov 2008 22:49:17 -0600 Subject: [PATCH 12/22] Minor documentation updates: json, xml, serialize --- basis/json/reader/reader-docs.factor | 10 +++++-- basis/json/writer/writer-docs.factor | 10 +++++-- basis/serialize/serialize-docs.factor | 38 ++++++++++++++++++--------- basis/serialize/serialize.factor | 4 +++ basis/xml/xml-docs.factor | 8 +++--- 5 files changed, 48 insertions(+), 22 deletions(-) diff --git a/basis/json/reader/reader-docs.factor b/basis/json/reader/reader-docs.factor index ea4dcbf954..4700423db5 100644 --- a/basis/json/reader/reader-docs.factor +++ b/basis/json/reader/reader-docs.factor @@ -3,6 +3,12 @@ USING: help.markup help.syntax ; IN: json.reader -HELP: json> "( string -- object )" -{ $values { "string" "a string in JSON format" } { "object" "yhe object deserialized from the JSON string" } } +HELP: json> ( string -- object ) +{ $values { "string" "a string in JSON format" } { "object" "a deserialized object" } } { $description "Deserializes the JSON formatted string into a Factor object. JSON objects are converted to Factor hashtables. All other JSON objects convert to their obvious Factor equivalents." } ; + +ARTICLE: "json.reader" "JSON reader" +"The " { $vocab-link "json.reader" } " vocabulary defines a word for parsing strings in JSON format." +{ $subsection json> } ; + +ABOUT: "json.reader" diff --git a/basis/json/writer/writer-docs.factor b/basis/json/writer/writer-docs.factor index 21aa8b2cb5..8512d80384 100644 --- a/basis/json/writer/writer-docs.factor +++ b/basis/json/writer/writer-docs.factor @@ -3,13 +3,19 @@ USING: help.markup help.syntax ; IN: json.writer -HELP: >json "( obj -- string )" +HELP: >json { $values { "obj" "an object" } { "string" "the object converted to JSON format" } } { $description "Serializes the object into a JSON formatted string." } { $see-also json-print } ; -HELP: json-print "( obj -- )" +HELP: json-print { $values { "obj" "an object" } } { $description "Serializes the object into a JSON formatted string and outputs it to the standard output stream." } { $see-also >json } ; +ARTICLE: "json.writer" "JSON writer" +"The " { $vocab-link "json.writer" } " vocabulary defines words for converting objects to JSON format." +{ $subsection >json } +{ $subsection json-print } ; + +ABOUT: "json.writer" diff --git a/basis/serialize/serialize-docs.factor b/basis/serialize/serialize-docs.factor index fc060d6b33..34922a5eae 100644 --- a/basis/serialize/serialize-docs.factor +++ b/basis/serialize/serialize-docs.factor @@ -1,22 +1,34 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. -USING: help.syntax help.markup ; +USING: help.syntax help.markup byte-arrays io ; IN: serialize HELP: serialize -{ $values { "obj" "object to serialize" } -} -{ $description "Serializes the object to the current output stream. Object references within the structure being serialized are maintained." } -{ $examples - { $example "USING: serialize io.encodings.binary io.streams.byte-array prettyprint ;" "binary [ { 1 2 } serialize ] with-byte-writer\n\nbinary [ deserialize ] with-byte-reader ." "{ 1 2 }" } -} -{ $see-also deserialize } ; +{ $values { "obj" "object to serialize" } } +{ $description "Serializes the object to " { $link output-stream } "." } ; HELP: deserialize -{ $values { "obj" "deserialized object" } +{ $values { "obj" "deserialized object" } } +{ $description "Deserializes an object by reading from " { $link input-stream } "." } ; + +HELP: object>bytes +{ $values { "obj" "object to serialize" } { "bytes" byte-array } } -{ $description "Deserializes an object by reading from the current input stream. Object references within the structure that was originally serialized are maintained." } -{ $examples - { $example "USING: serialize io.encodings.binary io.streams.byte-array prettyprint ;" "binary [ { 1 2 } serialize ] with-byte-writer\n\nbinary [ deserialize ] with-byte-reader ." "{ 1 2 }" } +{ $description "Serializes the object to a byte array." } ; + +HELP: bytes>object +{ $values { "bytes" byte-array } { "obj" "deserialized object" } } -{ $see-also serialize } ; +{ $description "Deserializes an object from a byte array." } ; + +ARTICLE: "serialize" "Binary object serialization" +"The " { $vocab-link "serialize" } " vocabulary implements binary serialization for all Factor data types except for continuations. Unlike the prettyprinter, shared structure and circularity is preserved." +$nl +"Storing objects on streams:" +{ $subsection serialize } +{ $subsection deserialize } +"Storing objects as byte arrays:" +{ $subsection object>bytes } +{ $subsection bytes>object } ; + +ABOUT: "serialize" diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor index 52c1535886..2e72fa12cf 100644 --- a/basis/serialize/serialize.factor +++ b/basis/serialize/serialize.factor @@ -15,6 +15,8 @@ locals prettyprint compiler.units sequences.private classes.tuple.private ; IN: serialize + + : deserialize ( -- obj ) ! [ V{ } clone deserialized diff --git a/basis/xml/xml-docs.factor b/basis/xml/xml-docs.factor index 6a2ff1109e..248a43ed63 100644 --- a/basis/xml/xml-docs.factor +++ b/basis/xml/xml-docs.factor @@ -460,10 +460,8 @@ ARTICLE: { "xml" "entities" } "XML entities" { $subsection with-entities } { $subsection with-html-entities } ; -ARTICLE: { "xml" "intro" } "XML" - "The XML module attempts to implement the XML 1.1 standard, converting strings of text into XML and vice versa. It currently is a work in progress." - $nl - "The XML module was implemented by Daniel Ehrenberg, with contributions from the Factor community" +ARTICLE: "xml" "XML parser" +"The " { $vocab-link "xml" } " vocabulary implements the XML 1.1 standard, converting strings of text into XML and vice versa." { $subsection { "xml" "reading" } } { $subsection { "xml" "writing" } } { $subsection { "xml" "classes" } } @@ -476,4 +474,4 @@ ARTICLE: { "xml" "intro" } "XML" IN: xml -ABOUT: { "xml" "intro" } +ABOUT: "xml" From 5c914ff054e044024fdcb6fe843d84766dedb2c4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 14 Nov 2008 22:51:14 -0600 Subject: [PATCH 13/22] Remove bogus dependency --- basis/validators/validators-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/validators/validators-docs.factor b/basis/validators/validators-docs.factor index fc16c48ca0..8c78d6a0db 100644 --- a/basis/validators/validators-docs.factor +++ b/basis/validators/validators-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax io.streams.string quotations -strings math parser-combinators.regexp ; +strings math regexp ; IN: validators HELP: v-captcha From b9afd25245f87ead6d9ed4d0734d62d2873f1c43 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 14 Nov 2008 22:51:53 -0600 Subject: [PATCH 14/22] Document furnace.sessions --- basis/furnace/furnace-docs.factor | 54 ++++++++++----- basis/furnace/sessions/sessions-docs.factor | 66 +++++++++++-------- .../syndication/syndication-docs.factor | 50 +++++++------- 3 files changed, 100 insertions(+), 70 deletions(-) diff --git a/basis/furnace/furnace-docs.factor b/basis/furnace/furnace-docs.factor index c49940cc74..57181ff0e9 100644 --- a/basis/furnace/furnace-docs.factor +++ b/basis/furnace/furnace-docs.factor @@ -155,7 +155,31 @@ HELP: with-exit-continuation } { $description "" } ; -ARTICLE: "furnace" "Furnace web framework" +ARTICLE: "furnace.persistence" "Furnace persistence layer" +{ $subsection "furnace.db" } +"Server-side state:" +{ $subsection "furnace.sessions" } +{ $subsection "furnace.conversations" } +{ $subsection "furnace.asides" } +{ $subsection "furnace.presentation" } ; + +ARTICLE: "furnace.presentation" "Furnace presentation layer" +"HTML components:" +{ $subsection "html.components" } +{ $subsection "html.forms" } +"Content templates:" +{ $subsection "html.templates" } +{ $subsection "html.templates.chloe" } +{ $subsection "html.templates.fhtml" } +{ $subsection "furnace.boilerplate" } +"Other types of content:" +{ $subsection "furnace.syndication" } +{ $subsection "furnace.json" } ; + +ARTICLE: "furnace.load-balancing" "Load balancing and fail-over with Furnace" +"The Furnace session manager persists sessions to a database. This means that HTTP requests can be transparently distributed between multiple Factor HTTP server instances, running the same web app on top of the same database, as long as the web applications do not use mutable global state, such as global variables. The Furnace framework itself does not use any mutable global state." ; + +ARTICLE: "furnace" "Furnace framework" "The " { $vocab-link "furnace" } " vocabulary implements a full-featured web framework on top of the " { $link "http.server" } ". Some of its features include:" { $list "Session management capable of load-balancing and fail-over" @@ -166,24 +190,18 @@ ARTICLE: "furnace" "Furnace web framework" } "Major functionality:" { $subsection "furnace.actions" } -"Server-side state:" -{ $subsection "furnace.db" } -{ $subsection "furnace.sessions" } -{ $subsection "furnace.conversations" } -{ $subsection "furnace.asides" } -"HTML components:" -{ $subsection "html.components" } -{ $subsection "html.forms" } -"Content templates:" -{ $subsection "html.templates" } -{ $subsection "html.templates.chloe" } -{ $subsection "html.templates.fhtml" } -{ $subsection "furnace.boilerplate" } -"Utilities:" { $subsection "furnace.alloy" } -{ $subsection "furnace.syndication" } -{ $subsection "furnace.json" } +{ $subsection "furnace.persistence" } +{ $subsection "furnace.presentation" } +{ $subsection "furnace.load-balancing" } +"Utilities:" +{ $subsection "furnace.referrer" } { $subsection "furnace.redirection" } -{ $subsection "furnace.referrer" } ; +"Related frameworks:" +{ $subsection "db" } +{ $subsection "xml" } +{ $subsection "http.server" } +{ $subsection "logging" } +{ $subsection "urls" } ; ABOUT: "furnace" diff --git a/basis/furnace/sessions/sessions-docs.factor b/basis/furnace/sessions/sessions-docs.factor index f7aac7e2e9..778452edc2 100644 --- a/basis/furnace/sessions/sessions-docs.factor +++ b/basis/furnace/sessions/sessions-docs.factor @@ -1,45 +1,55 @@ -USING: help.markup help.syntax io.streams.string quotations strings ; +USING: help.markup help.syntax io.streams.string quotations strings calendar serialize kernel furnace.db words kernel ; IN: furnace.sessions HELP: { $values - { "responder" null } - { "responder'" null } + { "responder" "a responder" } + { "responder'" "a new responder" } } -{ $description "" } ; - -HELP: init-session* -{ $values - { "responder" null } -} -{ $description "" } ; +{ $description "Wraps a responder in a session manager responder." } ; HELP: schange -{ $values - { "key" null } { "quot" quotation } -} -{ $description "" } ; +{ $values { "key" symbol } { "quot" "a quotation with stack effect " { $snippet "( old -- new )" } } } +{ $description "Applies the quotation to the old value of the session variable, and assigns the resulting value back to the variable." } ; HELP: sget -{ $values - { "key" null } - { "value" null } -} -{ $description "" } ; +{ $values { "key" symbol } { "value" object } } +{ $description "Outputs the value of a session variable." } ; HELP: sset -{ $values - { "value" null } { "key" null } -} -{ $description "" } ; +{ $values { "value" object } { "key" symbol } } +{ $description "Sets the value of a session variable." } ; + +ARTICLE: "furnace.sessions.config" "Session manager configuration" +"The " { $link sessions } " tuple has two slots which contain configuration parameters:" +{ $table + { { $slot "verify?" } { "If set to a true value, the client IP address and user agent of each session is tracked, and checked every time a client attempts to re-establish a session. While this does not offer any real security, it can thwart unskilled packet-sniffing attacks. On by default." } } + { { $slot "timeout" } { "A " { $link duration } " storing the maximum time that inactive sessions will be stored on the server. The default timeout is 20 minutes. Note that for sessions to actually expire, you must start a thread to do so; see the " { $vocab-link "furnace.alloy" } " vocabulary for an easy way of doing this." } } +} ; ARTICLE: "furnace.sessions.serialize" "Session state serialization" - -; +"Session variable values are serialized to the database using the " { $link "serialize" } " library." +$nl +"This means that there are three restrictions on the values stored in the session:" +{ $list + "Continuations cannot be stored at all." + { "Object identity is not preserved between serialization and deserialization. That is, if an object is stored with " { $link sset } " and later retrieved with " { $link sget } ", the retrieved value will be " { $link = } " to the original, but not necessarily " { $link eq? } "." } + { "All objects reachable from the value passed to " { $link sset } " are serialized, so large structures should not be stored in the session state, and neither should anything that can reference the global namespace. Large structures should be persisted in the database directly instead, using " { $vocab-link "db.tuples" } "." } +} ; ARTICLE: "furnace.sessions" "Furnace sessions" -{ $vocab-link "furnace.sessions" } - -; +"The " { $vocab-link "furnace.sessions" } " vocabulary implements session management, which allows state to be maintained between HTTP requests. The session state is stored on the server; the client receives an opaque ID which is saved in a cookie (for GET requests) or a hidden form field (for POST requests)." +$nl +"To use session management, wrap your responder in an session manager:" +{ $subsection } +"The sessions responder must be wrapped inside a database persistence responder (" { $link } "). The " { $vocab-link "furnace.alloy" } " vocabulary combines all of these responders into one." +$nl +"Reading and writing session variables from a request:" +{ $subsection sget } +{ $subsection sset } +{ $subsection schange } +"Additional topics:" +{ $subsection "furnace.sessions.config" } +{ $subsection "furnace.sessions.serialize" } ; ABOUT: "furnace.sessions" diff --git a/basis/furnace/syndication/syndication-docs.factor b/basis/furnace/syndication/syndication-docs.factor index e68a5a2965..a1fb84f0e5 100644 --- a/basis/furnace/syndication/syndication-docs.factor +++ b/basis/furnace/syndication/syndication-docs.factor @@ -1,29 +1,23 @@ -USING: help.markup help.syntax io.streams.string kernel sequences strings urls ; +USING: help.markup help.syntax io.streams.string kernel sequences strings urls syndication ; IN: furnace.syndication HELP: -{ $values - - { "action" null } -} -{ $description "" } ; - -HELP: -{ $values - { "body" null } - { "response" null } -} -{ $description "" } ; +{ $values { "action" feed-action } } +{ $description "Creates a new Atom feed action." } ; HELP: >entry { $values { "object" object } - { "entry" null } + { "entry" entry } } -{ $description "" } ; +{ $contract "Converts an object into an Atom feed entry. The default implementation constructs an entry by calling " +{ $link feed-entry-title } ", " +{ $link feed-entry-description } ", " +{ $link feed-entry-date } ", and " +{ $link feed-entry-url } "." } ; HELP: feed-action -{ $description "" } ; +{ $class-description "The class of feed actions. Contains several slots, documented in " { $link "furnace.syndication.config" } "." } ; HELP: feed-entry-date { $values @@ -53,15 +47,23 @@ HELP: feed-entry-url } { $description "" } ; -HELP: process-entries -{ $values - { "seq" sequence } - { "seq'" sequence } -} -{ $description "" } ; +ARTICLE: "furnace.syndication.config" "Configuring Atom feed actions" -ARTICLE: "furnace.syndication" "Furnace Atom syndication support" -{ $vocab-link "furnace.syndication" } ; +ARTICLE: "furnace.syndication.protocol" "Atom feed entry protocol" +"An Atom feed action takes a sequence of objects and converts them into Atom feed entries. The objects must implement a protocol consisting of either a single generic word:" +{ $subsection >entry } +"Or a series of generic words, called by the default implementation of " { $link >entry } ":" +{ $subsection feed-entry-title } +{ $subsection feed-entry-description } +{ $subsection feed-entry-date } +{ $subsection feed-entry-url } ; + +ARTICLE: "furnace.syndication" "Furnace Atom syndication support" +"The " { $vocab-link "furnace.syndication" } " vocabulary builds on the " { $link "syndication" } " library by providing easy support for generating Atom feeds from " { $link "furnace.actions" } "." +{ $subsection } +{ $subsection "furnace.syndication.config" } +{ $subsection "furnace.syndication.protocol" } ; + ABOUT: "furnace.syndication" From c3c5b4f9449ba61514d149e4307fc8c85fae4183 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 14 Nov 2008 23:01:04 -0600 Subject: [PATCH 15/22] Document furnace.syndication --- .../syndication/syndication-docs.factor | 20 +++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/basis/furnace/syndication/syndication-docs.factor b/basis/furnace/syndication/syndication-docs.factor index a1fb84f0e5..94a69ccd0e 100644 --- a/basis/furnace/syndication/syndication-docs.factor +++ b/basis/furnace/syndication/syndication-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax io.streams.string kernel sequences strings urls syndication ; +USING: help.markup help.syntax io.streams.string kernel sequences strings urls syndication calendar ; IN: furnace.syndication HELP: @@ -22,34 +22,38 @@ HELP: feed-action HELP: feed-entry-date { $values { "object" object } - { "timestamp" null } + { "timestamp" timestamp } } -{ $description "" } ; +{ $contract "Outputs a feed entry timestmap." } ; HELP: feed-entry-description { $values { "object" object } { "description" null } } -{ $description "" } ; +{ $contract "Outputs a feed entry description." } ; HELP: feed-entry-title { $values { "object" object } { "string" string } } -{ $description "" } ; +{ $contract "Outputs a feed entry title." } ; HELP: feed-entry-url { $values { "object" object } { "url" url } } -{ $description "" } ; +{ $contract "Outputs a feed entry URL." } ; ARTICLE: "furnace.syndication.config" "Configuring Atom feed actions" - -; +"Instances of " { $link feed-action } " have three slots which need to be set:" +{ $table + { { $slot "title" } "The title of the feed as a string" } + { { $slot "url" } { "The feed " { $link url } } } + { { $slot "entries" } { "A quotation with stack effect " { $snippet "( -- seq )" } ", which produces a sequence of objects responding to the " { $link "furnace.syndication.protocol" } " protocol" } } +} ; ARTICLE: "furnace.syndication.protocol" "Atom feed entry protocol" "An Atom feed action takes a sequence of objects and converts them into Atom feed entries. The objects must implement a protocol consisting of either a single generic word:" From 821fb8969c576c64517ab35c184987cd195ad276 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 14 Nov 2008 23:01:12 -0600 Subject: [PATCH 16/22] Fix validators docs --- basis/validators/validators-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/validators/validators-docs.factor b/basis/validators/validators-docs.factor index 8c78d6a0db..4f03fa915b 100644 --- a/basis/validators/validators-docs.factor +++ b/basis/validators/validators-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax io.streams.string quotations -strings math regexp ; +strings math regexp regexp.backend ; IN: validators HELP: v-captcha From ca1f3b5af0c42c943f2111957280f8658f6276c4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 15 Nov 2008 02:35:53 -0600 Subject: [PATCH 17/22] (serialize) should not be private since concurrency.distributed defines a method --- basis/serialize/serialize.factor | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor index 2e72fa12cf..f062548482 100644 --- a/basis/serialize/serialize.factor +++ b/basis/serialize/serialize.factor @@ -15,6 +15,8 @@ locals prettyprint compiler.units sequences.private classes.tuple.private ; IN: serialize +GENERIC: (serialize) ( obj -- ) + > ] bi@ eq? ] [ 2drop f ] if ; #! Return the id of an already serialized object serialized get at ; -! Serialize object -GENERIC: (serialize) ( obj -- ) - ! Numbers are serialized as follows: ! 0 => B{ 0 } ! 1<=x<=126 => B{ x | 0x80 } @@ -304,10 +303,8 @@ SYMBOL: deserialized PRIVATE> : deserialize ( -- obj ) - ! [ V{ } clone deserialized [ (deserialize) ] with-variable ; - ! ] with-compilation-unit ; : serialize ( obj -- ) H{ } clone serialized [ (serialize) ] with-variable ; From e313988bf0183489122a31b436ce86fa52b068c1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 15 Nov 2008 03:07:55 -0600 Subject: [PATCH 18/22] json.writer now converts ratios to floats --- basis/json/json.factor | 3 +++ basis/json/reader/reader-tests.factor | 3 ++- basis/json/reader/reader.factor | 10 ++++++---- basis/json/writer/writer-tests.factor | 6 ++++-- basis/json/writer/writer.factor | 14 ++++++++------ 5 files changed, 23 insertions(+), 13 deletions(-) create mode 100644 basis/json/json.factor diff --git a/basis/json/json.factor b/basis/json/json.factor new file mode 100644 index 0000000000..08d2590ee7 --- /dev/null +++ b/basis/json/json.factor @@ -0,0 +1,3 @@ +IN: json + +SINGLETON: json-null diff --git a/basis/json/reader/reader-tests.factor b/basis/json/reader/reader-tests.factor index fbd91601bf..e97d45babe 100644 --- a/basis/json/reader/reader-tests.factor +++ b/basis/json/reader/reader-tests.factor @@ -1,4 +1,5 @@ -USING: arrays json.reader kernel multiline strings tools.test hashtables ; +USING: arrays json.reader kernel multiline strings tools.test +hashtables json ; IN: json.reader.tests { f } [ "false" json> ] unit-test diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index 858c9ed4de..f1520a9272 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -1,14 +1,16 @@ ! Copyright (C) 2008 Peter Burns. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel peg peg.ebnf math.parser math.private strings math math.functions sequences - arrays vectors hashtables assocs prettyprint ; +USING: kernel peg peg.ebnf math.parser math.private strings math +math.functions sequences arrays vectors hashtables assocs +prettyprint json ; IN: json.reader -SINGLETON: json-null - +vector ( seq -- vec ) first2 values swap prefix ; +PRIVATE> + ! Grammar for JSON from RFC 4627 EBNF: json> diff --git a/basis/json/writer/writer-tests.factor b/basis/json/writer/writer-tests.factor index 1b29bac824..6b6118c443 100644 --- a/basis/json/writer/writer-tests.factor +++ b/basis/json/writer/writer-tests.factor @@ -1,4 +1,4 @@ -USING: json.writer tools.test multiline json.reader ; +USING: json.writer tools.test multiline json.reader json ; IN: json.writer.tests { "false" } [ f >json ] unit-test @@ -15,4 +15,6 @@ IN: json.writer.tests ! Random symbols are written simply as strings SYMBOL: testSymbol -{ <" "testSymbol""> } [ testSymbol >json ] unit-test \ No newline at end of file +{ <" "testSymbol""> } [ testSymbol >json ] unit-test + +[ { 0.5 } ] [ { 1/2 } >json json> ] unit-test \ No newline at end of file diff --git a/basis/json/writer/writer.factor b/basis/json/writer/writer.factor index d50a4de8f5..e374919039 100644 --- a/basis/json/writer/writer.factor +++ b/basis/json/writer/writer.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2006 Chris Double. ! 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 json.reader ; +USING: accessors kernel io.streams.string io strings splitting +sequences math math.parser assocs classes words namespaces make +prettyprint hashtables mirrors tr json ; IN: json.writer #! Writes the object out to a stream in JSON format @@ -24,9 +24,12 @@ M: json-null json-print ( null -- ) M: string json-print ( obj -- ) CHAR: " write1 "\"" split "\\\"" join CHAR: \r swap remove "\n" split "\\r\\n" join write CHAR: " write1 ; -M: number json-print ( num -- ) +M: integer json-print ( num -- ) number>string write ; +M: real json-print ( num -- ) + >float number>string write ; + M: sequence json-print ( array -- ) CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ; @@ -46,5 +49,4 @@ M: hashtable json-print ( hashtable -- ) { } assoc>map "," join write CHAR: } write1 ; -M: object json-print ( object -- ) - unparse json-print ; +M: word json-print name>> json-print ; From dced1da5b58ef499b4048be212677f70eef01adb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 15 Nov 2008 03:09:57 -0600 Subject: [PATCH 19/22] More JSON tweaks --- basis/json/json-docs.factor | 8 ++++++++ basis/json/json.factor | 4 ++++ basis/json/reader/reader-docs.factor | 2 +- basis/json/reader/reader.factor | 10 ++++++---- 4 files changed, 19 insertions(+), 5 deletions(-) create mode 100644 basis/json/json-docs.factor diff --git a/basis/json/json-docs.factor b/basis/json/json-docs.factor new file mode 100644 index 0000000000..816e7236ac --- /dev/null +++ b/basis/json/json-docs.factor @@ -0,0 +1,8 @@ +IN: json +USING: help.markup help.syntax ; + +ARTICLE: "json" "JSON serialization" +{ $subsection "json.reader" } +{ $subsection "json.writer" } ; + +ABOUT: "json" diff --git a/basis/json/json.factor b/basis/json/json.factor index 08d2590ee7..d7cfc0e5bc 100644 --- a/basis/json/json.factor +++ b/basis/json/json.factor @@ -1,3 +1,7 @@ IN: json +USE: vocabs.loader SINGLETON: json-null + +"json.reader" require +"json.writer" require diff --git a/basis/json/reader/reader-docs.factor b/basis/json/reader/reader-docs.factor index 4700423db5..4446c385d3 100644 --- a/basis/json/reader/reader-docs.factor +++ b/basis/json/reader/reader-docs.factor @@ -3,7 +3,7 @@ USING: help.markup help.syntax ; IN: json.reader -HELP: json> ( string -- object ) +HELP: json> { $values { "string" "a string in JSON format" } { "object" "a deserialized object" } } { $description "Deserializes the JSON formatted string into a Factor object. JSON objects are converted to Factor hashtables. All other JSON objects convert to their obvious Factor equivalents." } ; diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index f1520a9272..0014ba1eb1 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -9,10 +9,8 @@ IN: json.reader : grammar-list>vector ( seq -- vec ) first2 values swap prefix ; -PRIVATE> - ! Grammar for JSON from RFC 4627 -EBNF: json> +EBNF: (json>) ws = (" " | "\r" | "\t" | "\n")* @@ -56,4 +54,8 @@ val = true value = ws val:v ws => [[ v ]] -;EBNF \ No newline at end of file +;EBNF + +PRIVATE> + +: json> ( string -- object ) (json>) ; \ No newline at end of file From b44bc33d1b3f0fa8039eb2ca3cb270d8cdd645e7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 15 Nov 2008 04:13:03 -0600 Subject: [PATCH 20/22] Fix serialize tsets --- basis/serialize/serialize-tests.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/serialize/serialize-tests.factor b/basis/serialize/serialize-tests.factor index 3a75ad65b6..4ed534151b 100644 --- a/basis/serialize/serialize-tests.factor +++ b/basis/serialize/serialize-tests.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: tools.test kernel serialize io io.streams.byte-array math -alien arrays byte-arrays bit-arrays float-arrays sequences math -prettyprint parser classes math.constants io.encodings.binary -random assocs ; +USING: tools.test kernel serialize serialize.private io +io.streams.byte-array math alien arrays byte-arrays bit-arrays +float-arrays sequences math prettyprint parser classes +math.constants io.encodings.binary random assocs ; IN: serialize.tests : test-serialize-cell From 74e5979ba85741aa3a56bdba015d1b6d214337cc Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 16 Nov 2008 00:16:13 +0100 Subject: [PATCH 21/22] Font lock improvements (highlight word, symbol and tuple definitions). --- misc/factor.el | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/misc/factor.el b/misc/factor.el index 2afb5a7b7f..553597a1c2 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -91,11 +91,23 @@ "TUPLE:" "T{" "t\\??" "TYPEDEF:" "UNION:" "USE:" "USING:" "V{" "VAR:" "VARS:" "W{")) -(defconst factor--regex--parsing-words-ext +(defconst factor--regex-parsing-words-ext (regexp-opt '("B" "call-next-method" "delimiter" "f" "flushable" "foldable" "initial:" "inline" "parsing" "read-only" "recursive") 'words)) +(defun factor--regex-second-word (prefixes) + (format "^%s +\\([^ ]+\\)" (regexp-opt prefixes t))) + +(defconst factor--regex-word-definition + (factor--regex-second-word '(":" "::" "M:" "GENERIC:"))) + +(defconst factor--regex-type-definition + (factor--regex-second-word '("TUPLE:"))) + +(defconst factor--regex-const-definition + (factor--regex-second-word '("SYMBOL:"))) + (defconst factor-font-lock-keywords `(("#!.*$" . font-lock-comment-face) ("!( .* )" . font-lock-comment-face) @@ -108,7 +120,10 @@ ,@(mapcar #'(lambda (w) (cons (concat "\\(^\\| \\)\\(" w "\\)\\($\\| \\)") '(2 font-lock-keyword-face))) factor--parsing-words) - (,factor--regex--parsing-words-ext . font-lock-keyword-face))) + (,factor--regex-parsing-words-ext . font-lock-keyword-face) + (,factor--regex-word-definition 2 font-lock-function-name-face) + (,factor--regex-type-definition 2 font-lock-type-face) + (,factor--regex-const-definition 2 font-lock-constant-face))) (defun factor-indent-line () "Indent current line as Factor code" From e7ccb46254f5d3553e4e9bd156681785aba6e2e4 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 16 Nov 2008 00:19:05 +0100 Subject: [PATCH 22/22] Show keybindings for factor-mode in help buffer (C-h m). --- misc/factor.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/misc/factor.el b/misc/factor.el index 553597a1c2..5d937c14ca 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -130,7 +130,8 @@ (indent-line-to (+ (current-indentation) 4))) (defun factor-mode () - "A mode for editing programs written in the Factor programming language." + "A mode for editing programs written in the Factor programming language. +\\{factor-mode-map}" (interactive) (kill-all-local-variables) (use-local-map factor-mode-map)