factor: trim using lists

[factor.git] / basis / db / queries / queries.factor

diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor
index 3ff93f49c67f42f461159c6446fa7b6c91f36453..d166340de0cabe5a2eab8d042699a71c6e4b3ff1 100644 (file)
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math namespaces make sequences random
-strings math.parser math.intervals combinators math.bitwise
-nmake db db.tuples db.types classes words shuffle arrays
-destructors continuations db.tuples.private prettyprint
-db.private byte-arrays ;
+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 random
+sequences strings ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )
@@ -23,7 +23,7 @@ SINGLETON: retryable
     [ make-retryable ] when ;
 
 : regenerate-params ( statement -- statement )
-    dup 
+    dup
     [ bind-params>> ] [ in-params>> ] bi
     [
         dup generator-bind? [
@@ -32,13 +32,13 @@ SINGLETON: retryable
             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 ;
@@ -46,11 +46,10 @@ M: retryable execute-statement* ( statement type -- )
 : 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
@@ -63,7 +62,7 @@ M: retryable execute-statement* ( statement type -- )
         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%
@@ -72,7 +71,7 @@ M: db-connection <update-tuple-statement> ( class -- statement )
         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
@@ -103,32 +102,32 @@ M: random-id-generator eval-generator ( singleton -- obj )
 : 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' )
     [
@@ -146,7 +145,7 @@ M: string where ( spec obj -- ) object-where ;
 : 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
@@ -154,7 +153,7 @@ M: db-connection <delete-tuples-statement> ( tuple table -- sql )
 
 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
@@ -189,14 +188,14 @@ M: db-connection <select-by-slots-statement> ( tuple class -- statement )
         [ 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* ;
 
@@ -206,5 +205,14 @@ M: db-connection <count-statement> ( query -- statement )
         "," 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 ;
+
+: create-database ( string -- )
+    "create database " ";" surround sql-command ;
+
+: ensure-database ( string -- )
+    '[ _ create-database ] ignore-database-exists ;