some work on foreign keys
parent
dc9f374570
commit
68b6515ac2
|
@ -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 } }
|
||||
|
|
|
@ -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" } }
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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? [
|
||||
|
|
Loading…
Reference in New Issue