Merge pull request #12 from gregwebs/findAndModify

add findAndModify command
This commit is contained in:
Fedor Gogolev 2013-06-19 05:22:24 -07:00
commit 33e9bcf67d

View file

@ -27,7 +27,7 @@ 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, count, distinct, explain, find, findOne, fetch, findAndModify, count, distinct,
-- *** Cursor -- *** Cursor
Cursor, nextBatch, next, nextN, rest, closeCursor, isCursorClosed, Cursor, nextBatch, next, nextN, rest, closeCursor, isCursorClosed,
-- ** Aggregate -- ** Aggregate
@ -67,7 +67,7 @@ import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl(..),
MonadTransControl(..), StM, StT, MonadTransControl(..), StM, StT,
defaultLiftBaseWith, defaultRestoreM) defaultLiftBaseWith, defaultRestoreM)
import Control.Monad.Writer (WriterT, Monoid) import Control.Monad.Writer (WriterT, Monoid)
import Data.Bson (Document, Field(..), Label, Val, Value(String,Doc), import Data.Bson (Document, Field(..), Label, Val, Value(String, Doc, Bool),
Javascript, at, valueAt, lookup, look, genObjectId, (=:), Javascript, at, valueAt, lookup, look, genObjectId, (=:),
(=?)) (=?))
import Data.Text (Text) import Data.Text (Text)
@ -438,6 +438,34 @@ 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 (throwError $ DocNotFound $ selection q) return fetch q = findOne q >>= maybe (throwError $ DocNotFound $ selection q) return
-- | runs the findAndModify command.
-- Returns a single updated document (new option is set to true).
-- Currently this API does not allow setting the remove option
findAndModify :: (Applicative m, MonadIO m)
=> Query
-> Document -- ^ updates
-> Action m (Either String Document)
findAndModify (Query {
selection = Select sel collection
, project = project
, sort = sort
}) updates = do
result <- runCommand [
"findAndModify" := String collection
, "new" := Bool True -- return updated document, not original document
, "query" := Doc sel
, "update" := Doc updates
, "fields" := Doc project
, "sort" := Doc sort
]
return $ case findErr result of
Nothing -> case lookup "value" result of
Nothing -> Left "findAndModify: no document found (value field was empty)"
Just doc -> Right doc
Just e -> Left e
where
findErr result = lookup "err" (at "lastErrorObject" result)
explain :: (MonadIO m) => Query -> Action m Document explain :: (MonadIO m) => Query -> Action m Document
-- ^ Return performance stats of query execution -- ^ Return performance stats of query execution
explain q = do -- same as findOne but with explain set to true explain q = do -- same as findOne but with explain set to true