expose runCommand

This commit is contained in:
Scott R. Parish 2010-01-19 06:31:59 -06:00
parent 45b9be608e
commit bff4817970

View file

@ -32,7 +32,8 @@ module Database.MongoDB
-- * Database -- * Database
Database, MongoDBCollectionInvalid, Database, MongoDBCollectionInvalid,
ColCreateOpt(..), ColCreateOpt(..),
collectionNames, createCollection, dropCollection, validateCollection, collectionNames, createCollection, dropCollection,
runCommand, validateCollection,
-- * Collection -- * Collection
Collection, FieldSelector, FullCollection, Collection, FieldSelector, FullCollection,
NumToSkip, NumToReturn, Selector, NumToSkip, NumToReturn, Selector,
@ -98,7 +99,7 @@ disconnect = conClose
-- | Drop a database. -- | Drop a database.
dropDatabase :: Connection -> Database -> IO () dropDatabase :: Connection -> Database -> IO ()
dropDatabase c db = do dropDatabase c db = do
_ <- dbCmd c db $ toBsonDoc [("dropDatabase", toBson (1::Int))] _ <- runCommand c db $ toBsonDoc [("dropDatabase", toBson (1::Int))]
return () return ()
-- | Return a list of collections in /Database/. -- | Return a list of collections in /Database/.
@ -150,14 +151,14 @@ createCollection c col opts = do
"Collection can't start or end with '.': " ++ show col "Collection can't start or end with '.': " ++ show col
False -> return () False -> return ()
let cmd = ("create", toBson col') : List.map colCreateOptToBson opts let cmd = ("create", toBson col') : List.map colCreateOptToBson opts
_ <- dbCmd c db $ toBsonDoc cmd _ <- runCommand c db $ toBsonDoc cmd
return () return ()
-- | Drop a collection. -- | Drop a collection.
dropCollection :: Connection -> FullCollection -> IO () dropCollection :: Connection -> FullCollection -> IO ()
dropCollection c col = do dropCollection c col = do
let (db, col') = splitFullCol col let (db, col') = splitFullCol col
_ <- dbCmd c db $ toBsonDoc [("drop", toBson col')] _ <- runCommand c db $ toBsonDoc [("drop", toBson col')]
return () return ()
-- | Return a string of validation info about the collection. -- | Return a string of validation info about the collection.
@ -186,15 +187,18 @@ dropCollection c col = do
validateCollection :: Connection -> FullCollection -> IO String validateCollection :: Connection -> FullCollection -> IO String
validateCollection c col = do validateCollection c col = do
let (db, col') = splitFullCol col let (db, col') = splitFullCol col
res <- dbCmd c db $ toBsonDoc [("validate", toBson col')] res <- runCommand c db $ toBsonDoc [("validate", toBson col')]
return $ fromBson $ fromJust $ BSON.lookup "result" res return $ fromBson $ fromJust $ BSON.lookup "result" res
splitFullCol :: FullCollection -> (Database, Collection) splitFullCol :: FullCollection -> (Database, Collection)
splitFullCol col = (List.takeWhile (/= '.') col, splitFullCol col = (List.takeWhile (/= '.') col,
List.tail $ List.dropWhile (/= '.') col) List.tail $ List.dropWhile (/= '.') col)
dbCmd :: Connection -> Database -> BsonDoc -> IO BsonDoc -- | Run a database command. Usually this is unneeded as driver wraps
dbCmd c db cmd = do -- all of the commands for you (eg 'createCollection',
-- 'dropCollection', etc).
runCommand :: Connection -> Database -> BsonDoc -> IO BsonDoc
runCommand c db cmd = do
mres <- findOne c (db ++ ".$cmd") cmd mres <- findOne c (db ++ ".$cmd") cmd
let res = fromJust mres let res = fromJust mres
case fromBson $ fromJust $ BSON.lookup "ok" res :: Int of case fromBson $ fromJust $ BSON.lookup "ok" res :: Int of
@ -358,8 +362,8 @@ count c col = countMatching c col BSON.empty
countMatching :: Connection -> FullCollection -> Selector -> IO Int64 countMatching :: Connection -> FullCollection -> Selector -> IO Int64
countMatching c col sel = do countMatching c col sel = do
let (db, col') = splitFullCol col let (db, col') = splitFullCol col
res <- dbCmd c db $ toBsonDoc [("count", toBson col'), res <- runCommand c db $ toBsonDoc [("count", toBson col'),
("query", BsonObject sel)] ("query", BsonObject sel)]
return $ fromBson $ fromJust $ BSON.lookup "n" res return $ fromBson $ fromJust $ BSON.lookup "n" res
-- | Delete documents matching /Selector/ from the given /FullCollection/. -- | Delete documents matching /Selector/ from the given /FullCollection/.