]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/db/db.factor
factor: trim using lists
[factor.git] / basis / db / db.factor
index 96b72b8865a224f563345dbbbe218c4e1bd4f5ae..6f9c4483824783d47d219b64e53e7b8e20b382b7 100644 (file)
@@ -1,8 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs classes continuations destructors kernel math
-namespaces sequences classes.tuple words strings
-tools.walker accessors combinators fry db.errors ;
+USING: accessors assocs continuations destructors kernel
+namespaces sequences strings ;
 IN: db
 
 TUPLE: db-connection
@@ -27,7 +26,7 @@ HOOK: parse-db-error db-connection ( error -- error' )
 
 : dispose-statements ( assoc -- ) values dispose-each ;
 
-M: db-connection dispose ( db-connection -- ) 
+M: db-connection dispose
     dup db-connection [
         [ dispose-statements H{ } clone ] change-insert-statements
         [ dispose-statements H{ } clone ] change-update-statements
@@ -41,8 +40,8 @@ TUPLE: result-set sql in-params out-params handle n max ;
 GENERIC: query-results ( query -- result-set )
 GENERIC: #rows ( result-set -- n )
 GENERIC: #columns ( result-set -- n )
-GENERIC# row-column 1 ( result-set column -- obj )
-GENERIC# row-column-typed 1 ( result-set column -- sql )
+GENERIC#: row-column 1 ( result-set column -- obj )
+GENERIC#: row-column-typed 1 ( result-set column -- sql )
 GENERIC: advance-row ( result-set -- )
 GENERIC: more-rows? ( result-set -- ? )
 
@@ -77,7 +76,7 @@ GENERIC: bind-tuple ( tuple statement -- )
 
 GENERIC: execute-statement* ( statement type -- )
 
-M: object execute-statement* ( statement type -- )
+M: object execute-statement*
     '[
         _ _ drop query-results dispose
     ] [
@@ -100,20 +99,20 @@ M: object execute-statement* ( statement type -- )
     t >>bound? drop ;
 
 : sql-row ( result-set -- seq )
-    dup #columns [ row-column ] with map ;
+    dup #columns [ row-column ] with { } map-integers ;
 
 : sql-row-typed ( result-set -- seq )
-    dup #columns [ row-column-typed ] with map ;
+    dup #columns [ row-column-typed ] with { } map-integers ;
 
-: query-each ( statement quot: ( statement -- ) -- )
+: query-each ( result-set quot: ( row -- ) -- )
     over more-rows? [
         [ call ] 2keep over advance-row query-each
     ] [
         2drop
     ] if ; inline recursive
 
-: query-map ( statement quot -- seq )
-    accumulator [ query-each ] dip { } like ; inline
+: query-map ( result-set quot: ( row -- row' ) -- seq )
+    collector [ query-each ] dip { } like ; inline
 
 : with-db ( db quot -- )
     [ db-open db-connection ] dip
@@ -139,14 +138,18 @@ HOOK: begin-transaction db-connection ( -- )
 HOOK: commit-transaction db-connection ( -- )
 HOOK: rollback-transaction db-connection ( -- )
 
-M: db-connection begin-transaction ( -- ) "BEGIN" sql-command ;
-M: db-connection commit-transaction ( -- ) "COMMIT" sql-command ;
-M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ;
+M: db-connection begin-transaction "BEGIN" sql-command ;
+M: db-connection commit-transaction "COMMIT" sql-command ;
+M: db-connection rollback-transaction "ROLLBACK" sql-command ;
 
 : in-transaction? ( -- ? ) in-transaction get ;
 
 : with-transaction ( quot -- )
-    t in-transaction [
-        begin-transaction
-        [ ] [ rollback-transaction ] cleanup commit-transaction
-    ] with-variable ;
+    in-transaction? [
+        call
+    ] [
+        t in-transaction [
+            begin-transaction
+            [ ] [ rollback-transaction ] cleanup commit-transaction
+        ] with-variable
+    ] if ; inline