adding update support
This commit is contained in:
parent
985423cfe7
commit
6a9a533fcc
1 changed files with 21 additions and 0 deletions
|
@ -93,6 +93,13 @@ fromQueryOpts opts = List.foldl (.|.) 0 $ fmap toVal opts
|
|||
toVal QO_OpLogReplay = 8
|
||||
toVal QO_NoCursorTimeout = 16
|
||||
|
||||
data UpdateFlag = UF_Upsert
|
||||
| UF_Multiupdate
|
||||
deriving (Show, Enum)
|
||||
|
||||
fromUpdateFlags flags = List.foldl (.|.) 0 $
|
||||
flip fmap flags $ (1 `shiftL`) . fromEnum
|
||||
|
||||
delete :: Connection -> Collection -> Selector -> IO RequestID
|
||||
delete c col sel = do
|
||||
let body = runPut $ do
|
||||
|
@ -142,6 +149,20 @@ query c col opts skip ret sel fsel = do
|
|||
L.hPut (cHandle c) msg
|
||||
getReply c reqID
|
||||
|
||||
update :: Connection -> Collection ->
|
||||
[UpdateFlag] -> Selector -> BSONObject -> IO RequestID
|
||||
update c col flags sel obj = do
|
||||
let body = runPut $ do
|
||||
putI32 0
|
||||
putCol col
|
||||
putI32 $ fromUpdateFlags flags
|
||||
put sel
|
||||
put obj
|
||||
(reqID, msg) <- packMsg c OP_UPDATE body
|
||||
L.hPut (cHandle c) msg
|
||||
return reqID
|
||||
|
||||
|
||||
data Hdr = Hdr {
|
||||
hMsgLen :: Int32,
|
||||
hReqID :: Int32,
|
||||
|
|
Loading…
Reference in a new issue