redo lookup-type

extra/db/postgresql/postgresql.factor

@@ -135,7 +135,7 @@ M: postgresql-db bind# ( spec obj -- )
         "(" 0% [ ", " 0% ] [
             dup column-name>> 0%
             " " 0%
-            dup type>> t lookup-type 0%
+            dup type>> lookup-create-type 0%
             modifiers 0%
         ] interleave ");" 0%
     ] postgresql-make ;
@@ -147,7 +147,7 @@ M: postgresql-db bind# ( spec obj -- )
         "(" 0%
         over [ "," 0% ]
         [
-            type>> f lookup-type 0%
+            type>> lookup-type 0%
         ] interleave
         ")" 0%
         " returns bigint as '" 0%
@@ -174,7 +174,7 @@ M: postgresql-db create-sql-statement ( class -- seq )
         "drop function add_" 0% 0%
         "(" 0%
         remove-id
-        [ ", " 0% ] [ type>> f lookup-type 0% ] interleave
+        [ ", " 0% ] [ type>> lookup-type 0% ] interleave
         ");" 0%
     ] postgresql-make ;
 
@@ -252,42 +252,33 @@ M: postgresql-db <select-by-slots-statement> ( tuple class -- statement )
         ] if ";" 0%
     ] postgresql-make ;
 
-M: postgresql-db type-table ( -- hash )
+M: postgresql-db persistent-table ( -- hashtable )
     H{
-        { +native-id+ "integer" }
+        { +native-id+ { "integer" "serial primary key" f } }
-        { +random-id+ "bigint" }
+        { +assigned-id+ { f f "primary key" } }
-        { TEXT "text" }
+        { +random-id+ { "bigint" "bigint primary key" f } }
-        { VARCHAR "varchar" }
+        { TEXT { "text" f f } }
-        { INTEGER "integer" }
+        { VARCHAR { "varchar" "varchar" f } }
-        { DOUBLE "real" }
+        { INTEGER { "integer" "integer" f } }
-        { DATE "date" }
+        { BIG-INTEGER { "bigint" "bigint" f } }
-        { TIME "time" }
+        { UNSIGNED-BIG-INTEGER { "bigint" "bigint" f } }
-        { DATETIME "timestamp" }
+        { SIGNED-BIG-INTEGER { "bigint" "bigint" f } }
-        { TIMESTAMP "timestamp" }
+        { DOUBLE { "real" "real" f } }
-        { BLOB "bytea" }
+        { DATE { "date" "date" f } }
-        { FACTOR-BLOB "bytea" }
+        { TIME { "time" "time" f } }
-    } ;
+        { DATETIME { "timestamp" "timestamp" f } }
-
+        { TIMESTAMP { "timestamp" "timestamp" f } }
-M: postgresql-db create-type-table ( -- hash )
+        { BLOB { "bytea" "bytea" f } }
-    H{
+        { FACTOR-BLOB { "bytea" "bytea" f } }
-        { +native-id+ "serial primary key" }
+        { +foreign-id+ { f f "references" } }
-        { +random-id+ "bigint primary key" }
+        { +autoincrement+ { f f "autoincrement" } }
-    } ;
+        { +unique+ { f f "unique" } }
-
+        { +default+ { f f "default" } }
-M: postgresql-db modifier-table ( -- hashtable )
+        { +null+ { f f "null" } }
-    H{
+        { +not-null+ { f f "not null" } }
-        { +native-id+ "primary key" }
+        { system-random-generator { f f f } }
-        { +assigned-id+ "primary key" }
+        { secure-random-generator { f f f } }
-        { +random-id+ "primary key" }
+        { random-generator { f f f } }
-        { +foreign-id+ "references" }
-        { +autoincrement+ "autoincrement" }
-        { +unique+ "unique" }
-        { +default+ "default" }
-        { +null+ "null" }
-        { +not-null+ "not null" }
-        { system-random-generator "" }
-        { secure-random-generator "" }
-        { random-generator "" }
     } ;
 
 M: postgresql-db compound ( str obj -- str' )

extra/db/types/types.factor

@@ -7,10 +7,9 @@ mirrors classes.tuple combinators calendar.format symbols
 classes.singleton accessors quotations random ;
 IN: db.types
 
-HOOK: modifier-table db ( -- hash )
+HOOK: persistent-table db ( -- hash )
 HOOK: compound db ( str obj -- hash )
-HOOK: type-table db ( -- hash )
+
-HOOK: create-type-table db ( -- hash )
 HOOK: random-id-quot db ( -- quot )
 
 TUPLE: sql-spec class slot-name column-name type primary-key modifiers ;
@@ -40,26 +39,26 @@ SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
     ] find nip [ system-random-generator ] unless* ;
 
 : primary-key? ( spec -- ? )
-    sql-spec-primary-key +primary-key+? ;
+    primary-key>> +primary-key+? ;
 
 : native-id? ( spec -- ? )
-    sql-spec-primary-key +native-id+? ;
+    primary-key>> +native-id+? ;
 
 : nonnative-id? ( spec -- ? )
-    sql-spec-primary-key +nonnative-id+? ;
+    primary-key>> +nonnative-id+? ;
 
 : normalize-spec ( spec -- )
-    dup sql-spec-type dup +primary-key+? [
+    dup type>> dup +primary-key+? [
-        swap set-sql-spec-primary-key
+        >>primary-key drop
     ] [
-        drop dup sql-spec-modifiers [
+        drop dup modifiers>> [
             +primary-key+?
         ] deep-find
-        [ swap set-sql-spec-primary-key ] [ drop ] if*
+        [ >>primary-key drop ] [ drop ] if*
     ] if ;
 
 : find-primary-key ( specs -- obj )
-    [ sql-spec-primary-key ] find nip ;
+    [ primary-key>> ] find nip ;
 
 : relation? ( spec -- ? ) [ +has-many+ = ] deep-find ;
 
@@ -88,7 +87,7 @@ FACTOR-BLOB NULL ;
     [ relation? not ] subset ;
 
 : remove-id ( specs -- obj )
-    [ sql-spec-primary-key not ] subset ;
+    [ primary-key>> not ] subset ;
 
 ! SQLite Types: http://www.sqlite.org/datatype3.html
 ! NULL INTEGER REAL TEXT BLOB
@@ -100,29 +99,28 @@ ERROR: unknown-modifier ;
 : lookup-modifier ( obj -- str )
     {
         { [ dup array? ] [ unclip lookup-modifier swap compound ] }
-        [ modifier-table at* [ unknown-modifier ] unless ]
+        [ persistent-table at* [ unknown-modifier ] unless third ]
     } cond ;
 
 ERROR: no-sql-type ;
 
-: lookup-type* ( obj -- str )
+: (lookup-type) ( obj -- str )
+    persistent-table at* [ no-sql-type ] unless ;
+
+: lookup-type ( obj -- str )
     dup array? [
-        first lookup-type*
+        unclip (lookup-type) first nip
     ] [
-        type-table at* [ no-sql-type ] unless
+        (lookup-type) first
     ] if ;
 
 : lookup-create-type ( obj -- str )
     dup array? [
-        unclip lookup-create-type swap compound
+        unclip (lookup-type) second swap compound
     ] [
-        dup create-type-table at*
+        (lookup-type) second
-        [ nip ] [ drop lookup-type* ] if
     ] if ;
 
-: lookup-type ( obj create? -- str )
-    [ lookup-create-type ] [ lookup-type* ] if ;
-
 : single-quote ( str -- newstr )
     "'" swap "'" 3append ;
 
@@ -136,8 +134,7 @@ ERROR: no-sql-type ;
     " " swap 3append ;
 
 : modifiers ( spec -- str )
-    sql-spec-modifiers 
+    modifiers>> [ lookup-modifier ] map " " join
-    [ lookup-modifier ] map " " join
     dup empty? [ " " prepend ] unless ;
 
 HOOK: bind% db ( spec -- )
@@ -157,6 +154,6 @@ HOOK: bind# db ( spec obj -- )
 
 : tuple>params ( specs tuple -- obj )
     [
-        >r dup sql-spec-type swap sql-spec-slot-name r>
+        >r [ type>> ] [ slot-name>> ] bi r>
         get-slot-named swap
     ] curry { } map>assoc ;