sequences debugger db db.postgresql.lib db.postgresql.ffi
db.tuples db.types tools.annotations math.ranges
combinators sequences.lib classes locals words tools.walker
-namespaces.lib accessors random ;
+namespaces.lib accessors random db.queries ;
IN: db.postgresql
TUPLE: postgresql-db < db
TUPLE: postgresql-result-set < result-set ;
-: <postgresql-statement> ( statement in out -- postgresql-statement )
- postgresql-statement construct-statement ;
-
M: postgresql-db make-db* ( seq tuple -- db )
>r first4 r>
swap >>db
>>handle drop ;
M: postgresql-db <simple-statement> ( sql in out -- statement )
- <postgresql-statement> ;
+ postgresql-statement construct-statement ;
M: postgresql-db <prepared-statement> ( sql in out -- statement )
- <postgresql-statement> dup prepare-statement ;
-
-M: postgresql-db begin-transaction ( -- )
- "BEGIN" sql-command ;
-
-M: postgresql-db commit-transaction ( -- )
- "COMMIT" sql-command ;
-
-M: postgresql-db rollback-transaction ( -- )
- "ROLLBACK" sql-command ;
+ <simple-statement> dup prepare-statement ;
SYMBOL: postgresql-counter
: bind-name% ( -- )
M: postgresql-db bind# ( spec obj -- )
>r bind-name% f swap type>> r> <literal-bind> 1, ;
-: postgresql-make ( class quot -- )
- >r sql-props r>
- [ postgresql-counter off call ] { "" { } { } } nmake
- <postgresql-statement> ; inline
-
: create-table-sql ( class -- statement )
[
"create table " 0% 0%
dup type>> lookup-create-type 0%
modifiers 0%
] interleave ");" 0%
- ] postgresql-make ;
+ ] query-make ;
: create-function-sql ( class -- statement )
[
swap [ ", " 0% ] [ drop bind-name% ] interleave
"); " 0%
"select currval(''" 0% 0% "_id_seq'');' language sql;" 0%
- ] postgresql-make ;
+ ] query-make ;
M: postgresql-db create-sql-statement ( class -- seq )
[
remove-id
[ ", " 0% ] [ type>> lookup-type 0% ] interleave
");" 0%
- ] postgresql-make ;
+ ] query-make ;
: drop-table-sql ( table -- statement )
[
"drop table " 0% 0% ";" 0% drop
- ] postgresql-make ;
+ ] query-make ;
M: postgresql-db drop-sql-statement ( class -- seq )
[
remove-id
[ ", " 0% ] [ bind% ] interleave
");" 0%
- ] postgresql-make ;
+ ] query-make ;
M: postgresql-db <insert-nonnative-statement> ( class -- statement )
[
" values(" 0%
[ ", " 0% ] [ bind% ] interleave
");" 0%
- ] postgresql-make ;
+ ] query-make ;
M: postgresql-db insert-tuple* ( tuple statement -- )
query-modify-tuple ;
" where " 0%
find-primary-key
dup column-name>> 0% " = " 0% bind%
- ] postgresql-make ;
+ ] query-make ;
M: postgresql-db <delete-tuple-statement> ( class -- statement )
[
" where " 0%
find-primary-key
dup column-name>> 0% " = " 0% bind%
- ] postgresql-make ;
+ ] query-make ;
M: postgresql-db <select-by-slots-statement> ( tuple class -- statement )
[
[ " and " 0% ]
[ dup column-name>> 0% " = " 0% bind% ] interleave
] if ";" 0%
- ] postgresql-make ;
+ ] query-make ;
M: postgresql-db persistent-table ( -- hashtable )
H{
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel namespaces sequences namespaces.lib db
+db.tuples db.types ;
+IN: db.queries
+
+: maybe-make-retryable ( statement -- statement )
+ dup in-params>> [ generator-bind? ] contains? [
+ make-retryable
+ ] when ;
+
+: query-make ( class quot -- )
+ >r sql-props r>
+ [ 0 sql-counter rot with-variable ] { "" { } { } } nmake
+ <simple-statement> maybe-make-retryable ;
+
+M: db begin-transaction ( -- ) "BEGIN" sql-command ;
+M: db commit-transaction ( -- ) "COMMIT" sql-command ;
+M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
continuations db.sqlite.lib db.sqlite.ffi db.tuples
words combinators.lib db.types combinators math.intervals
io namespaces.lib accessors vectors math.ranges random
-math.bitfields.lib ;
+math.bitfields.lib db.queries ;
USE: tools.walker
IN: db.sqlite
dup handle>> sqlite-result-set construct-result-set
dup advance-row ;
-M: sqlite-db begin-transaction ( -- ) "BEGIN" sql-command ;
-M: sqlite-db commit-transaction ( -- ) "COMMIT" sql-command ;
-M: sqlite-db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
-
-: maybe-make-retryable ( statement -- statement )
- dup in-params>> [ generator-bind? ] contains? [
- make-retryable
- ] when ;
-
-: sqlite-make ( class quot -- )
- >r sql-props r>
- [ 0 sql-counter rot with-variable ] { "" { } { } } nmake
- <simple-statement> maybe-make-retryable ;
-
M: sqlite-db create-sql-statement ( class -- statement )
[
"create table " 0% 0%
dup type>> lookup-create-type 0%
modifiers 0%
] interleave ");" 0%
- ] sqlite-make dup sql>> . ;
+ ] query-make dup sql>> . ;
M: sqlite-db drop-sql-statement ( class -- statement )
- [ "drop table " 0% 0% ";" 0% drop ] sqlite-make ;
+ [ "drop table " 0% 0% ";" 0% drop ] query-make ;
M: sqlite-db <insert-native-statement> ( tuple -- statement )
[
] if
] interleave
");" 0%
- ] sqlite-make ;
+ ] query-make ;
M: sqlite-db <insert-nonnative-statement> ( tuple -- statement )
<insert-native-statement> ;
dup remove-id
[ ", " 0% ] [ dup column-name>> 0% " = " 0% bind% ] interleave
where-primary-key%
- ] sqlite-make ;
+ ] query-make ;
M: sqlite-db <delete-tuple-statement> ( specs table -- sql )
[
" where " 0%
find-primary-key
dup column-name>> 0% " = " 0% bind%
- ] sqlite-make ;
+ ] query-make ;
M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
[
dupd
[ slot-name>> swap get-slot-named ] with subset
dup empty? [ 2drop ] [ where-clause ] if ";" 0%
- ] sqlite-make ;
+ ] query-make ;
M: sqlite-db random-id-quot ( -- quot )
[ 64 [ 2^ random ] keep 1 - set-bit ] ;