sequences debugger db db.postgresql.lib db.postgresql.ffi
db.tuples db.types tools.annotations math.ranges
combinators classes locals words tools.walker
-nmake accessors random db.queries destructors ;
+nmake accessors random db.queries destructors db.tuples.private ;
USE: tools.walker
IN: db.postgresql
TUPLE: postgresql-db < db
- host port pgopts pgtty db user pass ;
+ host port pgopts pgtty database username password ;
+
+: <postgresql-db> ( -- postgresql-db )
+ postgresql-db new-db ;
TUPLE: postgresql-statement < statement ;
TUPLE: postgresql-result-set < result-set ;
-M: postgresql-db make-db* ( seq db -- db )
- >r first4 r>
- swap >>db
- swap >>pass
- swap >>user
- swap >>host ;
-
M: postgresql-db db-open ( db -- db )
dup {
[ host>> ]
[ port>> ]
[ pgopts>> ]
[ pgtty>> ]
- [ db>> ]
- [ user>> ]
- [ pass>> ]
+ [ database>> ]
+ [ username>> ]
+ [ password>> ]
} cleave connect-postgres >>handle ;
M: postgresql-db dispose ( db -- )
handle>> PQfinish ;
-M: postgresql-statement bind-statement* ( statement -- )
- drop ;
+M: postgresql-statement bind-statement* ( statement -- ) drop ;
GENERIC: postgresql-bind-conversion ( tuple object -- low-level-binding )
[ handle>> ] [ n>> ] bi ;
M: postgresql-result-set row-column ( result-set column -- object )
- >r result-handle-n r> pq-get-string ;
+ [ result-handle-n ] dip pq-get-string ;
M: postgresql-result-set row-column-typed ( result-set column -- object )
dup pick out-params>> nth type>>
- >r >r result-handle-n r> r> postgresql-column-typed ;
+ [ result-handle-n ] 2dip postgresql-column-typed ;
M: postgresql-statement query-results ( query -- result-set )
dup bind-params>> [
M: postgresql-statement prepare-statement ( statement -- )
dup
- >r db get handle>> f r>
+ [ db get handle>> f ] dip
[ sql>> ] [ in-params>> ] bi
length f PQprepare postgresql-error
>>handle drop ;
bind-name% 1, ;
M: postgresql-db bind# ( spec object -- )
- >r bind-name% f swap type>> r> <literal-bind> 1, ;
+ [ bind-name% f swap type>> ] dip
+ <literal-bind> 1, ;
: create-table-sql ( class -- statement )
[
+ dupd
"create table " 0% 0%
"(" 0% [ ", " 0% ] [
dup column-name>> 0%
" " 0%
dup type>> lookup-create-type 0%
modifiers 0%
- ] interleave ");" 0%
+ ] interleave
+
+ ", " 0%
+ find-primary-key
+ "primary key(" 0%
+ [ "," 0% ] [ column-name>> 0% ] interleave
+ "));" 0%
] query-make ;
: create-function-sql ( class -- statement )
[
- >r remove-id r>
+ [ remove-id ] dip
"create function add_" 0% dup 0%
"(" 0%
over [ "," 0% ]
M: postgresql-db create-sql-statement ( class -- seq )
[
[ create-table-sql , ] keep
- dup db-columns find-primary-key db-assigned-id-spec?
- [ create-function-sql , ] [ drop ] if
+ dup db-assigned? [ create-function-sql , ] [ drop ] if
] { } make ;
: drop-function-sql ( class -- statement )
M: postgresql-db drop-sql-statement ( class -- seq )
[
[ drop-table-sql , ] keep
- dup db-columns find-primary-key db-assigned-id-spec?
- [ drop-function-sql , ] [ drop ] if
+ dup db-assigned? [ drop-function-sql , ] [ drop ] if
] { } make ;
M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
[
"select add_" 0% 0%
"(" 0%
- dup find-primary-key 2,
+ dup find-primary-key first 2,
remove-id
[ ", " 0% ] [ bind% ] interleave
");" 0%
");" 0%
] query-make ;
-M: postgresql-db insert-tuple* ( tuple statement -- )
+M: postgresql-db insert-tuple-set-key ( tuple statement -- )
query-modify-tuple ;
M: postgresql-db persistent-table ( -- hashtable )
H{
- { +db-assigned-id+ { "integer" "serial primary key" f } }
- { +user-assigned-id+ { f f "primary key" } }
- { +random-id+ { "bigint" "bigint primary key" f } }
+ { +db-assigned-id+ { "integer" "serial" f } }
+ { +user-assigned-id+ { f f f } }
+ { +random-id+ { "bigint" "bigint" f } }
+
+ { +foreign-id+ { f f "references" } }
+
+ { +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 } }
{ BLOB { "bytea" "bytea" f } }
{ FACTOR-BLOB { "bytea" "bytea" f } }
{ URL { "varchar" "varchar" f } }
- { +foreign-id+ { f f "references" } }
{ +autoincrement+ { f f "autoincrement" } }
{ +unique+ { f f "unique" } }
{ +default+ { f f "default" } }
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
- ] }
+ { "references" [ >reference-string ] }
[ drop no-compound-found ]
} case ;