factor/extra/tangle/tangle.factor

76 lines
2.2 KiB
Factor

! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs db db.sqlite db.postgresql http http.server http.server.actions http.server.static io io.files json.writer kernel math.parser namespaces semantic-db sequences strings tangle.path ;
IN: tangle
GENERIC: render* ( content templater -- output )
GENERIC: render ( content templater -- )
TUPLE: echo-template ;
C: <echo-template> echo-template
M: echo-template render* drop ;
! METHOD: render* { string echo-template } drop ;
M: object render render* write ;
TUPLE: tangle db seq templater ;
C: <tangle> tangle
: with-tangle ( tangle quot -- )
[ [ db>> ] [ seq>> ] bi ] dip with-db ;
: <text-response> ( text -- response )
"text/plain" <content> swap >>body ;
: node-response ( id -- response )
load-node [ node-content <text-response> ] [ <404> ] if* ;
: display-node ( params -- response )
[
"node_id" swap at* [
string>number node-response
] [
drop <400>
] if
] [
<400>
] if* ;
: submit-node ( params -- response )
[
"node_content" swap at* [
create-node id>> number>string <text-response>
] [
drop <400>
] if
] [
<400>
] if* ;
: <node-responder> ( -- responder )
<action> [ params get display-node ] >>display
[ params get submit-node ] >>submit ;
TUPLE: path-responder ;
C: <path-responder> path-responder
M: path-responder call-responder* ( path responder -- response )
drop path>file [ node-content <text-response> ] [ <404> ] if* ;
: <json-response> ( obj -- response )
"application/json" <content> swap >json >>body ;
TUPLE: tangle-dispatcher < dispatcher tangle ;
: <tangle-dispatcher> ( tangle -- dispatcher )
tangle-dispatcher new-dispatcher swap >>tangle
<path-responder> >>default
"resource:extra/tangle/resources" <static> "resources" add-responder
<node-responder> "node" add-responder
<action> [ all-node-ids <json-response> ] >>display "all" add-responder ;
M: tangle-dispatcher call-responder* ( path dispatcher -- response )
dup tangle>> [
find-responder call-responder
] with-tangle ;