removed generic words; added kill-cursor + filter-fields words
parent
44e32981b2
commit
67c8bbe5c7
|
|
@ -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 ;
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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 ]
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue