about to consolidate sql types/create types/modifiers

db4
Doug Coleman 2008-04-20 00:52:05 -05:00
parent 7293a4f4f8
commit 89a728f645
3 changed files with 22 additions and 31 deletions

View File

@ -93,7 +93,7 @@ M: postgresql-result-set dispose ( result-set -- )
M: postgresql-statement prepare-statement ( statement -- ) M: postgresql-statement prepare-statement ( statement -- )
dup dup
>r db get handle>> "" r> >r db get handle>> f r>
[ sql>> ] [ in-params>> ] bi [ sql>> ] [ in-params>> ] bi
length f PQprepare postgresql-error length f PQprepare postgresql-error
>>handle drop ; >>handle drop ;
@ -274,21 +274,6 @@ M: postgresql-db create-type-table ( -- hash )
{ +random-id+ "bigint primary key" } { +random-id+ "bigint primary key" }
} ; } ;
: postgresql-compound ( str n -- newstr )
over {
{ "default" [ first number>string join-space ] }
{ "varchar" [ first number>string paren append ] }
{ "references" [
first2 >r [ unparse join-space ] keep db-columns r>
swap [ slot-name>> = ] with find nip
column-name>> paren append
] }
[ "no compound found" 3array throw ]
} case ;
M: postgresql-db compound-modifier ( str seq -- newstr )
postgresql-compound ;
M: postgresql-db modifier-table ( -- hashtable ) M: postgresql-db modifier-table ( -- hashtable )
H{ H{
{ +native-id+ "primary key" } { +native-id+ "primary key" }
@ -305,5 +290,14 @@ M: postgresql-db modifier-table ( -- hashtable )
{ random-generator "" } { random-generator "" }
} ; } ;
M: postgresql-db compound-type ( str n -- newstr ) M: postgresql-db compound ( str obj -- str' )
postgresql-compound ; over {
{ "default" [ first number>string join-space ] }
{ "varchar" [ first number>string paren append ] }
{ "references" [
first2 >r [ unparse join-space ] keep db-columns r>
swap [ slot-name>> = ] with find nip
column-name>> paren append
] }
[ "no compound found" 3array throw ]
} case ;

View File

@ -110,7 +110,6 @@ M: sqlite-db begin-transaction ( -- ) "BEGIN" sql-command ;
M: sqlite-db commit-transaction ( -- ) "COMMIT" sql-command ; M: sqlite-db commit-transaction ( -- ) "COMMIT" sql-command ;
M: sqlite-db rollback-transaction ( -- ) "ROLLBACK" sql-command ; M: sqlite-db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
: maybe-make-retryable ( statement -- statement ) : maybe-make-retryable ( statement -- statement )
dup in-params>> [ generator-bind? ] contains? [ dup in-params>> [ generator-bind? ] contains? [
make-retryable make-retryable
@ -263,14 +262,6 @@ M: sqlite-db modifier-table ( -- hashtable )
{ random-generator "" } { random-generator "" }
} ; } ;
M: sqlite-db compound-modifier ( str obj -- str' ) compound-type ;
M: sqlite-db compound-type ( str seq -- str' )
over {
{ "default" [ first number>string join-space ] }
[ 2drop ]
} case ;
M: sqlite-db type-table ( -- assoc ) M: sqlite-db type-table ( -- assoc )
H{ H{
{ +native-id+ "integer primary key" } { +native-id+ "integer primary key" }
@ -291,3 +282,10 @@ M: sqlite-db type-table ( -- assoc )
} ; } ;
M: sqlite-db create-type-table ( symbol -- str ) type-table ; M: sqlite-db create-type-table ( symbol -- str ) type-table ;
M: sqlite-db compound ( str seq -- str' )
over {
{ "default" [ first number>string join-space ] }
[ 2drop ]
} case ;

View File

@ -8,10 +8,9 @@ classes.singleton accessors quotations random ;
IN: db.types IN: db.types
HOOK: modifier-table db ( -- hash ) HOOK: modifier-table db ( -- hash )
HOOK: compound-modifier db ( str seq -- hash ) HOOK: compound db ( str obj -- hash )
HOOK: type-table db ( -- hash ) HOOK: type-table db ( -- hash )
HOOK: create-type-table db ( -- hash ) HOOK: create-type-table db ( -- hash )
HOOK: compound-type db ( str n -- hash )
HOOK: random-id-quot db ( -- quot ) HOOK: random-id-quot db ( -- quot )
TUPLE: sql-spec class slot-name column-name type primary-key modifiers ; TUPLE: sql-spec class slot-name column-name type primary-key modifiers ;
@ -100,7 +99,7 @@ ERROR: unknown-modifier ;
: lookup-modifier ( obj -- str ) : lookup-modifier ( obj -- str )
{ {
{ [ dup array? ] [ unclip lookup-modifier swap compound-modifier ] } { [ dup array? ] [ unclip lookup-modifier swap compound ] }
[ modifier-table at* [ unknown-modifier ] unless ] [ modifier-table at* [ unknown-modifier ] unless ]
} cond ; } cond ;
@ -115,7 +114,7 @@ ERROR: no-sql-type ;
: lookup-create-type ( obj -- str ) : lookup-create-type ( obj -- str )
dup array? [ dup array? [
unclip lookup-create-type swap compound-type unclip lookup-create-type swap compound
] [ ] [
dup create-type-table at* dup create-type-table at*
[ nip ] [ drop lookup-type* ] if [ nip ] [ drop lookup-type* ] if