Remove MonadIO'

Database/MongoDB/Admin.hs

@@ -30,7 +30,7 @@ module Database.MongoDB.Admin (
 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,17 +64,17 @@ 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]
 
-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
@@ -83,7 +83,7 @@ dropCollection coll = 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]
 
@@ -115,7 +115,7 @@ genName :: Order -> IndexName
 genName keys = T.intercalate "_" (map f keys)  where
     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
@@ -124,11 +124,11 @@ ensureIndex idx = let k = (iColl idx, iName idx) in 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
@@ -140,7 +140,7 @@ getIndexes coll = do
     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
@@ -192,7 +192,7 @@ allUsers :: (MonadIO m, MonadBaseControl IO m, Functor m) => Action m [Document]
 allUsers = map (exclude ["_id"]) <$> (rest =<< find
     (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")
@@ -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]
+            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
+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)
  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 ()
 
 -- ** 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)]
 
 

Database/MongoDB/Internal/Util.hs

@@ -7,7 +7,7 @@
 
 module Database.MongoDB.Internal.Util where
 
-import Control.Applicative (Applicative(..), (<$>))
+import Control.Applicative ((<$>))
 import Control.Exception (assert, handle, throwIO, Exception)
 import Control.Monad (liftM, liftM2)
 import Data.Bits (Bits, (.|.))
@@ -35,10 +35,6 @@ deriving instance Eq PortID
 #endif
 deriving instance Ord PortID
 
--- | MonadIO with extra Applicative and Functor superclasses
-class (MonadIO m, Applicative m, Functor m) => MonadIO' m
-instance (MonadIO m, Applicative m, Functor m) => MonadIO' m
-
 -- | A monadic sort implementation derived from the non-monadic one in ghc's Prelude
 mergesortM :: Monad m => (a -> a -> m Ordering) -> [a] -> m [a]
 mergesortM cmp = mergesortM' cmp . map wrap