Added Support for Aggregate Framework

This commit is contained in:
Timo von Holtz 2013-05-23 16:47:57 +02:00
parent 46b3f1f3fa
commit 83cae75efc

View file

@ -30,6 +30,8 @@ module Database.MongoDB.Query (
explain, find, findOne, fetch, count, distinct, explain, find, findOne, fetch, count, distinct,
-- *** Cursor -- *** Cursor
Cursor, nextBatch, next, nextN, rest, closeCursor, isCursorClosed, Cursor, nextBatch, next, nextN, rest, closeCursor, isCursorClosed,
-- ** Aggregate
Pipeline, aggregate,
-- ** Group -- ** Group
Group(..), GroupKey(..), group, Group(..), GroupKey(..), group,
-- ** MapReduce -- ** MapReduce
@ -123,6 +125,7 @@ data Failure =
| QueryFailure ErrorCode String -- ^ Query failed for some reason as described in the string | QueryFailure ErrorCode String -- ^ Query failed for some reason as described in the string
| WriteFailure ErrorCode String -- ^ Error observed by getLastError after a write, error description is in string | WriteFailure ErrorCode String -- ^ Error observed by getLastError after a write, error description is in string
| DocNotFound Selection -- ^ 'fetch' found no document matching selection | DocNotFound Selection -- ^ 'fetch' found no document matching selection
| AggregateFailure String -- ^ 'aggregate' returned an error
deriving (Show, Eq) deriving (Show, Eq)
type ErrorCode = Int type ErrorCode = Int
@ -580,6 +583,19 @@ isCursorClosed (Cursor _ _ var) = do
Batch _ cid docs <- fulfill =<< readMVar var Batch _ cid docs <- fulfill =<< readMVar var
return (cid == 0 && null docs) return (cid == 0 && null docs)
-- ** Aggregate
type Pipeline = [Document]
-- ^ The Aggregate Pipeline
aggregate :: MonadIO' m => Collection -> Pipeline -> Action m [Document]
-- ^ Runs an aggregate and unpacks the result. See <http://docs.mongodb.org/manual/core/aggregation/> for details.
aggregate aColl agg = do
response <- runCommand ["aggregate" =: aColl, "pipeline" =: agg]
case true1 "ok" response of
True -> lookup "result" response
False -> throwError $ AggregateFailure $ at "errmsg" response
-- ** Group -- ** Group
-- | Groups documents in collection by key then reduces (aggregates) each group -- | Groups documents in collection by key then reduces (aggregates) each group