]> gitweb.factorcode.org Git - factor.git/commitdiff
removed usages of sprintf
authorSascha Matzke <sascha.matzke@didolo.org>
Sun, 5 Jul 2009 11:28:41 +0000 (13:28 +0200)
committerSascha Matzke <sascha.matzke@didolo.org>
Thu, 9 Jul 2009 11:36:37 +0000 (13:36 +0200)
made collection handling more concise

extra/mongodb/benchmark/benchmark.factor
extra/mongodb/connection/connection.factor
extra/mongodb/driver/driver-docs.factor
extra/mongodb/driver/driver.factor
extra/mongodb/tuple/collection/collection.factor

index 5204846d0346f75f001b0a52cd2d4e838dd9af84..ad8c5016052688153f4694ef424b4a89e4ebc316 100644 (file)
@@ -163,7 +163,7 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
     [ create-collection ] keep ; 
 
 : prepare-index ( collection -- )
-    "_x_idx" [ "x" asc ] key-spec <index-spec> unique-index ensure-index ; 
+    "_x_idx" [ "x" asc ] key-spec <index-spec> t >>unique? ensure-index ; 
 
 : insert ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
     prepare-collection
index 7477ee5486daac12bb28f95a2f2265e773b3ae83..af54f2ebc53fc924d647b9f7ef3d0ae460755db8 100644 (file)
@@ -1,6 +1,6 @@
 USING: accessors assocs fry io.encodings.binary io.sockets kernel math
 math.parser mongodb.msg mongodb.operations namespaces destructors
-constructors sequences splitting checksums checksums.md5 formatting
+constructors sequences splitting checksums checksums.md5 
 io.streams.duplex io.encodings.utf8 io.encodings.string combinators.smart
 arrays hashtables sequences.deep vectors locals ;
 
@@ -39,16 +39,16 @@ CONSTRUCTOR: mdb-connection ( instance -- mdb-connection ) ;
     mdb-connection get instance>> ; inline
 
 : index-collection ( -- ns )
-    mdb-instance name>> "%s.system.indexes" sprintf ; inline
+    mdb-instance name>> "system.indexes" 2array "." join ; inline
 
 : namespaces-collection ( -- ns )
-    mdb-instance name>> "%s.system.namespaces" sprintf ; inline
+    mdb-instance name>> "system.namespaces" 2array "." join ; inline
 
 : cmd-collection ( -- ns )
-    mdb-instance name>> "%s.$cmd" sprintf ; inline
+    mdb-instance name>> "$cmd" 2array "." join ; inline
 
 : index-ns ( colname -- index-ns )
-    [ mdb-instance name>> ] dip "%s.%s" sprintf ; inline
+    [ mdb-instance name>> ] dip 2array "." join ; inline
 
 : send-message ( message -- )
     [ mdb-connection get handle>> ] dip '[ _ write-message ] with-stream* ;
index 7dbf564df943e8d7de3795fe570fa71c281de393..e8f726374c1431f3b66d140ce96f162e2c336055 100644 (file)
@@ -131,7 +131,7 @@ HELP: ensure-index
     "\"db\" \"127.0.0.1\" 27017 <mdb>"
     "[ \"mycollection\" nameIdx [ \"name\" asc ] keyspec <index-spec> ensure-index ] with-db" "" }
   { $unchecked-example  "USING: mongodb.driver ;"
-    "\"db\" \"127.0.0.1\" 27017 <mdb>" "[ \"mycollection\" nameIdx [ \"name\" asc ] keyspec <index-spec> unique-index ensure-index ] with-db" "" } } ;
+    "\"db\" \"127.0.0.1\" 27017 <mdb>" "[ \"mycollection\" nameIdx [ \"name\" asc ] keyspec <index-spec> t >>unique? ensure-index ] with-db" "" } } ;
 
 HELP: explain.
 { $values
index 967d4f11c5582ec3987cf684eea43abc9435ed44..48f0aef4ff1587003492db554bc1409253792c3f 100644 (file)
@@ -1,8 +1,8 @@
-USING: accessors assocs bson.constants bson.writer combinators combinators.smart
-constructors continuations destructors formatting fry io io.pools
-io.encodings.binary io.sockets io.streams.duplex kernel linked-assocs hashtables
-namespaces parser prettyprint sequences sets splitting strings uuid arrays
-math math.parser memoize mongodb.connection mongodb.msg mongodb.operations  ;
+USING: accessors arrays assocs bson.constants combinators
+combinators.smart constructors destructors formatting fry hashtables
+io io.pools io.sockets kernel linked-assocs math mongodb.connection
+mongodb.msg parser prettyprint sequences sets splitting strings
+tools.continuations uuid memoize locals ;
 
 IN: mongodb.driver
 
@@ -23,9 +23,6 @@ TUPLE: index-spec
 
 CONSTRUCTOR: index-spec ( ns name key -- index-spec ) ;
 
-: unique-index ( index-spec -- index-spec )
-    t >>unique? ;
-
 M: mdb-pool make-connection
     mdb>> mdb-open ;
 
@@ -83,6 +80,15 @@ M: mdb-getmore-msg verify-query-result
     [ make-cursor ] 2tri
     swap objects>> ;
 
+: make-collection-assoc ( collection assoc -- )
+    [ [ 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 ; 
+
 PRIVATE>
 
 SYNTAX: r/ ( token -- mdbregexp )
@@ -100,23 +106,17 @@ SYNTAX: r/ ( token -- mdbregexp )
    H{ } clone [ set-at ] keep <mdb-db>
    [ verify-nodes ] keep ;
 
-GENERIC: create-collection ( name -- )
+GENERIC: create-collection ( name/collection -- )
 
 M: string create-collection
     <mdb-collection> create-collection ;
 
 M: mdb-collection create-collection
-    [ cmd-collection ] dip
-    <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 drop ;
-
+    [ [ cmd-collection ] dip
+      <linked-hash> [ make-collection-assoc ] keep
+      <mdb-query-msg> 1 >>return# send-query-plain drop ] keep
+      [ ] [ name>> ] bi mdb-instance collections>> set-at ;
+  
 : load-collection-list ( -- collection-list )
     namespaces-collection
     H{ } clone <mdb-query-msg> send-query-plain objects>> ;
@@ -125,27 +125,36 @@ M: mdb-collection create-collection
 
 : ensure-valid-collection-name ( collection -- )
     [ ";$." intersect length 0 > ] keep
-    '[ _ "%s contains invalid characters ( . $ ; )" sprintf throw ] when ; inline
-
-: (ensure-collection) ( collection --  )
-    mdb-instance collections>> dup keys length 0 = 
-    [ load-collection-list      
-      [ [ "options" ] dip key? ] filter
-      [ [ "name" ] dip at "." split second <mdb-collection> ] map
-      over '[ [ ] [ name>> ] bi _ set-at ] each ] [ ] if
-    [ dup ] dip key? [ drop ]
-    [ [ ensure-valid-collection-name ] keep create-collection ] if ; 
-
+    '[ _ "contains invalid characters ( . $ ; )" 2array "." join throw ] when ; inline
+
+: build-collection-map ( -- assoc )
+    H{ } clone load-collection-list      
+    [ [ "name" ] dip at "." split second <mdb-collection> ] map
+    over '[ [ ] [ name>> ] bi _ set-at ] each ;
+
+: ensure-collection-map ( mdb-instance -- assoc )
+    dup collections>> dup keys length 0 = 
+    [ drop build-collection-map [ >>collections drop ] keep ]
+    [ nip ] if ; 
+
+: (ensure-collection) ( collection mdb-instance -- collection )
+    ensure-collection-map [ dup ] dip key?
+    [ ] [ [ ensure-valid-collection-name ]
+          [ create-collection ]
+          [ ] tri ] if ; 
+      
 : reserved-namespace? ( name -- ? )
     [ "$cmd" = ] [ "system" head? ] bi or ;
 
 : check-collection ( collection -- fq-collection )
-    dup mdb-collection? [ name>> ] when
-    "." split1 over mdb-instance name>> =
-    [ nip ] [ drop ] if
-    [ ] [ reserved-namespace? ] bi
-    [ [ (ensure-collection) ] keep ] unless
-    [ mdb-instance name>> ] dip "%s.%s" sprintf ; 
+    [let* | instance [ mdb-instance ]
+            instance-name [ instance name>> ] |        
+        dup mdb-collection? [ name>> ] when
+        "." split1 over instance-name =
+        [ nip ] [ drop ] if
+        [ ] [ reserved-namespace? ] bi
+        [ instance (ensure-collection) ] unless
+        [ instance-name ] dip 2array "." join ] ; 
 
 : fix-query-collection ( mdb-query -- mdb-query )
     [ check-collection ] change-collection ; inline
index 60b2d25764a8546976c9349f65cb353153aca75e..6c2b89a57167424429533c2a3885e60cb3ad33fc 100644 (file)
@@ -88,7 +88,7 @@ GENERIC: mdb-index-map ( tuple -- sequence )
 : user-defined-key-index ( class -- assoc )
     mdb-slot-map user-defined-key
     [ drop [ "user-defined-key-index" 1 ] dip
-      H{ } clone [ set-at ] keep <tuple-index> unique-index
+      H{ } clone [ set-at ] keep <tuple-index> t >>unique?
       [ ] [ name>> ] bi  H{ } clone [ set-at ] keep
     ] [ 2drop H{ } clone ] if ;