From 46839acdbc4c6718f5b3b2bd737c71407a80b107 Mon Sep 17 00:00:00 2001
From: "Scott R. Parish" <sparish@peak6.com>
Date: Tue, 19 Jan 2010 22:31:38 -0600
Subject: [PATCH] createIndex

---
 Database/MongoDB.hs | 40 +++++++++++++++++++++++++++++++++++++++-
 TODO                |  3 ++-
 2 files changed, 41 insertions(+), 2 deletions(-)

diff --git a/Database/MongoDB.hs b/Database/MongoDB.hs
index a5ebf0d..ad6f34e 100644
--- a/Database/MongoDB.hs
+++ b/Database/MongoDB.hs
@@ -45,6 +45,10 @@ module Database.MongoDB
      -- * Cursor
      Cursor,
      allDocs, allDocs', finish, nextDoc,
+     -- * Index
+     Key, Unique,
+     Direction(..),
+     createIndex,
     )
 where
 import Control.Exception
@@ -363,7 +367,7 @@ countMatching :: Connection -> FullCollection -> Selector -> IO Int64
 countMatching c col sel = do
   let (db, col') = splitFullCol col
   res <- runCommand c db $ toBsonDoc [("count", toBson col'),
-                                      ("query", BsonObject sel)]
+                                      ("query", toBson sel)]
   return $ fromBson $ fromJust $ BSON.lookup "n" res
 
 -- | Delete documents matching /Selector/ from the given /FullCollection/.
@@ -610,6 +614,40 @@ finish cur = do
   writeIORef (curClosed cur) True
   return ()
 
+-- | The field key to index on.
+type Key = String
+
+-- | Direction to index.
+data Direction = Ascending
+               | Descending
+                 deriving (Show, Eq)
+
+fromDirection :: Direction -> Int
+fromDirection Ascending  = 1
+fromDirection Descending = (-1)
+
+-- | Should this index guarantee uniqueness?
+type Unique = Bool
+
+createIndex :: Connection -> FullCollection ->
+               [(Key, Direction)] -> Unique -> IO String
+createIndex c col keys uniq = do
+  let (db, _col') = splitFullCol col
+      name = indexName keys
+      keysDoc = flip fmap keys $
+                \(k, d) -> (k, toBson $ fromDirection d :: BsonValue)
+  _ <- insert c (db ++ ".system.indexes") $
+       toBsonDoc [("name",   toBson name),
+                  ("ns",     toBson col),
+                  ("key",    toBson keysDoc),
+                  ("unique", toBson uniq)]
+  return name
+
+indexName :: [(Key, Direction)] -> String
+indexName = List.concat . List.intersperse "_" . fmap partName
+    where partName (k, Ascending)  = k ++ "_1"
+          partName (k, Descending) = k ++ "_-1"
+
 putCol :: Collection -> Put
 putCol col = putByteString (pack col) >> putNull
 
diff --git a/TODO b/TODO
index c825f09..bfca888 100644
--- a/TODO
+++ b/TODO
@@ -44,7 +44,6 @@ MongoDB
     * repsert
     * rename
   - index operations
-    * createIndex
     * ensureIndex
     * dropIndex
     * dropIndexes
@@ -100,3 +99,5 @@ Documentation
   - tutorial
 
 GridFS
+
+what's this about index caching?