From 880a3a2af41ebbec3274eccf3c840e25457de3b8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 17 Mar 2008 14:14:04 -0500
Subject: [PATCH] before major refactoring

---
 extra/db/sqlite/lib/lib.factor      |  1 +
 extra/db/sqlite/sqlite.factor       |  2 ++
 extra/db/tuples/tuples-tests.factor | 42 ++++++++++++++++++++---------
 extra/db/types/types.factor         |  2 --
 4 files changed, 33 insertions(+), 14 deletions(-)

diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor
index 0e512ad018..f81d7de4b8 100755
--- a/extra/db/sqlite/lib/lib.factor
+++ b/extra/db/sqlite/lib/lib.factor
@@ -121,6 +121,7 @@ IN: db.sqlite.lib
     dup array? [ first ] when
     {
         { +native-id+ [ sqlite3_column_int64 ] }
+        { +random-id+ [ sqlite3_column_int64 ] }
         { INTEGER [ sqlite3_column_int ] }
         { BIG-INTEGER [ sqlite3_column_int64 ] }
         { DOUBLE [ sqlite3_column_double ] }
diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index 1b594d6fa4..bca904279b 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -190,6 +190,7 @@ M: sqlite-db modifier-table ( -- hashtable )
     H{
         { +native-id+ "primary key" }
         { +assigned-id+ "primary key" }
+        { +random-id+ "primary key" }
         ! { +nonnative-id+ "primary key" }
         { +autoincrement+ "autoincrement" }
         { +unique+ "unique" }
@@ -209,6 +210,7 @@ M: sqlite-db compound-type ( str seq -- str' )
 M: sqlite-db type-table ( -- assoc )
     H{
         { +native-id+ "integer primary key" }
+        { +random-id+ "integer primary key" }
         { INTEGER "integer" }
         { TEXT "text" }
         { VARCHAR "text" }
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index 2dbf6d1008..6b61981119 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -196,13 +196,6 @@ TUPLE: annotation n paste-id summary author mode contents ;
     [ ] [ person1 get insert-tuple ] unit-test
     [ person1 get insert-tuple ] must-fail ;
 
-[ native-person-schema test-tuples ] test-sqlite
-[ assigned-person-schema test-tuples ] test-sqlite
-[ native-person-schema test-tuples ] test-postgresql
-[ assigned-person-schema test-tuples ] test-postgresql
-[ assigned-person-schema test-repeated-insert ] test-sqlite
-[ assigned-person-schema test-repeated-insert ] test-postgresql
-
 TUPLE: serialize-me id data ;
 
 : test-serialize ( -- )
@@ -247,8 +240,33 @@ TUPLE: exam id name score ;
 
 ! [ test-ranges ] test-sqlite
 
-\ insert-tuple must-infer
-\ update-tuple must-infer
-\ delete-tuple must-infer
-\ select-tuple must-infer
-\ define-persistent must-infer
+TUPLE: secret n message ;
+C: <secret> secret
+
+: test-random-id
+    secret "SECRET"
+    {
+        { "n" "ID" +random-id+ }
+        { "message" "MESSAGE" TEXT }
+    } define-persistent
+
+    [ ] [ secret ensure-table ] unit-test
+    [ ] [ f "kilroy was here" <secret> insert-tuple ] unit-test
+    [ ] [ T{ secret } select-tuples ] unit-test
+    ;
+
+
+
+! [ test-random-id ] test-sqlite
+ [ native-person-schema test-tuples ] test-sqlite
+ [ assigned-person-schema test-tuples ] test-sqlite
+! [ assigned-person-schema test-repeated-insert ] test-sqlite
+! [ native-person-schema test-tuples ] test-postgresql
+! [ assigned-person-schema test-tuples ] test-postgresql
+! [ assigned-person-schema test-repeated-insert ] test-postgresql
+
+! \ insert-tuple must-infer
+! \ update-tuple must-infer
+! \ delete-tuple must-infer
+! \ select-tuple must-infer
+! \ define-persistent must-infer
diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor
index 532c097957..a0414f334d 100755
--- a/extra/db/types/types.factor
+++ b/extra/db/types/types.factor
@@ -15,14 +15,12 @@ HOOK: compound-type db ( str n -- hash )
 
 TUPLE: sql-spec class slot-name column-name type modifiers primary-key ;
 
-
 SINGLETON: +native-id+
 SINGLETON: +assigned-id+
 SINGLETON: +random-id+
 UNION: +primary-key+ +native-id+ +assigned-id+ +random-id+ ;
 UNION: +nonnative-id+ +random-id+ +assigned-id+ ;
 
-! +native-id+ +assigned-id+ +random-assigned-id+
 SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
 +foreign-id+ +has-many+ ;