From 68b6515ac252f7c155ee1b3ee21c77bfe1d9ce20 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 27 Sep 2008 15:56:43 -0500
Subject: [PATCH] some work on foreign keys

---
 basis/db/postgresql/postgresql.factor |  7 ++++++
 basis/db/sqlite/sqlite.factor         | 33 ++++++++++++++++-----------
 basis/db/tuples/tuples-tests.factor   | 28 ++++++++++++++++++++++-
 basis/db/types/types.factor           | 14 ++++++------
 4 files changed, 61 insertions(+), 21 deletions(-)

diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor
index 60cc584bbf..430109f229 100755
--- a/basis/db/postgresql/postgresql.factor
+++ b/basis/db/postgresql/postgresql.factor
@@ -230,6 +230,13 @@ M: postgresql-db persistent-table ( -- hashtable )
         { +db-assigned-id+ { "integer" "serial" f } }
         { +user-assigned-id+ { f f f } }
         { +random-id+ { "bigint" "bigint" f } }
+
+        { +on-delete+ { f f "on delete" } }
+        { +restrict+ { f f "restrict" } }
+        { +cascade+ { f f "cascade" } }
+        { +set-null+ { f f "set null" } }
+        { +set-default+ { f f "set default" } }
+
         { TEXT { "text" "text" f } }
         { VARCHAR { "varchar" "varchar" f } }
         { INTEGER { "integer" "integer" f } }
diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor
index 0c4ce4717f..60eeb61965 100755
--- a/basis/db/sqlite/sqlite.factor
+++ b/basis/db/sqlite/sqlite.factor
@@ -172,20 +172,27 @@ M: sqlite-db persistent-table ( -- assoc )
         { +user-assigned-id+ { f f f } }
         { +random-id+ { "integer" "integer" f } }
         { +foreign-id+ { "integer" "integer" f } }
+
+        { +on-delete+ { f f "on delete" } }
+        { +restrict+ { f f "restrict" } }
+        { +cascade+ { f f "cascade" } }
+        { +set-null+ { f f "set null" } }
+        { +set-default+ { f f "set default" } }
+
         { INTEGER { "integer" "integer" f } }
-        { BIG-INTEGER { "bigint" "bigint" } }
-        { SIGNED-BIG-INTEGER { "bigint" "bigint" } }
-        { UNSIGNED-BIG-INTEGER { "bigint" "bigint" } }
-        { TEXT { "text" "text" } }
-        { VARCHAR { "text" "text" } }
-        { DATE { "date" "date" } }
-        { TIME { "time" "time" } }
-        { DATETIME { "datetime" "datetime" } }
-        { TIMESTAMP { "timestamp" "timestamp" } }
-        { DOUBLE { "real" "real" } }
-        { BLOB { "blob" "blob" } }
-        { FACTOR-BLOB { "blob" "blob" } }
-        { URL { "text" "text" } }
+        { BIG-INTEGER { "bigint" "bigint" f } }
+        { SIGNED-BIG-INTEGER { "bigint" "bigint" f } }
+        { UNSIGNED-BIG-INTEGER { "bigint" "bigint" f } }
+        { TEXT { "text" "text" f } }
+        { VARCHAR { "text" "text" f } }
+        { DATE { "date" "date" f } }
+        { TIME { "time" "time" f } }
+        { DATETIME { "datetime" "datetime" f } }
+        { TIMESTAMP { "timestamp" "timestamp" f } }
+        { DOUBLE { "real" "real" f } }
+        { BLOB { "blob" "blob" f } }
+        { FACTOR-BLOB { "blob" "blob" f } }
+        { URL { "text" "text" f } }
         { +autoincrement+ { f f "autoincrement" } }
         { +unique+ { f f "unique" } }
         { +default+ { f f "default" } }
diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor
index b3d1b2bbef..7e3aa44c40 100755
--- a/basis/db/tuples/tuples-tests.factor
+++ b/basis/db/tuples/tuples-tests.factor
@@ -210,6 +210,28 @@ TUPLE: annotation n paste-id summary author mode contents ;
     [ ] [ paste drop-table ] unit-test
     [ ] [ paste create-table ] unit-test
     [ ] [ annotation create-table ] unit-test
+
+    [ ] [
+        paste new
+            "summary1" >>summary
+            "erg" >>author
+            "#lol" >>channel
+            "contents1" >>contents
+            now >>timestamp
+        insert-tuple
+    ] unit-test
+
+    [ ] [
+        annotation new
+            1 >>paste-id
+            "annotation1" >>summary
+            "erg" >>author
+            "annotation contents" >>contents
+        insert-tuple
+    ] unit-test
+
+    [ ] [
+    ] unit-test
     ;
 
 [ test-paste-schema ] test-sqlite
@@ -552,5 +574,9 @@ compound-foo "COMPOUND_FOO"
 [ test-compound-primary-key ] test-sqlite
 [ test-compound-primary-key ] test-postgresql
 
-: test-db ( -- )
+: test-sqlite-db ( -- )
     "tuples-test.db" temp-file sqlite-db make-db db-open db set ;
+
+: test-postgresql-db ( -- )
+    { "localhost" "postgres" "foob" "factor-test" } postgresql-db
+    make-db db-open db set ;
diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor
index 0563b677e8..8e2a794cc2 100755
--- a/basis/db/types/types.factor
+++ b/basis/db/types/types.factor
@@ -22,13 +22,12 @@ SINGLETON: random-id-generator
 TUPLE: low-level-binding value ;
 C: <low-level-binding> low-level-binding
 
-SINGLETON: +db-assigned-id+
-SINGLETON: +user-assigned-id+
-SINGLETON: +random-id+
+SINGLETONS: +db-assigned-id+ +user-assigned-id+ +random-id+ ;
 UNION: +primary-key+ +db-assigned-id+ +user-assigned-id+ +random-id+ ;
 
 SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
-+foreign-id+ +has-many+ ;
++foreign-id+ +has-many+ +on-delete+ +restrict+ +cascade+ +set-null+
++set-default+ ;
 
 : offset-of-slot ( string tuple -- n )
     class superclasses [ "slots" word-prop ] map concat
@@ -116,21 +115,22 @@ FACTOR-BLOB NULL URL ;
 ! PostgreSQL Types:
 ! http://developer.postgresql.org/pgdocs/postgres/datatype.html
 
-ERROR: unknown-modifier modifier ;
 
 : ?at ( obj assoc -- value/obj ? )
     dupd at* [ [ nip ] [ drop ] if ] keep ;
 
+ERROR: unknown-modifier modifier ;
+
 : lookup-modifier ( obj -- string )
     {
         { [ dup array? ] [ unclip lookup-modifier swap compound ] }
         [ persistent-table ?at [ unknown-modifier ] unless third ]
     } cond ;
 
-ERROR: no-sql-type ;
+ERROR: no-sql-type type ;
 
 : (lookup-type) ( obj -- string )
-    persistent-table at* [ no-sql-type ] unless ;
+    persistent-table ?at [ no-sql-type ] unless ;
 
 : lookup-type ( obj -- string )
     dup array? [