diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 0d8acd0..3a5a619 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, RankNTypes, TypeFamilies #-} +{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses, RankNTypes, TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + module Language.Haskell.GhcMod.Monad ( GhcMod , GhcModEnv(..) @@ -15,40 +17,38 @@ module Language.Haskell.GhcMod.Monad ( , module Control.Monad.State.Class ) where -import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Cradle import Language.Haskell.GhcMod.GHCApi +import Language.Haskell.GhcMod.Types +import DynFlags +import Exception import GHC import GHC.Paths (libdir) import GhcMonad -import Exception import MonadUtils -import DynFlags #if __GLASGOW_HASKELL__ <= 702 import HscTypes #endif #if __GLASGOW_HASKELL__ < 708 -import Data.Monoid (Monoid) import Control.Monad.Trans.Class (lift) +import Data.Monoid (Monoid) #endif -import Data.IORef (IORef, readIORef, writeIORef, newIORef) - import Control.Monad (liftM) import Control.Monad.Base (MonadBase,liftBase) -import Control.Monad.IO.Class () -- MonadIO -import Control.Monad.Trans.RWS.Lazy (RWST(..),runRWST) -import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith - , control, liftBaseOp, liftBaseOp_) import Control.Monad.Reader.Class -import Control.Monad.Writer.Class import Control.Monad.State.Class +import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith, control, liftBaseOp, liftBaseOp_) +import Control.Monad.Trans.RWS.Lazy (RWST(..),runRWST) +import Control.Monad.Writer.Class -import System.IO (hPutStr, hPrint, stderr) +import Data.IORef (IORef, readIORef, writeIORef, newIORef) import System.Exit (exitSuccess) +import System.IO (hPutStr, hPrint, stderr) +---------------------------------------------------------------- data GhcModEnv = GhcModEnv { gmGhcSession :: !(IORef HscEnv) @@ -63,15 +63,18 @@ defaultState = GhcModState type GhcModWriter = () +---------------------------------------------------------------- + newtype GhcMod a = GhcMod { - unGhcMod :: RWST GhcModEnv GhcModWriter GhcModState IO a } - deriving (Functor, - Applicative, - Monad, - MonadIO, - MonadReader GhcModEnv, - MonadWriter GhcModWriter, - MonadState GhcModState) + unGhcMod :: RWST GhcModEnv GhcModWriter GhcModState IO a + } deriving (Functor + ,Applicative + ,Monad + ,MonadIO + ,MonadReader GhcModEnv + ,MonadWriter GhcModWriter + ,MonadState GhcModState + ) #if __GLASGOW_HASKELL__ < 708 instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where @@ -79,6 +82,8 @@ instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where liftIO = lift . liftIO #endif +---------------------------------------------------------------- + runGhcMod' :: GhcModEnv -> GhcModState -> GhcMod a @@ -102,6 +107,8 @@ runGhcMod opt action = do action return a +---------------------------------------------------------------- + withErrorHandler :: String -> GhcMod a -> GhcMod a withErrorHandler label = ghandle ignore where @@ -116,6 +123,8 @@ toGhcMod a = do s <- gmGhcSession <$> ask liftIO $ unGhc a $ Session s +---------------------------------------------------------------- + options :: GhcMod Options options = gmOptions <$> ask