From e8f6141529be1b2fd6526b0fb5e3bc75cbde6bd5 Mon Sep 17 00:00:00 2001
From: "Scott R. Parish" <sparish@peak6.com>
Date: Thu, 21 Jan 2010 19:12:06 -0600
Subject: [PATCH] renameCollection

---
 Database/MongoDB.hs | 43 +++++++++++++++++++++++++++++--------------
 TODO                |  1 -
 2 files changed, 29 insertions(+), 15 deletions(-)

diff --git a/Database/MongoDB.hs b/Database/MongoDB.hs
index 14ef6d4..b930cd5 100644
--- a/Database/MongoDB.hs
+++ b/Database/MongoDB.hs
@@ -33,7 +33,7 @@ module Database.MongoDB
      Database, MongoDBCollectionInvalid,
      ColCreateOpt(..),
      collectionNames, createCollection, dropCollection,
-     runCommand, validateCollection,
+     renameCollection, runCommand, validateCollection,
      -- * Collection
      Collection, FieldSelector, FullCollection,
      NumToSkip, NumToReturn, Selector,
@@ -137,23 +137,11 @@ colCreateOptToBson (CCOMax m) = ("max", toBson m)
 -- exists.
 createCollection :: Connection -> FullCollection -> [ColCreateOpt] -> IO ()
 createCollection c col opts = do
-  let (db, col') = splitFullCol col
+  (db, col') <- validateCollectionName col
   dbcols <- collectionNames c db
   case col `List.elem` dbcols of
     True -> throwColInvalid $ "Collection already exists: " ++ show col
     False -> return ()
-  case s2L ".." `List.elem` (L.group col) of
-    True -> throwColInvalid $ "Collection can't contain \"..\": " ++ show col
-    False -> return ()
-  case (c2w '$') `L.elem` col &&
-       not (s2L "oplog.$mail" `L.isPrefixOf` col' ||
-            s2L "$cmd" `L.isPrefixOf` col') of
-    True -> throwColInvalid $ "Collection can't contain '$': " ++ show col
-    False -> return ()
-  case L.head col == (c2w '.') || L.last col == (c2w '.') of
-    True -> throwColInvalid $
-            "Collection can't start or end with '.': " ++ show col
-    False -> return ()
   let cmd = ("create", toBson col') : List.map colCreateOptToBson opts
   _ <- runCommand c db $ toBsonDoc cmd
   return ()
@@ -165,6 +153,16 @@ dropCollection c col = do
   _ <- runCommand c db $ toBsonDoc [("drop", toBson col')]
   return ()
 
+-- | Rename a collection--first /FullCollection/ argument is the
+-- existing name, the second is the new name. At the moment this command
+-- can also be used to move a collection between databases.
+renameCollection :: Connection -> FullCollection -> FullCollection -> IO ()
+renameCollection c col newName = do
+  _ <- validateCollectionName col
+  _ <- runCommand c (s2L "admin") $ toBsonDoc [("renameCollection", toBson col),
+                                               ("to", toBson newName)]
+  return ()
+
 -- | Return a string of validation info about the collection.
 --
 -- Example output (note this probably can/will change with different
@@ -708,3 +706,20 @@ randNum Connection { cRand = nsRef } = atomicModifyIORef nsRef $ \ns ->
 
 s2L :: String -> L8.ByteString
 s2L = L8.fromString
+
+validateCollectionName :: FullCollection -> IO (Database, Collection)
+validateCollectionName col = do
+  let (db, col') = splitFullCol col
+  case s2L ".." `List.elem` (L.group col) of
+    True -> throwColInvalid $ "Collection can't contain \"..\": " ++ show col
+    False -> return ()
+  case (c2w '$') `L.elem` col &&
+       not (s2L "oplog.$mail" `L.isPrefixOf` col' ||
+            s2L "$cmd" `L.isPrefixOf` col') of
+    True -> throwColInvalid $ "Collection can't contain '$': " ++ show col
+    False -> return ()
+  case L.head col == (c2w '.') || L.last col == (c2w '.') of
+    True -> throwColInvalid $
+            "Collection can't start or end with '.': " ++ show col
+    False -> return ()
+  return (db, col')
diff --git a/TODO b/TODO
index 795670b..9c9996c 100644
--- a/TODO
+++ b/TODO
@@ -43,7 +43,6 @@ MongoDB
     * modify
     * replace
     * repsert
-    * rename
   - index operations
     * ensureIndex / index existance caching
   - misc operations