semantic-db: changing to use db.tuples

extra/semantic-db/context/context.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: semantic-db.db ;
+USING: semantic-db ;
 IN: semantic-db.context
 
 : all-contexts ( -- contexts )

extra/semantic-db/hierarchy/hierarchy.factor

@@ -0,0 +1,6 @@
+! Copyright (C) 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel semantic-db ;
+IN: semantic-db.hierarchy
+
+

extra/semantic-db/semantic-db-tests.factor

@@ -0,0 +1,11 @@
+USING: accessors db db.sqlite db.tuples kernel semantic-db tools.test ;
+IN: temporary
+
+[
+    create-node-table create-arc-table
+    [ 1 ] [ "first node" create-node* ] unit-test
+    [ 2 ] [ "second node" create-node* ] unit-test
+    [ 3 ] [ "third node" create-node* ] unit-test
+    [ 4 ] [ f create-node* ] unit-test
+    [ 5 ] [ 1 2 3 create-arc* ] unit-test
+] with-tmp-sqlite

extra/semantic-db/semantic-db.factor

@@ -0,0 +1,81 @@
+! Copyright (C) 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays db db.tuples db.types db.sqlite kernel new-slots sequences ;
+IN: semantic-db
+
+! new semantic-db using Doug Coleman's new db abstraction library
+
+TUPLE: node id content ;
+: <node> ( content -- node )
+    node construct-empty swap >>content ;
+
+node "node"
+{
+    { "id" "id" SERIAL +native-id+ +autoincrement+ }
+    { "content" "content" TEXT }
+} define-persistent
+
+: create-node-table ( -- )
+    node create-table ;
+
+: create-node* ( content -- id )
+    <node> dup persist id>> ;
+
+: create-node ( content -- )
+    create-node* drop ;
+
+TUPLE: arc relation subject object ;
+
+: <arc> ( relation subject object -- arc )
+    arc construct-empty
+    f <node> over set-delegate
+    swap >>object swap >>subject swap >>relation ;
+
+arc "arc"
+{
+    { "id" "id" SERIAL +native-id+ } ! foreign key to node table?
+    { "relation" "relation" SERIAL +not-null+ }
+    { "subject" "subject" SERIAL +not-null+ }
+    { "object" "object" SERIAL +not-null+ }
+} define-persistent
+
+: create-arc-table ( -- )
+    arc create-table ;
+    ! arc db-columns maybe-remove-id arc db-table create-sql sql-command ;
+
+: insert-arc ( arc -- )
+    dup delegate insert-tuple
+    [ ] [ insert-sql ] make-tuple-statement insert-statement drop ;
+
+: persist-arc ( arc -- )
+    dup primary-key [ update-tuple ] [ insert-arc ] if ;
+
+: delete-arc ( arc -- )
+    dup delete-tuple delegate delete-tuple ;
+
+: create-arc* ( relation subject object -- id )
+    <arc> dup persist-arc id>> ;
+
+: create-arc ( relation subject object -- )
+    create-arc* drop ;
+
+: create-bootstrap-nodes ( -- )
+    { "context" "relation" "is of type" "semantic-db" "is in context" }
+    [ create-node ] each ;
+
+: context-type 1 ; inline
+: relation-type 2 ; inline
+: has-type-relation 3 ; inline
+: semantic-db-context 4 ; inline
+: has-context-relation 5 ; inline
+
+: create-bootstrap-arcs ( -- )
+    has-type-relation has-type-relation relation-type create-arc
+    has-type-relation semantic-db-context context-type create-arc
+    has-context-relation has-type-relation semantic-db-context create-arc
+    has-type-relation has-context-relation relation-type create-arc
+    has-context-relation has-context-relation semantic-db-context create-arc ;
+
+: init-semantic-db ( -- )
+    create-node-table create-arc-table create-bootstrap-nodes create-bootstrap-arcs ;
+