removed generic words; added kill-cursor + filter-fields words

Sascha Matzke 2010-01-06 15:56:38 +01:00
parent 44e32981b2
commit 67c8bbe5c7
3 changed files with 19 additions and 35 deletions

View File

@ -165,9 +165,7 @@ M: mdb-collection create-collection
: fix-query-collection ( mdb-query -- mdb-query ) : fix-query-collection ( mdb-query -- mdb-query )
[ check-collection ] change-collection ; inline [ check-collection ] change-collection ; inline
GENERIC: get-more ( mdb-cursor -- mdb-cursor seq ) : get-more ( mdb-cursor -- mdb-cursor seq )
M: mdb-cursor get-more
[ [ query>> dup [ collection>> ] [ return#>> ] bi ] [ [ query>> dup [ collection>> ] [ return#>> ] bi ]
[ id>> ] bi <mdb-getmore-msg> swap >>query send-query ] [ id>> ] bi <mdb-getmore-msg> swap >>query send-query ]
[ f f ] if* ; [ f f ] if* ;
@ -177,21 +175,17 @@ PRIVATE>
: <query> ( collection assoc -- mdb-query-msg ) : <query> ( collection assoc -- mdb-query-msg )
<mdb-query-msg> ; inline <mdb-query-msg> ; inline
GENERIC# limit 1 ( mdb-query-msg limit# -- mdb-query-msg ) : limit ( mdb-query-msg limit# -- mdb-query-msg )
M: mdb-query-msg limit
>>return# ; inline >>return# ; inline
GENERIC# skip 1 ( mdb-query-msg skip# -- mdb-query-msg ) : skip ( mdb-query-msg skip# -- mdb-query-msg )
M: mdb-query-msg skip
>>skip# ; inline >>skip# ; inline
: asc ( key -- spec ) 1 2array ; inline : asc ( key -- spec ) 1 2array ; inline
: desc ( key -- spec ) -1 2array ; inline : desc ( key -- spec ) -1 2array ; inline
: sort ( mdb-query-msg sort-quot -- mdb-query-msg ) : sort ( mdb-query-msg sort-quot -- mdb-query-msg )
output>array [ 1array >hashtable ] map >>orderby ; inline output>array >hashtable >>orderby ; inline
: filter-fields ( mdb-query-msg filterseq -- mdb-query-msg ) : filter-fields ( mdb-query-msg filterseq -- mdb-query-msg )
[ asc ] map >hashtable >>returnfields ; inline [ asc ] map >hashtable >>returnfields ; inline
@ -212,21 +206,15 @@ M: mdb-query-msg find
M: mdb-cursor find M: mdb-cursor find
get-more ; get-more ;
GENERIC: explain. ( mdb-query-msg -- ) : explain. ( mdb-query-msg -- )
M: mdb-query-msg explain.
t >>explain find nip . ; t >>explain find nip . ;
GENERIC: find-one ( mdb-query-msg -- result/f ) : find-one ( mdb-query-msg -- result/f )
M: mdb-query-msg find-one
fix-query-collection fix-query-collection
1 >>return# send-query-plain objects>> 1 >>return# send-query-plain objects>>
dup empty? [ drop f ] [ first ] if ; dup empty? [ drop f ] [ first ] if ;
GENERIC: count ( mdb-query-msg -- result ) : count ( mdb-query-msg -- result )
M: mdb-query-msg count
[ collection>> "count" H{ } clone [ set-at ] keep ] keep [ collection>> "count" H{ } clone [ set-at ] keep ] keep
query>> [ over [ "query" ] dip set-at ] when* query>> [ over [ "query" ] dip set-at ] when*
[ cmd-collection ] dip <mdb-query-msg> find-one [ cmd-collection ] dip <mdb-query-msg> find-one
@ -254,18 +242,15 @@ M: mdb-collection validate.
PRIVATE> PRIVATE>
GENERIC: save ( collection assoc -- ) : save ( collection assoc -- )
M: assoc save
[ check-collection ] dip [ check-collection ] dip
<mdb-insert-msg> send-message-check-error ; <mdb-insert-msg> send-message-check-error ;
GENERIC: save-unsafe ( collection assoc -- ) : save-unsafe ( collection assoc -- )
M: assoc save-unsafe
[ check-collection ] dip [ check-collection ] dip
<mdb-insert-msg> send-message ; <mdb-insert-msg> send-message ;
GENERIC: ensure-index ( index-spec -- ) : ensure-index ( index-spec -- )
M: index-spec ensure-index
<linked-hash> [ [ uuid1 "_id" ] dip set-at ] keep <linked-hash> [ [ uuid1 "_id" ] dip set-at ] keep
[ { [ [ name>> "name" ] dip set-at ] [ { [ [ name>> "name" ] dip set-at ]
[ [ ns>> index-ns "ns" ] dip set-at ] [ [ ns>> index-ns "ns" ] dip set-at ]
@ -288,24 +273,23 @@ M: index-spec ensure-index
: >upsert ( mdb-update-msg -- mdb-update-msg ) : >upsert ( mdb-update-msg -- mdb-update-msg )
1 >>upsert? ; 1 >>upsert? ;
GENERIC: update ( mdb-update-msg -- ) : update ( mdb-update-msg -- )
M: mdb-update-msg update
send-message-check-error ; send-message-check-error ;
GENERIC: update-unsafe ( mdb-update-msg -- ) : update-unsafe ( mdb-update-msg -- )
M: mdb-update-msg update-unsafe
send-message ; send-message ;
GENERIC: delete ( collection selector -- ) : delete ( collection selector -- )
M: assoc delete
[ check-collection ] dip [ check-collection ] dip
<mdb-delete-msg> send-message-check-error ; <mdb-delete-msg> send-message-check-error ;
GENERIC: delete-unsafe ( collection selector -- ) : delete-unsafe ( collection selector -- )
M: assoc delete-unsafe
[ check-collection ] dip [ check-collection ] dip
<mdb-delete-msg> send-message ; <mdb-delete-msg> send-message ;
: kill-cursor ( mdb-cursor -- )
id>> <mdb-killcursors-msg> send-message ;
: load-index-list ( -- index-list ) : load-index-list ( -- index-list )
index-collection index-collection
H{ } clone <mdb-query-msg> find nip ; H{ } clone <mdb-query-msg> find nip ;

View File

@ -29,7 +29,7 @@ TUPLE: mdb-query-msg < mdb-msg
{ return# integer initial: 0 } { return# integer initial: 0 }
{ query assoc } { query assoc }
{ returnfields assoc } { returnfields assoc }
{ orderby sequence } { orderby assoc }
explain hint ; explain hint ;
TUPLE: mdb-insert-msg < mdb-msg TUPLE: mdb-insert-msg < mdb-msg

View File

@ -107,7 +107,7 @@ USE: tools.walker
:: build-query-object ( query -- selector ) :: build-query-object ( query -- selector )
H{ } clone :> selector H{ } clone :> selector
query { [ orderby>> [ "orderby" selector set-at ] when* ] query { [ orderby>> [ "$orderby" selector set-at ] when* ]
[ explain>> [ "$explain" selector set-at ] when* ] [ explain>> [ "$explain" selector set-at ] when* ]
[ hint>> [ "$hint" selector set-at ] when* ] [ hint>> [ "$hint" selector set-at ] when* ]
[ query>> "query" selector set-at ] [ query>> "query" selector set-at ]