use reject instead of [ ... not ] filter.

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

diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor
index 6a889689ce0c91416706d77a169cbd2fd73cb29a..aedbaf9f724204148df20bed92cef7034ebcd329 100644 (file)
--- a/basis/db/types/types.factor
+++ b/basis/db/types/types.factor
@@ -3,12 +3,12 @@
 USING: arrays assocs db kernel math math.parser
 sequences continuations sequences.deep prettyprint
 words namespaces slots slots.private classes mirrors
-classes.tuple combinators calendar.format symbols
-classes.singleton accessors quotations random ;
+classes.tuple combinators calendar.format classes.singleton
+accessors quotations random db.private ;
 IN: db.types
 
-HOOK: persistent-table db ( -- hash )
-HOOK: compound db ( string obj -- hash )
+HOOK: persistent-table db-connection ( -- hash )
+HOOK: compound db-connection ( string obj -- hash )
 
 TUPLE: sql-spec class slot-name column-name type primary-key modifiers ;
 
@@ -33,23 +33,11 @@ SYMBOL: IGNORE
 
 : filter-ignores ( tuple specs -- specs' )
     [ <mirror> [ nip IGNORE = ] assoc-filter keys ] dip
-    [ slot-name>> swap member? not ] with filter ;
-
-ERROR: no-slot ;
-
-: offset-of-slot ( string tuple -- n )
-    class superclasses [ "slots" word-prop ] map concat
-    slot-named dup [ no-slot ] unless offset>> ;
-
-: get-slot-named ( name tuple -- value )
-    tuck offset-of-slot slot ;
-
-: set-slot-named ( value name obj -- )
-    tuck offset-of-slot set-slot ;
+    [ slot-name>> swap member? ] with reject ;
 
 ERROR: not-persistent class ;
 
-: db-table ( class -- object )
+: db-table-name ( class -- object )
     dup "db-table" word-prop [ ] [ not-persistent ] ?if ;
 
 : db-columns ( class -- object )
@@ -63,7 +51,7 @@ ERROR: not-persistent class ;
 
 : set-primary-key ( value tuple -- )
     [
-        class db-columns
+        class-of db-columns
         find-primary-key first slot-name>>
     ] keep set-slot-named ;
 
@@ -71,10 +59,10 @@ ERROR: not-persistent class ;
     primary-key>> +primary-key+? ;
 
 : db-assigned-id-spec? ( specs -- ? )
-    [ primary-key>> +db-assigned-id+? ] contains? ;
+    [ primary-key>> +db-assigned-id+? ] any? ;
 
 : user-assigned-id-spec? ( specs -- ? )
-    [ primary-key>> +user-assigned-id+? ] contains? ;
+    [ primary-key>> +user-assigned-id+? ] any? ;
 
 : normalize-spec ( spec -- )
     dup type>> dup +primary-key+? [
@@ -105,28 +93,25 @@ FACTOR-BLOB NULL URL ;
         dup normalize-spec ;
 
 : spec>tuple ( class spec -- tuple )
-    3 f pad-right [ first3 ] keep 3 tail <sql-spec> ;
+    3 f pad-tail [ first3 ] keep 3 tail <sql-spec> ;
 
 : number>string* ( n/string -- string )
     dup number? [ number>string ] when ;
 
 : remove-db-assigned-id ( specs -- obj )
-    [ +db-assigned-id+? not ] filter ;
+    [ +db-assigned-id+? ] reject ;
 
 : remove-relations ( specs -- newcolumns )
-    [ relation? not ] filter ;
+    [ relation? ] reject ;
 
 : remove-id ( specs -- obj )
-    [ primary-key>> not ] filter ;
+    [ primary-key>> ] reject ;
 
 ! SQLite Types: http://www.sqlite.org/datatype3.html
 ! NULL INTEGER REAL TEXT BLOB
 ! PostgreSQL Types:
 ! http://developer.postgresql.org/pgdocs/postgres/datatype.html
 
-: ?at ( obj assoc -- value/obj ? )
-    dupd at* [ [ nip ] [ drop ] if ] keep ;
-
 ERROR: unknown-modifier modifier ;
 
 : lookup-modifier ( obj -- string )
@@ -158,20 +143,14 @@ ERROR: no-sql-type type ;
     modifiers>> [ lookup-modifier ] map " " join
     [ "" ] [ " " prepend ] if-empty ;
 
-: join-space ( string1 string2 -- new-string )
-    " " swap 3append ;
-
-: paren ( string -- new-string )
-    "(" swap ")" 3append ;
-
-HOOK: bind% db ( spec -- )
-HOOK: bind# db ( spec obj -- )
+HOOK: bind% db-connection ( spec -- )
+HOOK: bind# db-connection ( spec obj -- )
 
 ERROR: no-column column ;
 
 : >reference-string ( string pair -- string )
     first2
-    [ [ unparse join-space ] [ db-columns ] bi ] dip
+    [ [ db-table-name " " glue ] [ db-columns ] bi ] dip
     swap [ column-name>> = ] with find nip
     [ no-column ] unless*
-    column-name>> paren append ;
+    column-name>> "(" ")" surround append ;