steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

early tangle working with latest git

db4
Alex Chapman 2008-05-01 10:11:19 +10:00
parent ab796422e5
commit ce2412c4c8
2 changed files with 13 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/semantic-db/semantic-db.factor
View File

@ -15,7 +15,7 @@ node "node"
{ "content" "content" TEXT }
} define-persistent
: delete-node ( node -- ) delete-tuple ;
: delete-node ( node -- ) delete-tuples ;
: create-node ( content -- node ) f swap <node> dup insert-tuple ;
: load-node ( id -- node ) f <node> select-tuple ;
@ -33,7 +33,7 @@ TUPLE: arc id subject object relation ;
: <id-arc> ( id -- arc )
arc new swap >>id ;
: delete-arc ( arc -- ) delete-tuple ;
: delete-arc ( arc -- ) delete-tuples ;
: create-arc ( subject object relation -- )
[ id>> ] 3apply <arc> insert-tuple ;
@ -76,7 +76,7 @@ TUPLE: arc id subject object relation ;
arc "arc"
{
{ "id" "id" +native-id+ +autoincrement+ }
{ "id" "id" +db-assigned-id+ +autoincrement+ }
{ "relation" "relation" INTEGER +not-null+ }
{ "subject" "subject" INTEGER +not-null+ }
{ "object" "object" INTEGER +not-null+ }

36
extra/tangle/tangle.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs db db.sqlite db.postgresql http.server http.server.actions io kernel namespaces semantic-db sequences strings ;
USING: accessors assocs db db.sqlite db.postgresql http http.server http.server.actions io kernel math.parser namespaces semantic-db sequences strings ;
IN: tangle
GENERIC: render* ( content templater -- output )
@ -13,37 +13,21 @@ M: echo-template render* drop ;
! METHOD: render* { string echo-template } drop ;
M: object render render* write ;
TUPLE: tangle db templater ;
TUPLE: tangle db seq templater ;
C: <tangle> tangle
TUPLE: sqlite-tangle ;
TUPLE: postgres-tangle ;
: make-tangle ( db templater type -- tangle )
new [ <tangle> ] dip tuck set-delegate ;
: <sqlite-tangle> ( db templater -- tangle ) sqlite-tangle make-tangle ;
: <postgres-tangle> ( db templater -- tangle ) postgres-tangle make-tangle ;
: with-tangle ( tangle quot -- )
[ db>> ] dip with-db ;
: init-db ( tangle -- tangle )
dup [ init-semantic-db ] with-tangle ;
GENERIC# new-db 1 ( tangle obj -- tangle )
M: sqlite-tangle new-db ( tangle filename -- tangle )
sqlite-db >>db init-db ;
M: postgres-tangle new-db ( tangle args -- tangle )
postgresql-db >>db init-db ;
[ [ db>> ] [ seq>> ] bi ] dip with-db ;
TUPLE: node-responder tangle ;
C: <node-responder> node-responder
: node-response ( responder id -- responder )
load-node [ node-content ] [ "Unknown node" ] if* >>body ;
M: node-responder call-responder* ( path responder -- response )
"text/plain" <content> nip params get
[ "node-id" swap at* [ >>body ] [ drop ] if ] when* nip ;
: test-tangle ( -- )
f f <sqlite-tangle> <node-responder> main-responder set ;
dup tangle>> [
"text/plain" <content> nip request get request-params
[ "node-id" swap at* [ string>number node-response ] [ drop ] if ] when* nip
] with-tangle ;