some work on foreign keys

db4
Doug Coleman 2008-09-27 15:56:43 -05:00
parent dc9f374570
commit 68b6515ac2
4 changed files with 61 additions and 21 deletions

View File

@ -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 } }

View File

@ -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" } }

View File

@ -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 ;

View File

@ -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? [