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

Fix tests

Browse source
This commit is contained in:
Victor Denisov 2016-11-20 13:55:40 -08:00
parent a828806940
commit 139a17248f
2 changed files with 9 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
Database/MongoDB/Query.hs
View file

@ -449,10 +449,11 @@ insertCommandDocument opts col docs writeConcern =
] ]
takeRightsUpToLeft :: [Either a b] -> [b] takeRightsUpToLeft :: [Either a b] -> [b]
takeRightsUpToLeft l = go l [] takeRightsUpToLeft l = reverse $ go l []
where where
go [] !res = res
go ((Right x):xs) !res = go xs (x:res) go ((Right x):xs) !res = go xs (x:res)
go ((Left x):xs) !res = res go ((Left _):_) !res = res
insert' :: (MonadIO m) insert' :: (MonadIO m)
=> [InsertOption] -> Collection -> [Document] -> Action m [Value] => [InsertOption] -> Collection -> [Document] -> Action m [Value]
@ -479,6 +480,10 @@ insert' opts col docs = do
else rights preChunks else rights preChunks
chunkResults <- forM chunks (insertBlock opts col) chunkResults <- forM chunks (insertBlock opts col)
let lchunks = lefts preChunks
when ((not $ null lchunks) && ordered) $ do
liftIO $ throwIO $ head lchunks
return $ concat chunkResults return $ concat chunkResults
insertBlock :: (MonadIO m) insertBlock :: (MonadIO m)