Simplification of types, easier interop with other libraries

Database/MongoDB.hs

@@ -40,10 +40,10 @@ Simple example below. Use with language extensions /OvererloadedStrings/ & /Exte
 -}
 
 module Database.MongoDB (
-	module Data.Bson,
-	module Database.MongoDB.Connection,
-	module Database.MongoDB.Query,
-	module Database.MongoDB.Admin
+    module Data.Bson,
+    module Database.MongoDB.Connection,
+    module Database.MongoDB.Query,
+    module Database.MongoDB.Admin
 ) where
 
 import Data.Bson

Database/MongoDB/Admin.hs

@@ -3,34 +3,34 @@
 {-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards #-}
 
 module Database.MongoDB.Admin (
-	-- * Admin
-	-- ** Collection
-	CollectionOption(..), createCollection, renameCollection, dropCollection,
+    -- * Admin
+    -- ** Collection
+    CollectionOption(..), createCollection, renameCollection, dropCollection,
     validateCollection,
-	-- ** Index
-	Index(..), IndexName, index, ensureIndex, createIndex, dropIndex,
+    -- ** Index
+    Index(..), IndexName, index, ensureIndex, createIndex, dropIndex,
     getIndexes, dropIndexes,
-	-- ** User
-	allUsers, addUser, removeUser,
-	-- ** Database
-	admin, cloneDatabase, copyDatabase, dropDatabase, repairDatabase,
-	-- ** Server
-	serverBuildInfo, serverVersion,
-	-- * Diagnotics
-	-- ** Collection
-	collectionStats, dataSize, storageSize, totalIndexSize, totalSize,
-	-- ** Profiling
-	ProfilingLevel(..), getProfilingLevel, MilliSec, setProfilingLevel,
-	-- ** Database
-	dbStats, OpNum, currentOp, killOp,
-	-- ** Server
-	serverStatus
+    -- ** User
+    allUsers, addUser, removeUser,
+    -- ** Database
+    admin, cloneDatabase, copyDatabase, dropDatabase, repairDatabase,
+    -- ** Server
+    serverBuildInfo, serverVersion,
+    -- * Diagnotics
+    -- ** Collection
+    collectionStats, dataSize, storageSize, totalIndexSize, totalSize,
+    -- ** Profiling
+    ProfilingLevel(..), getProfilingLevel, MilliSec, setProfilingLevel,
+    -- ** Database
+    dbStats, OpNum, currentOp, killOp,
+    -- ** Server
+    serverStatus
 ) where
 
 import Prelude hiding (lookup)
 import Control.Applicative ((<$>))
 import Control.Concurrent (forkIO, threadDelay)
-import Control.Monad (forever, unless)
+import Control.Monad (forever, unless, liftM)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.Set (Set)
 import System.IO.Unsafe (unsafePerformIO)
@@ -47,7 +47,7 @@ import qualified Data.Text as T
 
 import Database.MongoDB.Connection (Host, showHostPort)
 import Database.MongoDB.Internal.Protocol (pwHash, pwKey)
-import Database.MongoDB.Internal.Util (MonadIO', (<.>), true1)
+import Database.MongoDB.Internal.Util ((<.>), true1)
 import Database.MongoDB.Query (Action, Database, Collection, Username, Password,
                                Order, Query(..), accessMode, master, runCommand,
                                useDb, thisDatabase, rest, select, find, findOne,
@@ -64,26 +64,26 @@ coptElem Capped = "capped" =: True
 coptElem (MaxByteSize n) = "size" =: n
 coptElem (MaxItems n) = "max" =: n
 
-createCollection :: (MonadIO' m) => [CollectionOption] -> Collection -> Action m Document
+createCollection :: (MonadIO m) => [CollectionOption] -> Collection -> Action m Document
 -- ^ Create collection with given options. You only need to call this to set options, otherwise a collection is created automatically on first use with no options.
 createCollection opts col = runCommand $ ["create" =: col] ++ map coptElem opts
 
-renameCollection :: (MonadIO' m) => Collection -> Collection -> Action m Document
+renameCollection :: (MonadIO m) => Collection -> Collection -> Action m Document
 -- ^ Rename first collection to second collection
 renameCollection from to = do
-	db <- thisDatabase
-	useDb admin $ runCommand ["renameCollection" =: db <.> from, "to" =: db <.> to, "dropTarget" =: True]
+    db <- thisDatabase
+    useDb admin $ runCommand ["renameCollection" =: db <.> from, "to" =: db <.> to, "dropTarget" =: True]
 
-dropCollection :: (MonadIO' m) => Collection -> Action m Bool
+dropCollection :: (MonadIO m) => Collection -> Action m Bool
 -- ^ Delete the given collection! Return True if collection existed (and was deleted); return False if collection did not exist (and no action).
 dropCollection coll = do
-	resetIndexCache
-	r <- runCommand ["drop" =: coll]
-	if true1 "ok" r then return True else do
-		if at "errmsg" r == ("ns not found" :: Text) then return False else
-			fail $ "dropCollection failed: " ++ show r
+    resetIndexCache
+    r <- runCommand ["drop" =: coll]
+    if true1 "ok" r then return True else do
+        if at "errmsg" r == ("ns not found" :: Text) then return False else
+            fail $ "dropCollection failed: " ++ show r
 
-validateCollection :: (MonadIO' m) => Collection -> Action m Document
+validateCollection :: (MonadIO m) => Collection -> Action m Document
 -- ^ This operation takes a while
 validateCollection coll = runCommand ["validate" =: coll]
 
@@ -92,59 +92,59 @@ validateCollection coll = runCommand ["validate" =: coll]
 type IndexName = Text
 
 data Index = Index {
-	iColl :: Collection,
-	iKey :: Order,
-	iName :: IndexName,
-	iUnique :: Bool,
-	iDropDups :: Bool
-	} deriving (Show, Eq)
+    iColl :: Collection,
+    iKey :: Order,
+    iName :: IndexName,
+    iUnique :: Bool,
+    iDropDups :: Bool
+    } deriving (Show, Eq)
 
 idxDocument :: Index -> Database -> Document
 idxDocument Index{..} db = [
-	"ns" =: db <.> iColl,
-	"key" =: iKey,
-	"name" =: iName,
-	"unique" =: iUnique,
-	"dropDups" =: iDropDups ]
+    "ns" =: db <.> iColl,
+    "key" =: iKey,
+    "name" =: iName,
+    "unique" =: iUnique,
+    "dropDups" =: iDropDups ]
 
 index :: Collection -> Order -> Index
 -- ^ Spec of index of ordered keys on collection. Name is generated from keys. Unique and dropDups are False.
 index coll keys = Index coll keys (genName keys) False False
 
 genName :: Order -> IndexName
 genName keys = T.intercalate "_" (map f keys)  where
-	f (k := v) = k `T.append` "_" `T.append` T.pack (show v)
+    f (k := v) = k `T.append` "_" `T.append` T.pack (show v)
 
-ensureIndex :: (MonadIO' m) => Index -> Action m ()
+ensureIndex :: (MonadIO m) => Index -> Action m ()
 -- ^ Create index if we did not already create one. May be called repeatedly with practically no performance hit, because we remember if we already called this for the same index (although this memory gets wiped out every 15 minutes, in case another client drops the index and we want to create it again).
 ensureIndex idx = let k = (iColl idx, iName idx) in do
-	icache <- fetchIndexCache
-	set <- liftIO (readIORef icache)
-	unless (Set.member k set) $ do
-		accessMode master (createIndex idx)
-		liftIO $ writeIORef icache (Set.insert k set)
+    icache <- fetchIndexCache
+    set <- liftIO (readIORef icache)
+    unless (Set.member k set) $ do
+        accessMode master (createIndex idx)
+        liftIO $ writeIORef icache (Set.insert k set)
 
-createIndex :: (MonadIO' m) => Index -> Action m ()
+createIndex :: (MonadIO m) => Index -> Action m ()
 -- ^ Create index on the server. This call goes to the server every time.
 createIndex idx = insert_ "system.indexes" . idxDocument idx =<< thisDatabase
 
-dropIndex :: (MonadIO' m) => Collection -> IndexName -> Action m Document
+dropIndex :: (MonadIO m) => Collection -> IndexName -> Action m Document
 -- ^ Remove the index
 dropIndex coll idxName = do
-	resetIndexCache
-	runCommand ["deleteIndexes" =: coll, "index" =: idxName]
+    resetIndexCache
+    runCommand ["deleteIndexes" =: coll, "index" =: idxName]
 
 getIndexes :: (MonadIO m, MonadBaseControl IO m, Functor m) => Collection -> Action m [Document]
 -- ^ Get all indexes on this collection
 getIndexes coll = do
-	db <- thisDatabase
-	rest =<< find (select ["ns" =: db <.> coll] "system.indexes")
+    db <- thisDatabase
+    rest =<< find (select ["ns" =: db <.> coll] "system.indexes")
 
-dropIndexes :: (MonadIO' m) => Collection -> Action m Document
+dropIndexes :: (MonadIO m) => Collection -> Action m Document
 -- ^ Drop all indexes on this collection
 dropIndexes coll = do
-	resetIndexCache
-	runCommand ["deleteIndexes" =: coll, "index" =: ("*" :: Text)]
+    resetIndexCache
+    runCommand ["deleteIndexes" =: coll, "index" =: ("*" :: Text)]
 
 -- *** Index cache
 
@@ -156,48 +156,48 @@ type IndexCache = IORef (Set (Collection, IndexName))
 dbIndexCache :: DbIndexCache
 -- ^ initialize cache and fork thread that clears it every 15 minutes
 dbIndexCache = unsafePerformIO $ do
-	table <- H.new
-	_ <- forkIO . forever $ threadDelay 900000000 >> clearDbIndexCache
-	return table
+    table <- H.new
+    _ <- forkIO . forever $ threadDelay 900000000 >> clearDbIndexCache
+    return table
 {-# NOINLINE dbIndexCache #-}
 
 clearDbIndexCache :: IO ()
 clearDbIndexCache = do
-	keys <- map fst <$> H.toList dbIndexCache
-	mapM_ (H.delete dbIndexCache) keys
+    keys <- map fst <$> H.toList dbIndexCache
+    mapM_ (H.delete dbIndexCache) keys
 
 fetchIndexCache :: (MonadIO m) => Action m IndexCache
 -- ^ Get index cache for current database
 fetchIndexCache = do
-	db <- thisDatabase
-	liftIO $ do
-		mc <- H.lookup dbIndexCache db
-		maybe (newIdxCache db) return mc
+    db <- thisDatabase
+    liftIO $ do
+        mc <- H.lookup dbIndexCache db
+        maybe (newIdxCache db) return mc
  where
-	newIdxCache db = do
-		idx <- newIORef Set.empty
-		H.insert dbIndexCache db idx
-		return idx
+    newIdxCache db = do
+        idx <- newIORef Set.empty
+        H.insert dbIndexCache db idx
+        return idx
 
 resetIndexCache :: (MonadIO m) => Action m ()
 -- ^ reset index cache for current database
 resetIndexCache = do
-	icache <- fetchIndexCache
-	liftIO (writeIORef icache Set.empty)
+    icache <- fetchIndexCache
+    liftIO (writeIORef icache Set.empty)
 
 -- ** User
 
 allUsers :: (MonadIO m, MonadBaseControl IO m, Functor m) => Action m [Document]
 -- ^ Fetch all users of this database
 allUsers = map (exclude ["_id"]) <$> (rest =<< find
-	(select [] "system.users") {sort = ["user" =: (1 :: Int)], project = ["user" =: (1 :: Int), "readOnly" =: (1 :: Int)]})
+    (select [] "system.users") {sort = ["user" =: (1 :: Int)], project = ["user" =: (1 :: Int), "readOnly" =: (1 :: Int)]})
 
-addUser :: (MonadIO' m) => Bool -> Username -> Password -> Action m ()
+addUser :: (MonadIO m) => Bool -> Username -> Password -> Action m ()
 -- ^ Add user with password with read-only access if bool is True or read-write access if bool is False
 addUser readOnly user pass = do
-	mu <- findOne (select ["user" =: user] "system.users")
-	let usr = merge ["readOnly" =: readOnly, "pwd" =: pwHash user pass] (maybe ["user" =: user] id mu)
-	save "system.users" usr
+    mu <- findOne (select ["user" =: user] "system.users")
+    let usr = merge ["readOnly" =: readOnly, "pwd" =: pwHash user pass] (maybe ["user" =: user] id mu)
+    save "system.users" usr
 
 removeUser :: (MonadIO m) => Username -> Action m ()
 removeUser user = delete (select ["user" =: user] "system.users")
@@ -208,76 +208,76 @@ admin :: Database
 -- ^ \"admin\" database
 admin = "admin"
 
-cloneDatabase :: (MonadIO' m) => Database -> Host -> Action m Document
+cloneDatabase :: (MonadIO m) => Database -> Host -> Action m Document
 -- ^ Copy database from given host to the server I am connected to. Fails and returns @"ok" = 0@ if we don't have permission to read from given server (use copyDatabase in this case).
 cloneDatabase db fromHost = useDb db $ runCommand ["clone" =: showHostPort fromHost]
 
-copyDatabase :: (MonadIO' m) => Database -> Host -> Maybe (Username, Password) -> Database -> Action m Document
+copyDatabase :: (MonadIO m) => Database -> Host -> Maybe (Username, Password) -> Database -> Action m Document
 -- ^ Copy database from given host to the server I am connected to. If username & password is supplied use them to read from given host.
 copyDatabase fromDb fromHost mup toDb = do
-	let c = ["copydb" =: (1 :: Int), "fromhost" =: showHostPort fromHost, "fromdb" =: fromDb, "todb" =: toDb]
-	useDb admin $ case mup of
-		Nothing -> runCommand c
-		Just (usr, pss) -> do
-			n <- at "nonce" <$> runCommand ["copydbgetnonce" =: (1 :: Int), "fromhost" =: showHostPort fromHost]
-			runCommand $ c ++ ["username" =: usr, "nonce" =: n, "key" =: pwKey n usr pss]
-
-dropDatabase :: (MonadIO' m) => Database -> Action m Document
+    let c = ["copydb" =: (1 :: Int), "fromhost" =: showHostPort fromHost, "fromdb" =: fromDb, "todb" =: toDb]
+    useDb admin $ case mup of
+        Nothing -> runCommand c
+        Just (usr, pss) -> do
+            n <- at "nonce" `liftM` runCommand ["copydbgetnonce" =: (1 :: Int), "fromhost" =: showHostPort fromHost]
+            runCommand $ c ++ ["username" =: usr, "nonce" =: n, "key" =: pwKey n usr pss]
+
+dropDatabase :: (MonadIO m) => Database -> Action m Document
 -- ^ Delete the given database!
 dropDatabase db = useDb db $ runCommand ["dropDatabase" =: (1 :: Int)]
 
-repairDatabase :: (MonadIO' m) => Database -> Action m Document
+repairDatabase :: (MonadIO m) => Database -> Action m Document
 -- ^ Attempt to fix any corrupt records. This operation takes a while.
 repairDatabase db = useDb db $ runCommand ["repairDatabase" =: (1 :: Int)]
 
 -- ** Server
 
-serverBuildInfo :: (MonadIO' m) => Action m Document
+serverBuildInfo :: (MonadIO m) => Action m Document
 serverBuildInfo = useDb admin $ runCommand ["buildinfo" =: (1 :: Int)]
 
-serverVersion :: (MonadIO' m) => Action m Text
-serverVersion = at "version" <$> serverBuildInfo
+serverVersion :: (MonadIO m) => Action m Text
+serverVersion = at "version" `liftM` serverBuildInfo
 
 -- * Diagnostics
 
 -- ** Collection
 
-collectionStats :: (MonadIO' m) => Collection -> Action m Document
+collectionStats :: (MonadIO m) => Collection -> Action m Document
 collectionStats coll = runCommand ["collstats" =: coll]
 
-dataSize :: (MonadIO' m) => Collection -> Action m Int
-dataSize c = at "size" <$> collectionStats c
+dataSize :: (MonadIO m) => Collection -> Action m Int
+dataSize c = at "size" `liftM` collectionStats c
 
-storageSize :: (MonadIO' m) => Collection -> Action m Int
-storageSize c = at "storageSize" <$> collectionStats c
+storageSize :: (MonadIO m) => Collection -> Action m Int
+storageSize c = at "storageSize" `liftM` collectionStats c
 
-totalIndexSize :: (MonadIO' m) => Collection -> Action m Int
-totalIndexSize c = at "totalIndexSize" <$> collectionStats c
+totalIndexSize :: (MonadIO m) => Collection -> Action m Int
+totalIndexSize c = at "totalIndexSize" `liftM` collectionStats c
 
-totalSize :: (MonadIO m, MonadBaseControl IO m, MonadIO' m) => Collection -> Action m Int
+totalSize :: (MonadIO m, MonadBaseControl IO m) => Collection -> Action m Int
 totalSize coll = do
-	x <- storageSize coll
-	xs <- mapM isize =<< getIndexes coll
-	return (foldl (+) x xs)
+    x <- storageSize coll
+    xs <- mapM isize =<< getIndexes coll
+    return (foldl (+) x xs)
  where
-	isize idx = at "storageSize" <$> collectionStats (coll `T.append` ".$" `T.append` at "name" idx)
+    isize idx = at "storageSize" `liftM` collectionStats (coll `T.append` ".$" `T.append` at "name" idx)
 
 -- ** Profiling
 
 data ProfilingLevel = Off | Slow | All  deriving (Show, Enum, Eq)
 
-getProfilingLevel :: (MonadIO' m) => Action m ProfilingLevel
-getProfilingLevel = toEnum . at "was" <$> runCommand ["profile" =: (-1 :: Int)]
+getProfilingLevel :: (MonadIO m) => Action m ProfilingLevel
+getProfilingLevel = (toEnum . at "was") `liftM` runCommand ["profile" =: (-1 :: Int)]
 
 type MilliSec = Int
 
-setProfilingLevel :: (MonadIO' m) => ProfilingLevel -> Maybe MilliSec -> Action m ()
+setProfilingLevel :: (MonadIO m) => ProfilingLevel -> Maybe MilliSec -> Action m ()
 setProfilingLevel p mSlowMs =
-	runCommand (["profile" =: fromEnum p] ++ ("slowms" =? mSlowMs)) >> return ()
+    runCommand (["profile" =: fromEnum p] ++ ("slowms" =? mSlowMs)) >> return ()
 
 -- ** Database
 
-dbStats :: (MonadIO' m) => Action m Document
+dbStats :: (MonadIO m) => Action m Document
 dbStats = runCommand ["dbstats" =: (1 :: Int)]
 
 currentOp :: (MonadIO m) => Action m (Maybe Document)
@@ -291,7 +291,7 @@ killOp op = findOne (select ["op" =: op] "$cmd.sys.killop")
 
 -- ** Server
 
-serverStatus :: (MonadIO' m) => Action m Document
+serverStatus :: (MonadIO m) => Action m Document
 serverStatus = useDb admin $ runCommand ["serverStatus" =: (1 :: Int)]