expose runCommand
This commit is contained in:
parent
45b9be608e
commit
bff4817970
1 changed files with 13 additions and 9 deletions
|
@ -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,7 +362,7 @@ 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
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue