factor: trim using lists

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

diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor
index 12f783711b3910404a9074f9924e2d3c236cf320..e620f34286f8ebd2ff65dbf6d012e2a888aca0e2 100644 (file)
--- a/basis/db/tuples/tuples.factor
+++ b/basis/db/tuples/tuples.factor
@@ -1,11 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! Copyright (C) 2018 Alexander Ilin.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs classes db kernel namespaces
-classes.tuple words sequences slots math accessors
-math.parser io prettyprint continuations
-destructors mirrors sets db.types db.private fry
-combinators.short-circuit db.errors ;
+USING: accessors assocs classes classes.tuple
+combinators.short-circuit continuations db db.errors db.types
+destructors kernel math.parser namespaces sequences sets words ;
 IN: db.tuples
 
 HOOK: create-sql-statement db-connection ( class -- object )
@@ -48,7 +46,7 @@ GENERIC: eval-generator ( singleton -- object )
 
 : with-disposals ( object quotation -- )
     over sequence? [
-        over '[ _ dispose-each ] [ ] cleanup
+        over '[ _ dispose-each ] finally
     ] [
         with-disposal
     ] if ; inline
@@ -122,17 +120,10 @@ ERROR: no-defined-persistent object ;
     drop-sql-statement [ execute-statement ] with-disposals ;
 
 : recreate-table ( class -- )
-    ensure-defined-persistent
-    [
-        '[
-            [
-                _ drop-sql-statement [ execute-statement ] with-disposals
-            ] ignore-table-missing
-        ] ignore-function-missing
-    ] [ create-table ] bi ;
+    [ '[ [ _ drop-table ] ignore-table-missing ] ignore-function-missing ]
+    [ create-table ] bi ;
 
 : ensure-table ( class -- )
-    ensure-defined-persistent
     '[ [ _ create-table ] ignore-table-exists ] ignore-function-exists ;
 
 : ensure-tables ( classes -- ) [ ensure-table ] each ;
@@ -170,3 +161,6 @@ ERROR: no-defined-persistent object ;
 
 : update-tuples ( query/tuple quot: ( tuple -- tuple'/f ) -- )
     '[ @ [ update-tuple ] when* ] each-tuple ; inline
+
+: reject-tuples ( query/tuple quot: ( tuple -- ? ) -- )
+    '[ dup @ [ delete-tuples ] [ drop ] if ] each-tuple ; inline