From 0a391e631bdada5bf162361c2ba4fc1c964e155d Mon Sep 17 00:00:00 2001
From: "Scott R. Parish" <srp@srparish.net>
Date: Mon, 8 Mar 2010 07:05:35 -0600
Subject: [PATCH] mapreduce command

---
 Database/MongoDB.hs | 48 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)

diff --git a/Database/MongoDB.hs b/Database/MongoDB.hs
index 0096603..8963b56 100644
--- a/Database/MongoDB.hs
+++ b/Database/MongoDB.hs
@@ -55,6 +55,8 @@ module Database.MongoDB
      Key, Unique,
      Direction(..),
      createIndex, dropIndex, dropIndexes, indexInformation,
+     -- * Map-Reduce
+     MapReduceOpt(..), mapReduce,
     )
 where
 import Control.Exception
@@ -617,6 +619,52 @@ addUser c db user pass = do
   _ <- save c fdb doc'
   return doc'
 
+data MapReduceOpt
+    = MROptQuery BsonDoc      -- ^ query filter object
+
+    -- | MRSort ???? TODO  <sort the query.  useful for optimization>
+
+    | MROptLimit Int64        -- ^ number of objects to return from
+                              -- collection
+
+    | MROptOut L8.ByteString  -- ^ output-collection name
+
+    | MROptKeepTemp           -- ^ If set the generated collection is
+                              -- not treated as temporary, as it will
+                              -- be by defualt. When /MROptOut/ is
+                              -- specified, the collection is
+                              -- automatically made permanent.
+
+    | MROptFinalize JSCode    -- ^ function to apply to all the
+                              -- results when finished
+
+    | MROptScope BsonDoc      -- ^ can pass in variables that can be
+                              -- access from map/reduce/finalize
+
+    | MROptVerbose            -- ^ provide statistics on job execution
+                              -- time
+
+mrOptToTuple :: MapReduceOpt -> (String, BsonValue)
+mrOptToTuple (MROptQuery q)    = ("query", BsonDoc q)
+mrOptToTuple (MROptLimit l)    = ("limit", BsonInt64 l)
+mrOptToTuple (MROptOut c)      = ("out", BsonString c)
+mrOptToTuple MROptKeepTemp     = ("keeptemp", BsonBool True)
+mrOptToTuple (MROptFinalize f) = ("finalize", BsonJSCode f)
+mrOptToTuple (MROptScope s)    = ("scope", BsonDoc s)
+mrOptToTuple MROptVerbose      = ("verbose", BsonBool True)
+
+mapReduce :: Connection -> FullCollection
+          -> JSCode -- ^ mapping javascript function
+          -> JSCode -- ^ reducing javascript function
+          -> [MapReduceOpt]
+          -> IO BsonDoc
+mapReduce 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
+  runCommand c db $ toBsonDoc doc
+
 -- | 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