module Control.Monad.Ghc ( Ghc, runGhc,
GhcT, runGhcT,
GHC.GhcMonad(..),
module Control.Monad.Trans )
where
import Prelude hiding ( catch )
import Control.Monad.Trans
import qualified Control.Monad.Trans as MTL
import Control.Monad.CatchIO
import qualified GHC ( runGhc, runGhcT )
import qualified HscTypes as GHC
import qualified MonadUtils as GHC
import qualified Exception as GHC
newtype Ghc a = Ghc (GHC.Ghc a)
deriving (Functor, Monad,
GHC.WarnLogMonad, GHC.ExceptionMonad, GHC.MonadIO, GHC.GhcMonad)
instance MTL.MonadIO Ghc where
liftIO = GHC.liftIO
instance MonadCatchIO Ghc where
catch = GHC.gcatch
block = GHC.gblock
unblock = GHC.gunblock
runGhc :: Maybe FilePath -> Ghc a -> IO a
runGhc f (Ghc m) = GHC.runGhc f m
newtype GhcT m a = GhcT { unGhcT :: GHC.GhcT (MTLAdapter m) a }
deriving (Functor, Monad)
runGhcT :: (Functor m, MonadCatchIO m) => Maybe FilePath -> GhcT m a -> m a
runGhcT f = unWrap . GHC.runGhcT f . unGhcT
instance MTL.MonadTrans GhcT where
lift = GhcT . GHC.liftGhcT . MTLAdapter
instance MTL.MonadIO m => MTL.MonadIO (GhcT m) where
liftIO = GhcT . GHC.liftIO
instance MTL.MonadIO m => GHC.MonadIO (GhcT m) where
liftIO = MTL.liftIO
instance MonadCatchIO m => MonadCatchIO (GhcT m) where
m `catch` f = GhcT $ (unGhcT m) `GHC.gcatch` (unGhcT . f)
block = GhcT . GHC.gblock . unGhcT
unblock = GhcT . GHC.gunblock . unGhcT
instance MonadCatchIO m => GHC.ExceptionMonad (GhcT m) where
gcatch = catch
gblock = block
gunblock = unblock
instance MTL.MonadIO m => GHC.WarnLogMonad (GhcT m) where
setWarnings = GhcT . GHC.setWarnings
getWarnings = GhcT GHC.getWarnings
instance (Functor m, MonadCatchIO m) => GHC.GhcMonad (GhcT m) where
getSession = GhcT GHC.getSession
setSession = GhcT . GHC.setSession
newtype MTLAdapter m a = MTLAdapter {unWrap :: m a} deriving (Functor, Monad)
instance MTL.MonadIO m => GHC.MonadIO (MTLAdapter m) where
liftIO = MTLAdapter . MTL.liftIO
instance MonadCatchIO m => GHC.ExceptionMonad (MTLAdapter m) where
m `gcatch` f = MTLAdapter $ (unWrap m) `catch` (unWrap . f)
gblock = MTLAdapter. block . unWrap
gunblock = MTLAdapter. unblock . unWrap