From 311e0462ac08468ab3ef99d138cb5c64730bce86 Mon Sep 17 00:00:00 2001
From: "Scott R. Parish" <sparish@peak6.com>
Date: Mon, 18 Jan 2010 21:26:34 -0600
Subject: [PATCH] dropCollection

---
 Database/MongoDB.hs | 19 ++++++++++++++++---
 TODO                |  1 -
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/Database/MongoDB.hs b/Database/MongoDB.hs
index ebfeb98..ec1b60f 100644
--- a/Database/MongoDB.hs
+++ b/Database/MongoDB.hs
@@ -31,7 +31,7 @@ module Database.MongoDB
      -- * Database
      Database, MongoDBCollectionInvalid,
      ColCreateOpt(..),
-     collectionNames, createCollection,
+     collectionNames, createCollection, dropCollection,
      -- * Collection
      Collection, FieldSelector, NumToSkip, NumToReturn, Selector,
      QueryOpt(..),
@@ -124,8 +124,8 @@ colCreateOptToBson (CCOMax m) = ("max", toBson m)
 -- exists.
 createCollection :: Connection -> Collection -> [ColCreateOpt] -> IO ()
 createCollection c col opts = do
-  let db = List.takeWhile (/= '.') col
-  let col' = List.tail $ List.dropWhile (/= '.') col
+  let db = dbFromCol col
+      col' = colMinusDB col
   dbcols <- collectionNames c db
   case col `List.elem` dbcols of
     True -> throwColInvalid $ "Collection already exists: " ++ show col
@@ -146,6 +146,19 @@ createCollection c col opts = do
   _ <- dbCmd c db $ toBsonDoc cmd
   return ()
 
+dropCollection :: Connection -> Collection -> IO ()
+dropCollection c col = do
+  let db = dbFromCol col
+      col' = colMinusDB col
+  _ <- dbCmd c db $ toBsonDoc [("drop", toBson col')]
+  return ()
+
+dbFromCol :: Collection -> Database
+dbFromCol = List.takeWhile (/= '.')
+
+colMinusDB :: Collection -> Collection
+colMinusDB = List.tail . List.dropWhile (/= '.')
+
 dbCmd :: Connection -> Database -> BsonDoc -> IO BsonDoc
 dbCmd c db cmd = do
   mres <- findOne c (db ++ ".$cmd") cmd
diff --git a/TODO b/TODO
index ead6d5f..100b822 100644
--- a/TODO
+++ b/TODO
@@ -24,7 +24,6 @@ MongoDB
   - operations on database objects
     * getName
     * getCollection
-    * dropCollection
     * executeCommand
     * dropDatabase (erase)
   - database admin