Vergara_Tech/mongodb
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Restrict type of write function

Browse source
This commit is contained in:
Victor Denisov 2016-08-06 13:28:36 -07:00
parent 8348045cc5
commit b9be757039
1 changed files with 4 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
Database/MongoDB/Query.hs
View file

@ -372,7 +372,7 @@ data WriteMode =
| Confirm GetLastError -- ^ Receive an acknowledgment after every write, and raise exception if one says the write failed. This is acomplished by sending the getLastError command, with given 'GetLastError' parameters, after every write. | Confirm GetLastError -- ^ Receive an acknowledgment after every write, and raise exception if one says the write failed. This is acomplished by sending the getLastError command, with given 'GetLastError' parameters, after every write.
deriving (Show, Eq) deriving (Show, Eq)
write :: (MonadIO m) => Notice -> Action m () write :: Notice -> Action IO ()
-- ^ Send write to server, and if write-mode is 'Safe' then include getLastError request and raise 'WriteFailure' if it reports an error. -- ^ Send write to server, and if write-mode is 'Safe' then include getLastError request and raise 'WriteFailure' if it reports an error.
write notice = asks mongoWriteMode >>= \mode -> case mode of write notice = asks mongoWriteMode >>= \mode -> case mode of
NoConfirm -> do NoConfirm -> do
@ -457,7 +457,7 @@ insertBlock opts col docs = do
let sd = P.serverData p let sd = P.serverData p
if (maxWireVersion sd < 2) if (maxWireVersion sd < 2)
then do then do
write (Insert (db <.> col) opts docs') liftDB $ write (Insert (db <.> col) opts docs')
return $ map (valueAt "_id") docs' return $ map (valueAt "_id") docs'
else do else do
mode <- asks mongoWriteMode mode <- asks mongoWriteMode
@ -628,7 +628,7 @@ updateBlock ordered col docs = do
let sel = (at "q" updateDoc) :: Document let sel = (at "q" updateDoc) :: Document
let upsrt = if at "upsert" updateDoc then [Upsert] else [] let upsrt = if at "upsert" updateDoc then [Upsert] else []
let multi = if at "multi" updateDoc then [MultiUpdate] else [] let multi = if at "multi" updateDoc then [MultiUpdate] else []
write (Update (db <.> col) (upsrt ++ multi) sel doc) liftDB $ write (Update (db <.> col) (upsrt ++ multi) sel doc)
return Nothing return Nothing
`catch` \(e :: SomeException) -> do `catch` \(e :: SomeException) -> do
when ordered $ liftIO $ throwIO e when ordered $ liftIO $ throwIO e
@ -747,7 +747,7 @@ deleteBlock ordered col docs = do
forM docs $ \deleteDoc -> do forM docs $ \deleteDoc -> do
let sel = (at "q" deleteDoc) :: Document let sel = (at "q" deleteDoc) :: Document
let opts = if at "limit" deleteDoc == (1 :: Int) then [SingleRemove] else [] let opts = if at "limit" deleteDoc == (1 :: Int) then [SingleRemove] else []
write (Delete (db <.> col) opts sel) liftDB $ write (Delete (db <.> col) opts sel)
return Nothing return Nothing
`catch` \(e :: SomeException) -> do `catch` \(e :: SomeException) -> do
when ordered $ liftIO $ throwIO e when ordered $ liftIO $ throwIO e