Merge branch 'master' of git://factorcode.org/git/factor

db4
John Benediktsson 2008-11-15 17:16:54 -08:00
commit 2aee0f74f2
26 changed files with 392 additions and 429 deletions

View File

@ -19,7 +19,7 @@ HELP: <page-action>
{ $description "Creates a new action which serves a Chloe template when servicing a GET request." } ; { $description "Creates a new action which serves a Chloe template when servicing a GET request." } ;
HELP: action HELP: action
{ $description "The class of Furnace actions. New instances are created with " { $link <action> } ". 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 <action> } ". New instances of subclasses can be created with " { $link new-action } ". The " { $link page-action } " class is a useful subclass."
$nl $nl
"Action slots are documented in " { $link "furnace.actions.config" } "." } ; "Action slots are documented in " { $link "furnace.actions.config" } "." } ;
@ -31,7 +31,7 @@ HELP: new-action
{ $description "Constructs a subclass of " { $link action } "." } ; { $description "Constructs a subclass of " { $link action } "." } ;
HELP: page-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 HELP: param
{ $values { $values

View File

@ -5,7 +5,7 @@ IN: furnace.asides
HELP: <asides> HELP: <asides>
{ $values { $values
{ "responder" "a responder" } { "responder" "a responder" }
{ "responder'" asides } { "responder'" "a new responder" }
} }
{ $description "Creates a new " { $link asides } " responder wrapping an existing responder." } ; { $description "Creates a new " { $link asides } " responder wrapping an existing responder." } ;
@ -22,7 +22,7 @@ ARTICLE: "furnace.asides" "Furnace asides"
$nl $nl
"To use asides, wrap your responder in an aside responder:" "To use asides, wrap your responder in an aside responder:"
{ $subsection <asides> } { $subsection <asides> }
"The aside responder must be wrapped inside a session responder (" { $link <sessions> } "), which in turn must be wrapped inside a database persistence responder (" { $link <db-persistence> } "). The " { $vocab-link "furnace.alloy" } " vocabulary combines all of these responders into one." "The asides responder must be wrapped inside a session responder (" { $link <sessions> } "), which in turn must be wrapped inside a database persistence responder (" { $link <db-persistence> } "). The " { $vocab-link "furnace.alloy" } " vocabulary combines all of these responders into one."
$nl $nl
"Saving the current page in an aside which propagates through " { $link <redirect> } " responses:" "Saving the current page in an aside which propagates through " { $link <redirect> } " responses:"
{ $subsection begin-aside } { $subsection begin-aside }

View File

@ -1,27 +1,35 @@
! Copyright (C) 2008 Your name. USING: help.markup help.syntax io.streams.string
! See http://factorcode.org/license.txt for BSD license. http.server.dispatchers ;
USING: help.markup help.syntax io.streams.string ;
IN: furnace.boilerplate IN: furnace.boilerplate
HELP: <boilerplate> HELP: <boilerplate>
{ $values { $values
{ "responder" null } { "responder" "a responder" }
{ "boilerplate" null } { "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 HELP: boilerplate
{ $description "" } ; { $class-description "The class of boilerplate responders. Slots are documented in " { $link "furnace.boilerplate.config" } "." } ;
HELP: wrap-boilerplate? ARTICLE: "furnace.boilerplate.config" "Boilerplate configuration"
{ $values "The " { $link boilerplate } " tuple has two slots which can be set:"
{ "response" null } { $table
{ "?" "a boolean" } { { $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." } }
{ $description "" } ; } ;
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 "<boilerplate>"
" [ init-sidebars init-relative-link-prefix ] >>init"
" { wiki \"wiki-common\" } >>template" } ;
ARTICLE: "furnace.boilerplate" "Furnace boilerplate support" 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 <boilerplate> }
{ $subsection "furnace.boilerplate.config" }
{ $subsection "furnace.boilerplate.example" }
{ $see-also "html.templates.chloe.tags.boilerplate" } ;
ABOUT: "furnace.boilerplate" ABOUT: "furnace.boilerplate"

View File

@ -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 IN: furnace.conversations
ARTICLE: "furnace.conversations" "Furnace conversation scope" HELP: <conversations>
{ $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 <continue-conversation> } "." } ;
HELP: end-conversation
{ $description "Ends the current conversation scope." } ;
HELP: <continue-conversation>
{ $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 <conversations> }
"The conversations responder must be wrapped inside a session responder (" { $link <sessions> } "), which in turn must be wrapped inside a database persistence responder (" { $link <db-persistence> } "). The " { $vocab-link "furnace.alloy" } " vocabulary combines all of these responders into one."
$nl
"Managing conversation scopes:"
{ $subsection begin-conversation }
{ $subsection end-conversation }
{ $subsection <continue-conversation> }
"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"

View File

@ -155,7 +155,31 @@ HELP: with-exit-continuation
} }
{ $description "" } ; { $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:" "The " { $vocab-link "furnace" } " vocabulary implements a full-featured web framework on top of the " { $link "http.server" } ". Some of its features include:"
{ $list { $list
"Session management capable of load-balancing and fail-over" "Session management capable of load-balancing and fail-over"
@ -166,24 +190,18 @@ ARTICLE: "furnace" "Furnace web framework"
} }
"Major functionality:" "Major functionality:"
{ $subsection "furnace.actions" } { $subsection "furnace.actions" }
{ $subsection "furnace.syndication" }
{ $subsection "furnace.boilerplate" }
{ $subsection "furnace.db" }
"Server-side state:"
{ $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" }
"Utilities:"
{ $subsection "furnace.alloy" } { $subsection "furnace.alloy" }
{ $subsection "furnace.json" } { $subsection "furnace.persistence" }
{ $subsection "furnace.presentation" }
{ $subsection "furnace.load-balancing" }
"Utilities:"
{ $subsection "furnace.referrer" }
{ $subsection "furnace.redirection" } { $subsection "furnace.redirection" }
{ $subsection "furnace.referrer" } ; "Related frameworks:"
{ $subsection "db" }
{ $subsection "xml" }
{ $subsection "http.server" }
{ $subsection "logging" }
{ $subsection "urls" } ;
ABOUT: "furnace" ABOUT: "furnace"

View File

@ -1,149 +1,55 @@
! Copyright (C) 2008 Your name. USING: help.markup help.syntax io.streams.string quotations strings calendar serialize kernel furnace.db words kernel ;
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax io.streams.string quotations strings ;
IN: furnace.sessions IN: furnace.sessions
HELP: <session-cookie>
{ $values
{ "cookie" null }
}
{ $description "" } ;
HELP: <session>
{ $values
{ "id" null }
{ "session" null }
}
{ $description "" } ;
HELP: <sessions> HELP: <sessions>
{ $values { $values
{ "responder" null } { "responder" "a responder" }
{ "responder'" null } { "responder'" "a new responder" }
} }
{ $description "" } ; { $description "Wraps a responder in a session manager responder." } ;
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 HELP: schange
{ $values { $values { "key" symbol } { "quot" "a quotation with stack effect " { $snippet "( old -- new )" } } }
{ "key" null } { "quot" quotation } { $description "Applies the quotation to the old value of the session variable, and assigns the resulting value back to the variable." } ;
}
{ $description "" } ;
HELP: session
{ $description "" } ;
HELP: session-changed
{ $description "" } ;
HELP: session-id-key
{ $description "" } ;
HELP: sessions
{ $description "" } ;
HELP: sget HELP: sget
{ $values { $values { "key" symbol } { "value" object } }
{ "key" null } { $description "Outputs the value of a session variable." } ;
{ "value" null }
}
{ $description "" } ;
HELP: sset HELP: sset
{ $values { $values { "value" object } { "key" symbol } }
{ "value" null } { "key" null } { $description "Sets the value of a session variable." } ;
}
{ $description "" } ;
HELP: touch-session ARTICLE: "furnace.sessions.config" "Session manager configuration"
{ $values "The " { $link sessions } " tuple has two slots which contain configuration parameters:"
{ "session" null } { $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." } }
{ $description "" } ; { { $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." } }
} ;
HELP: verify-session ARTICLE: "furnace.sessions.serialize" "Session state serialization"
{ $values "Session variable values are serialized to the database using the " { $link "serialize" } " library."
{ "session" null } $nl
{ "session" null } "This means that there are three restrictions on the values stored in the session:"
} { $list
{ $description "" } ; "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" 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 <sessions> }
"The sessions responder must be wrapped inside a database persistence responder (" { $link <db-persistence> } "). 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" ABOUT: "furnace.sessions"

View File

@ -1,69 +1,73 @@
! Copyright (C) 2008 Your name. USING: help.markup help.syntax io.streams.string kernel sequences strings urls syndication calendar ;
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax io.streams.string kernel sequences strings urls ;
IN: furnace.syndication IN: furnace.syndication
HELP: <feed-action> HELP: <feed-action>
{ $values { $values { "action" feed-action } }
{ $description "Creates a new Atom feed action." } ;
{ "action" null }
}
{ $description "" } ;
HELP: <feed-content>
{ $values
{ "body" null }
{ "response" null }
}
{ $description "" } ;
HELP: >entry HELP: >entry
{ $values { $values
{ "object" object } { "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 HELP: feed-action
{ $description "" } ; { $class-description "The class of feed actions. Contains several slots, documented in " { $link "furnace.syndication.config" } "." } ;
HELP: feed-entry-date HELP: feed-entry-date
{ $values { $values
{ "object" object } { "object" object }
{ "timestamp" null } { "timestamp" timestamp }
} }
{ $description "" } ; { $contract "Outputs a feed entry timestmap." } ;
HELP: feed-entry-description HELP: feed-entry-description
{ $values { $values
{ "object" object } { "object" object }
{ "description" null } { "description" null }
} }
{ $description "" } ; { $contract "Outputs a feed entry description." } ;
HELP: feed-entry-title HELP: feed-entry-title
{ $values { $values
{ "object" object } { "object" object }
{ "string" string } { "string" string }
} }
{ $description "" } ; { $contract "Outputs a feed entry title." } ;
HELP: feed-entry-url HELP: feed-entry-url
{ $values { $values
{ "object" object } { "object" object }
{ "url" url } { "url" url }
} }
{ $description "" } ; { $contract "Outputs a feed entry URL." } ;
HELP: process-entries ARTICLE: "furnace.syndication.config" "Configuring Atom feed actions"
{ $values "Instances of " { $link feed-action } " have three slots which need to be set:"
{ "seq" sequence } { $table
{ "seq'" sequence } { { $slot "title" } "The title of the feed as a string" }
} { { $slot "url" } { "The feed " { $link url } } }
{ $description "" } ; { { $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:"
{ $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" ARTICLE: "furnace.syndication" "Furnace Atom syndication support"
{ $vocab-link "furnace.syndication" } "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 <feed-action> }
{ $subsection "furnace.syndication.config" }
{ $subsection "furnace.syndication.protocol" } ;
ABOUT: "furnace.syndication" ABOUT: "furnace.syndication"

View File

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

View File

@ -0,0 +1,8 @@
IN: json
USING: help.markup help.syntax ;
ARTICLE: "json" "JSON serialization"
{ $subsection "json.reader" }
{ $subsection "json.writer" } ;
ABOUT: "json"

7
basis/json/json.factor Normal file
View File

@ -0,0 +1,7 @@
IN: json
USE: vocabs.loader
SINGLETON: json-null
"json.reader" require
"json.writer" require

View File

@ -3,6 +3,12 @@
USING: help.markup help.syntax ; USING: help.markup help.syntax ;
IN: json.reader IN: json.reader
HELP: json> "( string -- object )" HELP: json>
{ $values { "string" "a string in JSON format" } { "object" "yhe object deserialized from the JSON string" } } { $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." } ; { $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"

View File

@ -1,4 +1,5 @@
USING: arrays json.reader kernel multiline strings tools.test ; USING: arrays json.reader kernel multiline strings tools.test
hashtables json ;
IN: json.reader.tests IN: json.reader.tests
{ f } [ "false" json> ] unit-test { f } [ "false" json> ] unit-test
@ -8,21 +9,35 @@ IN: json.reader.tests
{ 102 } [ "102" json> ] unit-test { 102 } [ "102" json> ] unit-test
{ -102 } [ "-102" json> ] unit-test { -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.0 } [ "102.0" json> ] unit-test
{ 102.5 } [ "102.5" json> ] unit-test { 102.5 } [ "102.5" json> ] unit-test
{ 102.5 } [ "102.50" json> ] unit-test { 102.5 } [ "102.50" json> ] unit-test
{ -10250.0 } [ "-102.5e2" json> ] unit-test { -10250.0 } [ "-102.5e2" json> ] unit-test
{ -10250.0 } [ "-102.5E+2" 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
{ -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 { " fuzzy pickles " } [ <" " fuzzy pickles " "> json> ] unit-test
{ "while 1:\n\tpass" } [ <" "while 1:\n\tpass" "> 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 { 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 { HEX: abcd } >string 1array [ <" "\uaBCd" "> json> ] unit-test
{ { } } [ "[]" json> ] unit-test
{ { 1 "two" 3.0 } } [ <" [1, "two", 3.0] "> 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{ { "US$" 1.0 } { "EU€" 1.5 } } } [ <" { "US$":1.00, "EU\u20AC":1.50 } "> json> ] unit-test
{ H{ { H{
{ "fib" { 1 1 2 3 5 8 H{ { "etc" "etc" } } } } { "fib" { 1 1 2 3 5 8 H{ { "etc" "etc" } } } }
@ -40,4 +55,3 @@ IN: json.reader.tests
{ 0 } [ " 0" json> ] unit-test { 0 } [ " 0" json> ] unit-test
{ 0 } [ "0 " json> ] unit-test { 0 } [ "0 " json> ] unit-test
{ 0 } [ " 0 " json> ] unit-test { 0 } [ " 0 " json> ] unit-test

View File

@ -1,180 +1,61 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2008 Peter Burns.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel parser-combinators namespaces make sequences promises strings USING: kernel peg peg.ebnf math.parser math.private strings math
assocs math math.parser math.vectors math.functions math.order math.functions sequences arrays vectors hashtables assocs
lists hashtables ascii accessors ; prettyprint json ;
IN: json.reader IN: json.reader
<PRIVATE
: grammar-list>vector ( seq -- vec ) first2 values swap prefix ;
! Grammar for JSON from RFC 4627 ! Grammar for JSON from RFC 4627
EBNF: (json>)
SYMBOL: json-null ws = (" " | "\r" | "\t" | "\n")*
: [<&>] ( quot -- quot ) true = "true" => [[ t ]]
{ } make unclip [ <&> ] reduce ; false = "false" => [[ f ]]
null = "null" => [[ json-null ]]
: [<|>] ( quot -- quot ) hex = [0-9a-fA-F]
{ } make unclip [ <|> ] reduce ; char = '\\"' [[ CHAR: " ]]
| "\\\\" [[ CHAR: \ ]]
| "\\/" [[ CHAR: / ]]
| "\\b" [[ 8 ]]
| "\\f" [[ 12 ]]
| "\\n" [[ CHAR: \n ]]
| "\\r" [[ CHAR: \r ]]
| "\\t" [[ CHAR: \t ]]
| "\\u" (hex hex hex hex) [[ hex> ]] => [[ second ]]
| [^"\]
string = '"' char*:cs '"' => [[ cs >string ]]
LAZY: 'ws' ( -- parser ) sign = ("-" | "+")? => [[ "-" = "-" "" ? ]]
" " token digits = [0-9]+ => [[ >string ]]
"\n" token <|> decimal = "." digits => [[ concat ]]
"\r" token <|> exp = ("e" | "E") sign digits => [[ concat ]]
"\t" token <|> <*> ; number = sign digits decimal? exp? => [[ dup concat swap fourth [ string>float ] [ string>number ] if ]]
LAZY: spaced ( parser -- parser ) elements = value ("," value)* => [[ grammar-list>vector ]]
'ws' swap &> 'ws' <& ; array = "[" elements?:arr "]" => [[ arr >array ]]
LAZY: 'begin-array' ( -- parser ) pair = ws string:key ws ":" value:val => [[ { key val } ]]
"[" token spaced ; members = pair ("," pair)* => [[ grammar-list>vector ]]
object = "{" members?:hash "}" => [[ hash >hashtable ]]
LAZY: 'begin-object' ( -- parser ) val = true
"{" token spaced ; | false
| null
| string
| number
| array
| object
LAZY: 'end-array' ( -- parser ) value = ws val:v ws => [[ v ]]
"]" token spaced ;
LAZY: 'end-object' ( -- parser ) ;EBNF
"}" token spaced ;
LAZY: 'name-separator' ( -- parser ) PRIVATE>
":" token spaced ;
LAZY: 'value-separator' ( -- parser ) : json> ( string -- object ) (json>) ;
"," 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 ;

View File

@ -3,13 +3,19 @@
USING: help.markup help.syntax ; USING: help.markup help.syntax ;
IN: json.writer IN: json.writer
HELP: >json "( obj -- string )" HELP: >json
{ $values { "obj" "an object" } { "string" "the object converted to JSON format" } } { $values { "obj" "an object" } { "string" "the object converted to JSON format" } }
{ $description "Serializes the object into a JSON formatted string." } { $description "Serializes the object into a JSON formatted string." }
{ $see-also json-print } ; { $see-also json-print } ;
HELP: json-print "( obj -- )" HELP: json-print
{ $values { "obj" "an object" } } { $values { "obj" "an object" } }
{ $description "Serializes the object into a JSON formatted string and outputs it to the standard output stream." } { $description "Serializes the object into a JSON formatted string and outputs it to the standard output stream." }
{ $see-also >json } ; { $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"

View File

@ -0,0 +1,20 @@
USING: json.writer tools.test multiline json.reader json ;
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
[ { 0.5 } ] [ { 1/2 } >json json> ] unit-test

View File

@ -1,8 +1,8 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel io.streams.string io strings splitting sequences USING: accessors kernel io.streams.string io strings splitting
math math.parser assocs classes words namespaces make sequences math math.parser assocs classes words namespaces make
prettyprint hashtables mirrors tr ; prettyprint hashtables mirrors tr json ;
IN: json.writer IN: json.writer
#! Writes the object out to a stream in JSON format #! Writes the object out to a stream in JSON format
@ -15,12 +15,21 @@ GENERIC: json-print ( obj -- )
M: f json-print ( f -- ) 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 -- ) 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 -- ) M: integer json-print ( num -- )
number>string write ; number>string write ;
M: real json-print ( num -- )
>float number>string write ;
M: sequence json-print ( array -- ) M: sequence json-print ( array -- )
CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ; CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ;
@ -40,5 +49,4 @@ M: hashtable json-print ( hashtable -- )
{ } assoc>map "," join write { } assoc>map "," join write
CHAR: } write1 ; CHAR: } write1 ;
M: object json-print ( object -- ) M: word json-print name>> json-print ;
unparse json-print ;

View File

@ -1,22 +1,34 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.syntax help.markup ; USING: help.syntax help.markup byte-arrays io ;
IN: serialize IN: serialize
HELP: serialize HELP: serialize
{ $values { "obj" "object to serialize" } { $values { "obj" "object to serialize" } }
} { $description "Serializes the object to " { $link output-stream } "." } ;
{ $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 } ;
HELP: deserialize 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." } { $description "Serializes the object to a byte array." } ;
{ $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 }" } 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"

View File

@ -1,10 +1,10 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: tools.test kernel serialize io io.streams.byte-array math USING: tools.test kernel serialize serialize.private io
alien arrays byte-arrays bit-arrays float-arrays sequences math io.streams.byte-array math alien arrays byte-arrays bit-arrays
prettyprint parser classes math.constants io.encodings.binary float-arrays sequences math prettyprint parser classes
random assocs ; math.constants io.encodings.binary random assocs ;
IN: serialize.tests IN: serialize.tests
: test-serialize-cell : test-serialize-cell

View File

@ -15,6 +15,10 @@ locals prettyprint compiler.units sequences.private
classes.tuple.private ; classes.tuple.private ;
IN: serialize IN: serialize
GENERIC: (serialize) ( obj -- )
<PRIVATE
! Variable holding a assoc of objects already serialized ! Variable holding a assoc of objects already serialized
SYMBOL: serialized SYMBOL: serialized
@ -35,9 +39,6 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
#! Return the id of an already serialized object #! Return the id of an already serialized object
<id> serialized get at ; <id> serialized get at ;
! Serialize object
GENERIC: (serialize) ( obj -- )
! Numbers are serialized as follows: ! Numbers are serialized as follows:
! 0 => B{ 0 } ! 0 => B{ 0 }
! 1<=x<=126 => B{ x | 0x80 } ! 1<=x<=126 => B{ x | 0x80 }
@ -299,11 +300,11 @@ SYMBOL: deserialized
: (deserialize) ( -- obj ) : (deserialize) ( -- obj )
deserialize* [ "End of stream" throw ] unless ; deserialize* [ "End of stream" throw ] unless ;
PRIVATE>
: deserialize ( -- obj ) : deserialize ( -- obj )
! [
V{ } clone deserialized V{ } clone deserialized
[ (deserialize) ] with-variable ; [ (deserialize) ] with-variable ;
! ] with-compilation-unit ;
: serialize ( obj -- ) : serialize ( obj -- )
H{ } clone serialized [ (serialize) ] with-variable ; H{ } clone serialized [ (serialize) ] with-variable ;

View File

@ -1,2 +1,3 @@
collections collections
text text
algorithms

View File

@ -1 +1,2 @@
collections collections
algorithms

View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax io.streams.string quotations USING: help.markup help.syntax io.streams.string quotations
strings math parser-combinators.regexp ; strings math regexp regexp.backend ;
IN: validators IN: validators
HELP: v-captcha HELP: v-captcha

View File

@ -460,10 +460,8 @@ ARTICLE: { "xml" "entities" } "XML entities"
{ $subsection with-entities } { $subsection with-entities }
{ $subsection with-html-entities } ; { $subsection with-html-entities } ;
ARTICLE: { "xml" "intro" } "XML" ARTICLE: "xml" "XML parser"
"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." "The " { $vocab-link "xml" } " vocabulary implements the XML 1.1 standard, converting strings of text into XML and vice versa."
$nl
"The XML module was implemented by Daniel Ehrenberg, with contributions from the Factor community"
{ $subsection { "xml" "reading" } } { $subsection { "xml" "reading" } }
{ $subsection { "xml" "writing" } } { $subsection { "xml" "writing" } }
{ $subsection { "xml" "classes" } } { $subsection { "xml" "classes" } }
@ -476,4 +474,4 @@ ARTICLE: { "xml" "intro" } "XML"
IN: xml IN: xml
ABOUT: { "xml" "intro" } ABOUT: "xml"

View File

@ -1 +1,2 @@
collections collections
algorithms

View File

@ -1,3 +1 @@
advice extensions
aspect
annotations

View File

@ -91,11 +91,23 @@
"TUPLE:" "T{" "t\\??" "TYPEDEF:" "TUPLE:" "T{" "t\\??" "TYPEDEF:"
"UNION:" "USE:" "USING:" "V{" "VAR:" "VARS:" "W{")) "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" (regexp-opt '("B" "call-next-method" "delimiter" "f" "flushable" "foldable"
"initial:" "inline" "parsing" "read-only" "recursive") "initial:" "inline" "parsing" "read-only" "recursive")
'words)) '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 (defconst factor-font-lock-keywords
`(("#!.*$" . font-lock-comment-face) `(("#!.*$" . font-lock-comment-face)
("!( .* )" . font-lock-comment-face) ("!( .* )" . font-lock-comment-face)
@ -103,18 +115,23 @@
(" !.*$" . font-lock-comment-face) (" !.*$" . font-lock-comment-face)
("( .* )" . font-lock-comment-face) ("( .* )" . font-lock-comment-face)
("\"[^ ][^\"]*\"" . font-lock-string-face) ("\"[^ ][^\"]*\"" . font-lock-string-face)
("\"\"" . font-lock-string-face)
("\\(P\\|SBUF\\)\"" 1 font-lock-keyword-face) ("\\(P\\|SBUF\\)\"" 1 font-lock-keyword-face)
,@(mapcar #'(lambda (w) (cons (concat "\\(^\\| \\)\\(" w "\\)\\($\\| \\)") ,@(mapcar #'(lambda (w) (cons (concat "\\(^\\| \\)\\(" w "\\)\\($\\| \\)")
'(2 font-lock-keyword-face))) '(2 font-lock-keyword-face)))
factor--parsing-words) 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 () (defun factor-indent-line ()
"Indent current line as Factor code" "Indent current line as Factor code"
(indent-line-to (+ (current-indentation) 4))) (indent-line-to (+ (current-indentation) 4)))
(defun factor-mode () (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) (interactive)
(kill-all-local-variables) (kill-all-local-variables)
(use-local-map factor-mode-map) (use-local-map factor-mode-map)