From d7f6cfc3484dac9cddd023b8b6a15d52082072c7 Mon Sep 17 00:00:00 2001
From: "Scott R. Parish" <sparish@peak6.com>
Date: Mon, 18 Jan 2010 21:39:38 -0600
Subject: [PATCH] validateCollection

---
 Database/MongoDB.hs | 9 ++++++++-
 TODO                | 1 -
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/Database/MongoDB.hs b/Database/MongoDB.hs
index ad90c71..3089fb1 100644
--- a/Database/MongoDB.hs
+++ b/Database/MongoDB.hs
@@ -32,7 +32,7 @@ module Database.MongoDB
      -- * Database
      Database, MongoDBCollectionInvalid,
      ColCreateOpt(..),
-     collectionNames, createCollection, dropCollection,
+     collectionNames, createCollection, dropCollection, validateCollection,
      -- * Collection
      Collection, FieldSelector, NumToSkip, NumToReturn, Selector,
      QueryOpt(..),
@@ -160,6 +160,13 @@ dropCollection c col = do
   _ <- dbCmd c db $ toBsonDoc [("drop", toBson col')]
   return ()
 
+validateCollection :: Connection -> Collection -> IO String
+validateCollection c col = do
+  let db = dbFromCol col
+      col' = colMinusDB col
+  res <- dbCmd c db $ toBsonDoc [("validate", toBson col')]
+  return $ fromBson $ fromJust $ BSON.lookup "result" res
+
 dbFromCol :: Collection -> Database
 dbFromCol = List.takeWhile (/= '.')
 
diff --git a/TODO b/TODO
index 348c097..4179c5d 100644
--- a/TODO
+++ b/TODO
@@ -38,7 +38,6 @@ MongoDB
     * getProfilingLevel
     * setProfilingLevel
     * getProfilingInfo
-    * validateCollection
   - collection
     * modify
     * replace