Fix MonadIO mess

Language/Haskell/GhcMod/CaseSplit.hs

@@ -195,7 +195,8 @@ showFieldNames dflag style v (x:xs) = let fName = showName dflag style x
 ----------------------------------------------------------------
 -- c. Code for performing the case splitting
 
-genCaseSplitTextFile :: GhcMonad m => FilePath -> SplitToTextInfo -> m String
+genCaseSplitTextFile :: (MonadIO m, GhcMonad m) =>
+    FilePath -> SplitToTextInfo -> m String
 genCaseSplitTextFile file info = liftIO $ do
   t <- T.readFile file
   return $ getCaseSplitText (T.lines t) info

Language/Haskell/GhcMod/Error.hs

@@ -49,7 +49,6 @@ import Config (cProjectVersion, cHostPlatformString)
 import Paths_ghc_mod (version)
 
 import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.Pretty
 
 type GmError m = MonadError GhcModError m

Language/Haskell/GhcMod/FillSig.hs

@@ -167,7 +167,8 @@ getSignature modSum lineNo colNo = do
                       return $ InstanceDecl loc cls
 
 -- Get signature from haskell-src-exts
-getSignatureFromHE :: GhcMonad m => FilePath -> Int -> Int -> m (Maybe HESigInfo)
+getSignatureFromHE :: (MonadIO m, GhcMonad m) =>
+    FilePath -> Int -> Int -> m (Maybe HESigInfo)
 getSignatureFromHE file lineNo colNo = do
   presult <- liftIO $ HE.parseFile file
   return $ case presult of

Language/Haskell/GhcMod/HomeModuleGraph.hs

@@ -36,9 +36,9 @@ import Exception
 import Finder
 import GHC
 import HscTypes
-import MonadUtils hiding (foldrM)
 
 import Control.Arrow ((&&&))
+import Control.Applicative ((<$>))
 import Control.Monad
 import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
 import Control.Monad.State.Strict (execStateT)

Language/Haskell/GhcMod/Logger.hs

@@ -2,6 +2,7 @@ module Language.Haskell.GhcMod.Logger (
     withLogger
   , withLogger'
   , checkErrorPrefix
+  , errsToStr
   ) where
 
 import Control.Arrow
@@ -96,10 +97,10 @@ withLogger' env action = do
 
 -- | Converting 'SourceError' to 'String'.
 sourceError :: DynFlags -> PprStyle -> SourceError -> [String]
-sourceError df st src_err = errBagToStrList df st $ srcErrorMessages src_err
+sourceError df st src_err = errsToStr df st $ reverse $ bagToList $ srcErrorMessages src_err
 
-errBagToStrList :: DynFlags -> PprStyle -> Bag ErrMsg -> [String]
+errsToStr :: DynFlags -> PprStyle -> [ErrMsg] -> [String]
-errBagToStrList df st = map (ppErrMsg df st) . reverse . bagToList
+errsToStr df st = map (ppErrMsg df st)
 
 ----------------------------------------------------------------
 

Language/Haskell/GhcMod/Monad/Types.hs

@@ -78,6 +78,7 @@ import Control.Monad.Reader (ReaderT(..))
 import Control.Monad.Error (ErrorT(..), MonadError(..))
 import Control.Monad.State.Strict (StateT(..))
 import Control.Monad.Trans.Journal (JournalT)
+import Control.Monad.Trans.Maybe (MaybeT)
 
 import Control.Monad.Base (MonadBase(..), liftBase)
 import Control.Monad.Trans.Control
@@ -87,14 +88,10 @@ import Control.Monad.Writer.Class
 import Control.Monad.State.Class (MonadState(..))
 import Control.Monad.Journal.Class (MonadJournal(..))
 import Control.Monad.Trans.Class (MonadTrans(..))
-
-#ifdef MONADIO_INSTANCES
-import Control.Monad.Trans.Maybe (MaybeT)
 import Control.Monad.Error (Error(..))
-#endif
+import qualified Control.Monad.IO.Class as MTL
 
 #if DIFFERENT_MONADIO
-import qualified Control.Monad.IO.Class
 import Data.Monoid (Monoid)
 #endif
 
@@ -105,7 +102,7 @@ import Data.Monoid
 import Data.IORef
 import Distribution.Helper
 
-import MonadUtils (MonadIO(..))
+import qualified MonadUtils as GHC (MonadIO(..))
 
 data GhcModEnv = GhcModEnv {
       gmOptions    :: Options
@@ -159,8 +156,9 @@ newtype GhcModT m a = GhcModT {
                , Alternative
                , Monad
                , MonadPlus
+               , MTL.MonadIO
 #if DIFFERENT_MONADIO
-               , Control.Monad.IO.Class.MonadIO
+               , GHC.MonadIO
 #endif
                , MonadError GhcModError
                )
@@ -172,9 +170,9 @@ newtype GmlT m a = GmlT { unGmlT :: GhcModT m a }
              , Monad
              , MonadPlus
              , MonadTrans
-             , MonadIO
+             , MTL.MonadIO
 #if DIFFERENT_MONADIO
-             , Control.Monad.IO.Class.MonadIO
+             , GHC.MonadIO
 #endif
              , MonadError GhcModError
              , GmEnv
@@ -186,12 +184,43 @@ newtype LightGhc a = LightGhc { unLightGhc :: ReaderT (IORef HscEnv) IO a }
     deriving ( Functor
              , Applicative
              , Monad
-             , MonadIO
+             , MTL.MonadIO
 #if DIFFERENT_MONADIO
-             , Control.Monad.IO.Class.MonadIO
+             , GHC.MonadIO
 #endif
              )
 
+#if DIFFERENT_MONADIO
+instance MTL.MonadIO m => GHC.MonadIO (ReaderT x m) where
+    liftIO = MTL.liftIO
+instance MTL.MonadIO m => GHC.MonadIO (StateT x m) where
+    liftIO = MTL.liftIO
+instance (Error e, MTL.MonadIO m) => GHC.MonadIO (ErrorT e m) where
+    liftIO = MTL.liftIO
+instance MTL.MonadIO m => GHC.MonadIO (JournalT x m) where
+    liftIO = MTL.liftIO
+instance MTL.MonadIO m => GHC.MonadIO (MaybeT m) where
+    liftIO = MTL.liftIO
+#endif
+
+instance MonadIO IO where
+    liftIO = id
+instance MonadIO m => MonadIO (ReaderT x m) where
+    liftIO = MTL.liftIO
+instance MonadIO m => MonadIO (StateT x m) where
+    liftIO = MTL.liftIO
+instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
+    liftIO = MTL.liftIO
+instance MonadIO m => MonadIO (JournalT x m) where
+    liftIO = MTL.liftIO
+instance MonadIO m => MonadIO (MaybeT m) where
+    liftIO = MTL.liftIO
+instance MonadIOC m => MonadIO (GhcModT m) where
+    liftIO = MTL.liftIO
+instance MonadIOC m => MonadIO (GmlT m) where
+    liftIO = MTL.liftIO
+instance MonadIO LightGhc where
+    liftIO = MTL.liftIO
 
 class Monad m => GmEnv m where
     gmeAsk :: m GhcModEnv
@@ -263,9 +292,6 @@ instance (Monad m, GmLog m) => GmLog (StateT s m) where
     gmlHistory = lift gmlHistory
     gmlClear = lift gmlClear
 
-instance MonadIO m => MonadIO (GhcModT m) where
-    liftIO action = GhcModT $ liftIO action
-
 instance Monad m => MonadJournal GhcModLog (GhcModT m) where
   journal !w = GhcModT $ lift $ lift $ (journal w)
   history    = GhcModT $ lift $ lift $ history
@@ -291,23 +317,6 @@ instance MonadState s m => MonadState s (GhcModT m) where
     put = GhcModT . lift . lift . lift . put
     state = GhcModT . lift . lift . lift . state
 
-#if MONADIO_INSTANCES
-instance MonadIO m => MonadIO (StateT s m) where
-    liftIO = lift . liftIO
-
-instance MonadIO m => MonadIO (ReaderT r m) where
-    liftIO = lift . liftIO
-
-instance (Monoid w, MonadIO m) => MonadIO (JournalT w m) where
-    liftIO = lift . liftIO
-
-instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
-    liftIO = lift . liftIO
-
-instance MonadIO m => MonadIO (MaybeT m) where
-    liftIO = lift . liftIO
-#endif
-
 instance (MonadBaseControl IO m) => MonadBase IO (GmlT m) where
     liftBase = GmlT . liftBase
 
@@ -370,14 +379,14 @@ type GmGhc m = (IOish m, GhcMonad m)
 instance (MonadIO m, MonadBaseControl IO m) => GhcMonad (GmlT m) where
     getSession = do
         ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
-        liftIO $ readIORef ref
+        GHC.liftIO $ readIORef ref
     setSession a = do
         ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
-        liftIO $ flip writeIORef a ref
+        GHC.liftIO $ flip writeIORef a ref
 
 instance GhcMonad LightGhc where
-    getSession = (liftIO . readIORef) =<< LightGhc ask
+    getSession = (GHC.liftIO . readIORef) =<< LightGhc ask
-    setSession a = (liftIO . flip writeIORef a) =<< LightGhc ask
+    setSession a = (GHC.liftIO . flip writeIORef a) =<< LightGhc ask
 
 #if __GLASGOW_HASKELL__ >= 706
 instance (MonadIO m, MonadBaseControl IO m) => HasDynFlags (GmlT m) where

Language/Haskell/GhcMod/Types.hs

@@ -1,5 +1,5 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveGeneric, StandaloneDeriving,
+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveGeneric,
-             DefaultSignatures #-}
+  StandaloneDeriving, DefaultSignatures, FlexibleInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-}
 module Language.Haskell.GhcMod.Types (
     module Language.Haskell.GhcMod.Types
@@ -10,6 +10,7 @@ module Language.Haskell.GhcMod.Types (
 
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Control.Monad.Error (Error(..))
+import qualified Control.Monad.IO.Class as MTL
 import Control.Exception (Exception)
 import Control.Applicative
 import Control.Arrow
@@ -25,7 +26,9 @@ import Data.Maybe
 import Data.Typeable (Typeable)
 import Distribution.Helper
 import Exception (ExceptionMonad)
-import MonadUtils (MonadIO)
+#if __GLASGOW_HASKELL__ < 708
+import qualified MonadUtils as GHC (MonadIO(..))
+#endif
 import GHC (ModuleName, moduleNameString, mkModuleName)
 import PackageConfig (PackageConfig)
 import GHC.Generics
@@ -38,6 +41,18 @@ import GHC.Generics
 -- the exported API so users have the option to use a custom inner monad.
 type IOish m = (Functor m, MonadIO m, MonadBaseControl IO m, ExceptionMonad m)
 
+
+-- MonadUtils of GHC 7.6 or earlier defines its own MonadIO.
+-- MonadUtils of GHC 7.8 or later imports MonadIO in Monad.Control.IO.Class.
+#if __GLASGOW_HASKELL__ < 708
+type MonadIOC m = (GHC.MonadIO m, MTL.MonadIO m)
+#else
+type MonadIOC m = (MTL.MonadIO m)
+#endif
+
+class MonadIOC m => MonadIO m where
+    liftIO :: IO a -> m a
+
 -- | Output style.
 data OutputStyle = LispStyle  -- ^ S expression style.
                  | PlainStyle -- ^ Plain textstyle.
@@ -208,7 +223,7 @@ data GmComponent (t :: GmComponentType) eps = GmComponent {
       gmcEntrypoints     :: eps,
       gmcSourceDirs      :: [FilePath],
       gmcHomeModuleGraph :: GmModuleGraph
-    } deriving (Eq, Ord, Show, Read, Generic, Typeable, Functor)
+    } deriving (Eq, Ord, Show, Read, Generic, Functor)
 
 instance Serialize eps => Serialize (GmComponent t eps)