add queries.db to refactor some code
Doug Coleman
parent
be8ac1d7b6
commit
5dc015f0f5
|
|
@ -5,7 +5,7 @@ kernel math math.parser namespaces prettyprint quotations
|
|||
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
|
||||
|
|
@ -15,9 +15,6 @@ TUPLE: postgresql-statement < statement ;
|
|||
|
||||
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
|
||||
|
|
@ -99,19 +96,10 @@ M: postgresql-statement prepare-statement ( statement -- )
|
|||
>>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% ( -- )
|
||||
|
|
@ -124,11 +112,6 @@ M: postgresql-db bind% ( spec -- )
|
|||
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%
|
||||
|
|
@ -138,7 +121,7 @@ M: postgresql-db bind# ( spec obj -- )
|
|||
dup type>> lookup-create-type 0%
|
||||
modifiers 0%
|
||||
] interleave ");" 0%
|
||||
] postgresql-make ;
|
||||
] query-make ;
|
||||
|
||||
: create-function-sql ( class -- statement )
|
||||
[
|
||||
|
|
@ -160,7 +143,7 @@ M: postgresql-db bind# ( spec obj -- )
|
|||
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 )
|
||||
[
|
||||
|
|
@ -176,12 +159,12 @@ 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 )
|
||||
[
|
||||
|
|
@ -198,7 +181,7 @@ M: postgresql-db <insert-native-statement> ( class -- statement )
|
|||
remove-id
|
||||
[ ", " 0% ] [ bind% ] interleave
|
||||
");" 0%
|
||||
] postgresql-make ;
|
||||
] query-make ;
|
||||
|
||||
M: postgresql-db <insert-nonnative-statement> ( class -- statement )
|
||||
[
|
||||
|
|
@ -210,7 +193,7 @@ 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 ;
|
||||
|
|
@ -225,7 +208,7 @@ M: postgresql-db <update-tuple-statement> ( class -- statement )
|
|||
" where " 0%
|
||||
find-primary-key
|
||||
dup column-name>> 0% " = " 0% bind%
|
||||
] postgresql-make ;
|
||||
] query-make ;
|
||||
|
||||
M: postgresql-db <delete-tuple-statement> ( class -- statement )
|
||||
[
|
||||
|
|
@ -233,7 +216,7 @@ 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 )
|
||||
[
|
||||
|
|
@ -250,7 +233,7 @@ 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{
|
||||
|
|
|
|||
|
|
@ -0,0 +1,19 @@
|
|||
! 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 ;
|
||||
|
|
@ -6,7 +6,7 @@ prettyprint sequences strings classes.tuple alien.c-types
|
|||
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
|
||||
|
||||
|
|
@ -106,20 +106,6 @@ M: sqlite-statement query-results ( query -- result-set )
|
|||
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%
|
||||
|
|
@ -129,10 +115,10 @@ M: sqlite-db create-sql-statement ( class -- statement )
|
|||
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 )
|
||||
[
|
||||
|
|
@ -156,7 +142,7 @@ 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> ;
|
||||
|
|
@ -222,7 +208,7 @@ M: sqlite-db <update-tuple-statement> ( class -- 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 )
|
||||
[
|
||||
|
|
@ -230,7 +216,7 @@ 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 )
|
||||
[
|
||||
|
|
@ -242,7 +228,7 @@ 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 ] ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue