made most "front" methods generic

switched back to assoc generic type

bson/writer/writer.factor

@@ -3,7 +3,7 @@
 USING: accessors assocs bson.constants byte-arrays fry io io.binary
 io.encodings.binary io.encodings.string io.encodings.utf8
 io.streams.byte-array kernel math math.parser quotations sequences
-serialize strings words hashtables ;
+serialize strings words ;
 
 IN: bson.writer
 
@@ -23,7 +23,7 @@ M: tuple bson-type? ( tuple -- type ) drop T_Object ;
 M: sequence bson-type? ( seq -- type ) drop T_Array ;
 M: string bson-type? ( string -- type ) drop T_String ; 
 M: integer bson-type? ( integer -- type ) drop T_Integer ; 
-M: hashtable bson-type? ( hashtable -- type ) drop T_Object ; 
+M: assoc bson-type? ( assoc -- type ) drop T_Object ;
 
 M: oid bson-type? ( word -- type ) drop T_OID ;
 M: objid bson-type? ( objid -- type ) drop T_Binary ;
@@ -94,14 +94,14 @@ M: sequence bson-write ( array -- )
         write
         write-eoo ; 
 
-: write-oid ( hashtable -- )
+: write-oid ( assoc -- )
     [ MDB_OID_FIELD ] dip at*
     [ [ MDB_OID_FIELD ] dip write-pair ] [ drop ] if ; inline
 
 : skip-field? ( name -- boolean )
     { MDB_OID_FIELD MDB_INTERNAL_FIELD } member? ; inline
 
-M: hashtable bson-write ( hashtable -- )
+M: assoc bson-write ( assoc -- )
     '[ _ [ write-oid ] [ [ over skip-field? [ 2drop ] [ write-pair ] if ] assoc-each ] bi ]
     binary swap with-byte-writer
     [ length 5 + bson-write ] keep

mongodb/driver/driver.factor

@@ -134,10 +134,21 @@ PRIVATE>
     '[ dup master?>> _ set-at ] each
     H{ } clone mdb-db boa ;
 
-: create-collection ( name -- )
+GENERIC: create-collection ( name -- )
+M: string create-collection
+    <mdb-collection> create-collection ;
+
+M: mdb-collection create-collection ( mdb-collection -- )
     [ cmd-collection ] dip
-    "create" H{ } clone [ set-at ] keep 
-     <mdb-query-msg> 1 >>return# send-query-plain objects>> first check-ok
+    <linked-hash> [
+        [ [ name>> "create" ] dip set-at ]
+        [ [ [ capped>> ] keep ] dip
+          '[ _ _
+             [ [ drop t "capped" ] dip set-at ]
+             [ [ size>> "size" ] dip set-at ]
+             [ [ max>> "max" ] dip set-at ] 2tri ] when
+        ] 2bi
+    ] keep <mdb-query-msg> 1 >>return# send-query-plain objects>> first check-ok
     [ "could not create collection" throw ] unless ;
 
 : load-collection-list ( -- collection-list )
@@ -194,10 +205,12 @@ GENERIC# hint 1 ( mdb-query index-hint -- mdb-query )
 M: mdb-query-msg hint ( mdb-query index-hint -- mdb-query )
     >>hint ;
 
-: find ( mdb-query -- cursor result )
+GENERIC: find ( mdb-query -- cursor result )
+M: mdb-query-msg find
      send-query ;
 
-: explain ( mdb-query -- result )
+GENERIC: explain ( mdb-query -- result )
+M: mdb-query-msg explain
     t >>explain find [ drop ] dip ;
 
 GENERIC: get-more ( mdb-cursor -- mdb-cursor objects )
@@ -205,10 +218,12 @@ M: mdb-cursor get-more ( mdb-cursor -- mdb-cursor objects )
     [ [ collection>> ] [ return#>> ] [ id>> ] tri <mdb-getmore-msg> send-query ] 
     [ f f ] if* ;
 
-: find-one ( mdb-query -- result )
+GENERIC: find-one ( mdb-query -- result )
+M: mdb-query-msg find-one
     1 >>return# send-query-plain ;
 
-: count ( collection query -- result )
+GENERIC: count ( collection query -- result )
+M: assoc count
     [ "count" H{ } clone [ set-at ] keep ] dip
     [ over [ "query" ] dip set-at ] when*
     [ cmd-collection ] dip <mdb-query-msg> find-one objects>> first
@@ -218,11 +233,14 @@ M: mdb-cursor get-more ( mdb-cursor -- mdb-cursor objects )
     cmd-collection H{ { "getlasterror" 1 } } <mdb-query-msg>
     find-one objects>> [ "err" ] at ;
 
-: validate ( collection -- )
+GENERIC: validate ( collection -- )
+M: string validate
     [ cmd-collection ] dip
     "validate" H{ } clone [ set-at ] keep
     <mdb-query-msg> find-one objects>> first [ check-ok ] keep
     '[ "result" _ at print ] when ;
+M: mdb-collection validate
+    name>> validate ;
 
 <PRIVATE
 
@@ -231,15 +249,18 @@ M: mdb-cursor get-more ( mdb-cursor -- mdb-cursor objects )
 
 PRIVATE>
 
-: save ( collection object -- )
+GENERIC: save ( collection assoc -- )
+M: assoc save
     [ ensure-collection ] dip
     <mdb-insert-msg> send-message-check-error ;
 
-: save-unsafe ( collection object -- )
+GENERIC: save-unsafe ( collection object -- )
+M: assoc save-unsafe
     [ ensure-collection ] dip
     <mdb-insert-msg> send-message ;
 
-: ensure-index ( collection name spec -- )
+GENERIC: ensure-index ( collection name spec -- )
+M: assoc ensure-index
     H{ } clone
     [ [ "key" ] dip set-at ] keep
     [ [ "name" ] dip set-at ] keep
@@ -254,19 +275,23 @@ PRIVATE>
     [ cmd-collection ] dip <mdb-query-msg> find-one objects>> first
     check-ok [ "could not drop index" throw ] unless ;
 
-: update ( collection selector object -- )
+GENERIC: update ( collection selector object -- )
+M: assoc update
     [ ensure-collection ] dip
     <mdb-update-msg> send-message-check-error ;
 
-: update-unsafe ( collection selector object -- )
+GENERIC: update-unsafe ( collection selector object -- )
+M: assoc update-unsafe
     [ ensure-collection ] dip
     <mdb-update-msg> send-message ;
  
-: delete ( collection selector -- )
+GENERIC: delete ( collection selector -- )
+M: assoc delete
     [ ensure-collection ] dip
     <mdb-delete-msg> send-message-check-error ;
 
-: delete-unsafe ( collection selector -- )
+GENERIC: delete-unsafe ( collection selector -- )
+M: assoc delete-unsafe
     [ ensure-collection ] dip
     <mdb-delete-msg> send-message ;