From 83cae75efc94ac407130a11683a69d0f0167ca1d Mon Sep 17 00:00:00 2001 From: Timo von Holtz Date: Thu, 23 May 2013 16:47:57 +0200 Subject: [PATCH] Added Support for Aggregate Framework --- Database/MongoDB/Query.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/Database/MongoDB/Query.hs b/Database/MongoDB/Query.hs index fc37076..fa7ad03 100644 --- a/Database/MongoDB/Query.hs +++ b/Database/MongoDB/Query.hs @@ -30,6 +30,8 @@ module Database.MongoDB.Query ( explain, find, findOne, fetch, count, distinct, -- *** Cursor Cursor, nextBatch, next, nextN, rest, closeCursor, isCursorClosed, + -- ** Aggregate + Pipeline, aggregate, -- ** Group Group(..), GroupKey(..), group, -- ** MapReduce @@ -123,6 +125,7 @@ data Failure = | 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 | DocNotFound Selection -- ^ 'fetch' found no document matching selection + | AggregateFailure String -- ^ 'aggregate' returned an error deriving (Show, Eq) type ErrorCode = Int @@ -580,6 +583,19 @@ isCursorClosed (Cursor _ _ var) = do Batch _ cid docs <- fulfill =<< readMVar var 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 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 -- | Groups documents in collection by key then reduces (aggregates) each group