From 5ae3c4c2ae657e88d3e81021ee1cc17065329088 Mon Sep 17 00:00:00 2001
From: "Scott R. Parish" <sparish@peak6.com>
Date: Fri, 22 Jan 2010 06:23:39 -0600
Subject: [PATCH] databasesInfo, databaseNames

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

diff --git a/Database/MongoDB.hs b/Database/MongoDB.hs
index b1caf62..4b5b89f 100644
--- a/Database/MongoDB.hs
+++ b/Database/MongoDB.hs
@@ -29,6 +29,7 @@ module Database.MongoDB
      Connection,
      connect, connectOnPort, conClose, disconnect, dropDatabase,
      serverInfo,
+     databasesInfo, databaseNames,
      -- * Database
      Database, MongoDBCollectionInvalid,
      ColCreateOpt(..),
@@ -63,6 +64,7 @@ import qualified Data.ByteString.Lazy.UTF8 as L8
 import Data.Int
 import Data.IORef
 import qualified Data.List as List
+import qualified Data.Map as Map
 import Data.Maybe
 import Data.Typeable
 import Database.MongoDB.BSON as BSON
@@ -96,6 +98,19 @@ connectOnPort host port = do
 conClose :: Connection -> IO ()
 conClose = hClose . cHandle
 
+-- | Information about the databases on the server.
+databasesInfo :: Connection -> IO BsonDoc
+databasesInfo c = do
+    runCommand c (s2L "admin") $ toBsonDoc [("listDatabases", toBson (1::Int))]
+
+-- | Return a list of database names on the server.
+databaseNames :: Connection -> IO [Database]
+databaseNames c = do
+    info <- databasesInfo c
+    let (BsonArray dbs) = fromJust $ Map.lookup (s2L "databases") info
+        names = catMaybes $ List.map (Map.lookup (s2L "name") . fromBson) dbs
+    return $ List.map fromBson (names::[BsonValue])
+
 -- | Alias for 'conClose'
 disconnect :: Connection -> IO ()
 disconnect = conClose