Merge pull request #5 from mongodb-haskell/find-and-modify-opts

Find and modify opts
This commit is contained in:
Greg Weber 2014-07-19 17:54:53 -07:00
commit 357b308807
2 changed files with 53 additions and 13 deletions

View file

@ -28,7 +28,9 @@ module Database.MongoDB.Query (
-- ** Query -- ** Query
Query(..), QueryOption(NoCursorTimeout, TailableCursor, AwaitData, Partial), Query(..), QueryOption(NoCursorTimeout, TailableCursor, AwaitData, Partial),
Projector, Limit, Order, BatchSize, Projector, Limit, Order, BatchSize,
explain, find, findOne, fetch, findAndModify, count, distinct, explain, find, findOne, fetch,
findAndModify, findAndModifyOpts, FindAndModifyOpts(..),
count, distinct,
-- *** Cursor -- *** Cursor
Cursor, nextBatch, next, nextN, rest, closeCursor, isCursorClosed, Cursor, nextBatch, next, nextN, rest, closeCursor, isCursorClosed,
-- ** Aggregate -- ** Aggregate
@ -404,34 +406,72 @@ fetch :: (MonadIO m) => Query -> Action m Document
-- ^ Same as 'findOne' except throw 'DocNotFound' if none match -- ^ Same as 'findOne' except throw 'DocNotFound' if none match
fetch q = findOne q >>= maybe (liftIO $ throwIO $ DocNotFound $ selection q) return fetch q = findOne q >>= maybe (liftIO $ throwIO $ DocNotFound $ selection q) return
-- | runs the findAndModify command. data FindAndModifyOpts = FamRemove Bool
| FamUpdate
{ famUpdate :: Document
, famNew :: Bool
, famUpsert :: Bool
}
deriving Show
findAndModifyUpdate :: Document -> FindAndModifyOpts
findAndModifyUpdate ups = FamUpdate
{ famNew = True
, famUpsert = False
, famUpdate = ups
}
-- | runs the findAndModify command as an update without an upsert and new set to true.
-- Returns a single updated document (new option is set to true). -- Returns a single updated document (new option is set to true).
-- Currently this API does not allow setting the remove option --
-- see 'findAndModifyOpts' if you want to use findAndModify in a differnt way
findAndModify :: MonadIO m findAndModify :: MonadIO m
=> Query => Query
-> Document -- ^ updates -> Document -- ^ updates
-> Action m (Either String Document) -> Action m (Either String Document)
findAndModify (Query { findAndModify q ups = do
eres <- findAndModifyOpts q (findAndModifyUpdate ups)
return $ case eres of
Left l -> Left l
Right r -> case r of
-- mongoDB manual says this is only possible when update is True
Nothing -> Left "findAndModify: impossible null result"
Just doc -> Right doc
-- | runs the findAndModify command,
-- allows more options than 'findAndModify'
findAndModifyOpts :: MonadIO m
=> Query
->FindAndModifyOpts
-> Action m (Either String (Maybe Document))
findAndModifyOpts (Query {
selection = Select sel collection selection = Select sel collection
, project = project , project = project
, sort = sort , sort = sort
}) updates = do }) famOpts = do
result <- runCommand result <- runCommand
[ "findAndModify" := String collection ([ "findAndModify" := String collection
, "new" := Bool True -- return updated document, not original document
, "query" := Doc sel , "query" := Doc sel
, "update" := Doc updates
, "fields" := Doc project , "fields" := Doc project
, "sort" := Doc sort , "sort" := Doc sort
] ] ++
case famOpts of
FamRemove shouldRemove -> [ "remove" := Bool shouldRemove ]
FamUpdate {..} ->
[ "update" := Doc famUpdate
, "new" := Bool famNew -- return updated document, not original document
, "upsert" := Bool famUpsert -- insert if nothing is found
])
return $ return $
case lookup "value" result of case lookup "value" result of
Left err -> leftErr err Left err -> leftErr err
Right mdoc -> case mdoc of Right mdoc -> case mdoc of
Nothing -> leftErr $ show result Just doc@(_:_) -> case lookupErr result of
Just doc -> case lookupErr result of
Just e -> leftErr e Just e -> leftErr e
Nothing -> Right doc Nothing -> Right (Just doc)
_ -> case famOpts of
FamUpdate { famUpsert = True, famNew = True } -> Right Nothing
_ -> leftErr $ show result
where where
leftErr err = Left $ "findAndModify: no document found: " leftErr err = Left $ "findAndModify: no document found: "
`mappend` show collection `mappend` show collection

View file

@ -1,5 +1,5 @@
Name: mongoDB Name: mongoDB
Version: 2.0 Version: 2.0.1
Synopsis: Driver (client) for MongoDB, a free, scalable, fast, document Synopsis: Driver (client) for MongoDB, a free, scalable, fast, document
DBMS DBMS
Description: This package lets you connect to MongoDB servers and Description: This package lets you connect to MongoDB servers and