From ece60d87ad557c089d808c3b6d9a55c115464c8b Mon Sep 17 00:00:00 2001
From: "Scott R. Parish" <srp@srparish.net>
Date: Mon, 8 Mar 2010 19:42:47 -0600
Subject: [PATCH] better mapReduce apis

+ mapReduce is now the convience function that returns a cursor
+ runMapReduce can be called if you want the intermediate
  result meta-data
+ mapReduceResults will take the result meta-data and open a
  cursor on it
---
 Database/MongoDB.hs | 81 ++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 76 insertions(+), 5 deletions(-)

diff --git a/Database/MongoDB.hs b/Database/MongoDB.hs
index 8963b56..ca7185e 100644
--- a/Database/MongoDB.hs
+++ b/Database/MongoDB.hs
@@ -56,7 +56,10 @@ module Database.MongoDB
      Direction(..),
      createIndex, dropIndex, dropIndexes, indexInformation,
      -- * Map-Reduce
-     MapReduceOpt(..), mapReduce,
+     MapReduceOpt(..),
+     mapReduce, mapReduceWScopes,
+     runMapReduce, runMapReduceWScopes,
+     mapReduceResults,
     )
 where
 import Control.Exception
@@ -653,18 +656,86 @@ mrOptToTuple (MROptFinalize f) = ("finalize", BsonJSCode f)
 mrOptToTuple (MROptScope s)    = ("scope", BsonDoc s)
 mrOptToTuple MROptVerbose      = ("verbose", BsonBool True)
 
-mapReduce :: Connection -> FullCollection
+-- | Issue a map/reduce command and return the results metadata.  If
+-- all you care about is the actual map/reduce results you might want
+-- to use the 'mapReduce' command instead.
+--
+-- The results meta-document will look something like this:
+--
+-- > {"result": "tmp.mr.mapreduce_1268095152_14",
+-- >  "timeMillis": 67,
+-- >  "counts": {"input": 4,
+-- >             "emit": 6,
+-- >             "output": 3},
+-- >  "ok": 1.0}
+--
+-- The /results/ field is the collection name within the same Database
+-- that contain the results of the map/reduce.
+runMapReduce :: Connection -> FullCollection
           -> JSCode -- ^ mapping javascript function
           -> JSCode -- ^ reducing javascript function
           -> [MapReduceOpt]
           -> IO BsonDoc
-mapReduce c fc m r opts = do
+runMapReduce c fc m r opts = do
   let (db, col) = splitFullCol fc
       doc = [("mapreduce", toBson col),
-             ("map", BsonCode m),
-             ("reduce", BsonCode r)] ++ List.map mrOptToTuple opts
+             ("map", BsonJSCode m),
+             ("reduce", BsonJSCode r)] ++ List.map mrOptToTuple opts
   runCommand c db $ toBsonDoc doc
 
+-- | Issue a map/reduce command with associated scopes and return the
+-- results metadata. If all you care about is the actual map/reduce
+-- results you might want to use the 'mapReduce' command instead.
+--
+-- See 'runMapReduce' for more information about the form of the
+-- result metadata.
+runMapReduceWScopes :: Connection -> FullCollection
+          -> JSCode -- ^ mapping javascript function
+          -> BsonDoc -- ^ Scope for mapping function
+          -> JSCode -- ^ reducing javascript function
+          -> BsonDoc -- ^ Scope for reducing function
+          -> [MapReduceOpt]
+          -> IO BsonDoc
+runMapReduceWScopes c fc m ms r rs opts = do
+  let (db, col) = splitFullCol fc
+      doc = [("mapreduce", toBson col),
+             ("map", BsonJSCodeWScope m ms),
+             ("reduce", BsonJSCodeWScope r rs)] ++ List.map mrOptToTuple opts
+  runCommand c db $ toBsonDoc doc
+
+-- | Given a result metadata from a 'mapReduce' command (or
+-- 'mapReduceWScope'), issue the 'find' command that will produce the
+-- actual map/reduce results.
+mapReduceResults :: Connection -> Database -> BsonDoc -> IO Cursor
+mapReduceResults c db r = do
+  let col = case List.lookup (s2L "result") r of
+              Just bCol -> fromBson bCol
+              Nothing -> throwOpFailure "No 'result' in mapReduce response"
+      fc = L.append (L.append db $ s2L ".") col
+  find c fc []
+
+-- | Run map/reduce and produce a cursor on the results.
+mapReduce :: Connection -> FullCollection
+          -> JSCode -- ^ mapping javascript function
+          -> JSCode -- ^ reducing javascript function
+          -> [MapReduceOpt]
+          -> IO Cursor
+mapReduce c fc m r opts =
+    runMapReduce c fc m r opts >>= mapReduceResults c (fst $ splitFullCol fc)
+
+-- | Run map/reduce with associated scopes and produce a cursor on the
+-- results.
+mapReduceWScopes :: Connection -> FullCollection
+          -> JSCode -- ^ mapping javascript function
+          -> BsonDoc -- ^ Scope for mapping function
+          -> JSCode -- ^ reducing javascript function
+          -> BsonDoc -- ^ Scope for mapping function
+          -> [MapReduceOpt]
+          -> IO Cursor
+mapReduceWScopes c fc m ms r rs opts =
+    runMapReduceWScopes c fc m ms r rs opts >>=
+    mapReduceResults c (fst $ splitFullCol fc)
+
 -- | Conveniently stores the /BsonDoc/ to the /FullCollection/
 -- if there is an _id present in the /BsonDoc/ then it already has
 -- a place in the DB, so we update it using the _id, otherwise