add queries.db to refactor some code

extra/db/postgresql/postgresql.factor

@@ -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 ;
+    <simple-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 ;
 
 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{

extra/db/queries/queries.factor

@@ -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 ;

extra/db/sqlite/sqlite.factor

@@ -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 ] ;