! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays byte-arrays classes combinators
-continuations db db.errors db.private db.tuples
+USING: accessors arrays byte-arrays classes classes.tuple
+combinators continuations db db.errors db.tuples
db.tuples.private db.types destructors kernel make math
-math.bitwise math.intervals math.parser namespaces nmake
-prettyprint random sequences shuffle strings words fry ;
+math.bitwise math.intervals math.parser namespaces nmake random
+sequences strings ;
IN: db.queries
GENERIC: where ( specs obj -- )
[ make-retryable ] when ;
: regenerate-params ( statement -- statement )
- dup
+ dup
[ bind-params>> ] [ in-params>> ] bi
[
dup generator-bind? [
drop
] if
] 2map >>bind-params ;
-
-M: retryable execute-statement* ( statement type -- )
- drop [ retries>> iota ] [
+
+M: retryable execute-statement*
+ drop [ retries>> <iota> ] [
[
nip
[ query-results dispose t ]
- [ ]
+ [ ]
[ regenerate-params bind-statement* f ] cleanup
] curry
] bi attempt-all drop ;
: sql-props ( class -- columns table )
[ db-columns ] [ db-table-name ] bi ;
-: query-make ( class quot -- statements )
- #! query, input, outputs, secondary queries
- over db-table-name "table-name" set
+: query-make ( ..a class quot: ( ..a columns table -- ..b ) -- ..b statements )
+ ! query, input, outputs, secondary queries
[ sql-props ] dip
- [ 0 sql-counter rot with-variable ] curry
+ '[ 0 sql-counter [ dup "table-name" set @ ] with-variable ]
{ "" { } { } { } } nmake
[ <simple-statement> maybe-make-retryable ] dip
[ [ 1array ] dip append ] unless-empty ; inline
dup column-name>> 0% " = " 0% bind%
] interleave ;
-M: db-connection <update-tuple-statement> ( class -- statement )
+M: db-connection <update-tuple-statement>
[
"update " 0% 0%
" set " 0%
where-primary-key%
] query-make ;
-M: random-id-generator eval-generator ( singleton -- obj )
+M: random-id-generator eval-generator
drop
system-random-generator get [
63 [ random-bits ] keep 1 - set-bit
: in-parens ( quot -- )
"(" 0% call ")" 0% ; inline
-M: interval where ( spec obj -- )
+M: interval where
[
[ from>> "from" where-interval ] [
nip infinite-interval? [ " and " 0% ] unless
] [ to>> "to" where-interval ] 2tri
] in-parens ;
-M: sequence where ( spec obj -- )
+M: sequence where
[
[ " or " 0% ] [ dupd where ] interleave drop
] in-parens ;
-M: byte-array where ( spec obj -- )
+M: byte-array where
over column-name>> 0% " = " 0% bind# ;
-M: NULL where ( spec obj -- )
+M: NULL where
drop column-name>> 0% " is NULL" 0% ;
: object-where ( spec obj -- )
over column-name>> 0% " = " 0% bind# ;
-M: object where ( spec obj -- ) object-where ;
+M: object where object-where ;
-M: integer where ( spec obj -- ) object-where ;
+M: integer where object-where ;
-M: string where ( spec obj -- ) object-where ;
+M: string where object-where ;
: filter-slots ( tuple specs -- specs' )
[
: where-clause ( tuple specs -- )
dupd filter-slots [ drop ] [ many-where ] if-empty ;
-M: db-connection <delete-tuples-statement> ( tuple table -- sql )
+M: db-connection <delete-tuples-statement>
[
"delete from " 0% 0%
where-clause
ERROR: all-slots-ignored class ;
-M: db-connection <select-by-slots-statement> ( tuple class -- statement )
+M: db-connection <select-by-slots-statement>
[
"select " 0%
[ dupd filter-ignores ] dip
[ offset>> [ do-offset ] [ drop ] if* ]
} 2cleave ;
-M: db-connection query>statement ( query -- tuple )
- [ tuple>> dup class ] keep
+M: db-connection query>statement
+ [ tuple>> dup class-of ] keep
[ <select-by-slots-statement> ] dip make-query* ;
! select ID, NAME, SCORE from EXAM limit 1 offset 3
-M: db-connection <count-statement> ( query -- statement )
- [ tuple>> dup class ] keep
+M: db-connection <count-statement>
+ [ tuple>> dup class-of ] keep
[ [ "select count(*) from " 0% 0% where-clause ] query-make ]
dip make-query* ;
"," join % ")" %
] "" make sql-command ;
+: ensure-index ( index-name table-name columns -- )
+ '[ _ _ _ create-index ] ignore-index-exists ;
+
: drop-index ( index-name -- )
[ "drop index " % % ] "" make sql-command ;