module Control.Monad.Ghc ( Ghc, runGhc,
                           GhcT, runGhcT,
                           GHC.GhcMonad(..),
                           module Control.Monad.Trans )

where

#if __GLASGOW_HASKELL__ < 706
import Prelude hiding ( catch )
#endif

import qualified Control.Exception.Extensible as E

import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import qualified Control.Monad.Trans as MTL

import Control.Monad.Catch

import qualified GHC ( runGhc, runGhcT )
import qualified MonadUtils as GHC
import qualified Exception  as GHC
#if __GLASGOW_HASKELL__ >= 702
import qualified GhcMonad   as GHC
#else
import qualified HscTypes   as GHC
#endif

#if __GLASGOW_HASKELL__ >= 706
import qualified DynFlags as GHC
#endif

newtype Ghc a = Ghc{ Ghc a -> Ghc a
unGhc :: GHC.Ghc a }
    deriving (a -> Ghc b -> Ghc a
(a -> b) -> Ghc a -> Ghc b
(forall a b. (a -> b) -> Ghc a -> Ghc b)
-> (forall a b. a -> Ghc b -> Ghc a) -> Functor Ghc
forall a b. a -> Ghc b -> Ghc a
forall a b. (a -> b) -> Ghc a -> Ghc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Ghc b -> Ghc a
$c<$ :: forall a b. a -> Ghc b -> Ghc a
fmap :: (a -> b) -> Ghc a -> Ghc b
$cfmap :: forall a b. (a -> b) -> Ghc a -> Ghc b
Functor
             ,Applicative Ghc
a -> Ghc a
Applicative Ghc
-> (forall a b. Ghc a -> (a -> Ghc b) -> Ghc b)
-> (forall a b. Ghc a -> Ghc b -> Ghc b)
-> (forall a. a -> Ghc a)
-> Monad Ghc
Ghc a -> (a -> Ghc b) -> Ghc b
Ghc a -> Ghc b -> Ghc b
forall a. a -> Ghc a
forall a b. Ghc a -> Ghc b -> Ghc b
forall a b. Ghc a -> (a -> Ghc b) -> Ghc b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Ghc a
$creturn :: forall a. a -> Ghc a
>> :: Ghc a -> Ghc b -> Ghc b
$c>> :: forall a b. Ghc a -> Ghc b -> Ghc b
>>= :: Ghc a -> (a -> Ghc b) -> Ghc b
$c>>= :: forall a b. Ghc a -> (a -> Ghc b) -> Ghc b
$cp1Monad :: Applicative Ghc
Monad
#if __GLASGOW_HASKELL__ < 702
             ,GHC.WarnLogMonad
#elif __GLASGOW_HASKELL__ >= 706
             ,Ghc DynFlags
Ghc DynFlags -> HasDynFlags Ghc
forall (m :: * -> *). m DynFlags -> HasDynFlags m
getDynFlags :: Ghc DynFlags
$cgetDynFlags :: Ghc DynFlags
GHC.HasDynFlags
#endif
             ,MonadIO Ghc
MonadIO Ghc
-> (forall e a. Exception e => Ghc a -> (e -> Ghc a) -> Ghc a)
-> (forall a b. ((Ghc a -> Ghc a) -> Ghc b) -> Ghc b)
-> (forall a b c. Ghc a -> (a -> Ghc b) -> (a -> Ghc c) -> Ghc c)
-> (forall a b. Ghc a -> Ghc b -> Ghc a)
-> ExceptionMonad Ghc
Ghc a -> (e -> Ghc a) -> Ghc a
Ghc a -> (a -> Ghc b) -> (a -> Ghc c) -> Ghc c
Ghc a -> Ghc b -> Ghc a
((Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall e a. Exception e => Ghc a -> (e -> Ghc a) -> Ghc a
forall a b. Ghc a -> Ghc b -> Ghc a
forall a b. ((Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall a b c. Ghc a -> (a -> Ghc b) -> (a -> Ghc c) -> Ghc c
forall (m :: * -> *).
MonadIO m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. ((m a -> m a) -> m b) -> m b)
-> (forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c)
-> (forall a b. m a -> m b -> m a)
-> ExceptionMonad m
gfinally :: Ghc a -> Ghc b -> Ghc a
$cgfinally :: forall a b. Ghc a -> Ghc b -> Ghc a
gbracket :: Ghc a -> (a -> Ghc b) -> (a -> Ghc c) -> Ghc c
$cgbracket :: forall a b c. Ghc a -> (a -> Ghc b) -> (a -> Ghc c) -> Ghc c
gmask :: ((Ghc a -> Ghc a) -> Ghc b) -> Ghc b
$cgmask :: forall a b. ((Ghc a -> Ghc a) -> Ghc b) -> Ghc b
gcatch :: Ghc a -> (e -> Ghc a) -> Ghc a
$cgcatch :: forall e a. Exception e => Ghc a -> (e -> Ghc a) -> Ghc a
$cp1ExceptionMonad :: MonadIO Ghc
GHC.ExceptionMonad
#if __GLASGOW_HASKELL__ < 708
             ,GHC.MonadIO
#else
             ,Monad Ghc
Monad Ghc -> (forall a. IO a -> Ghc a) -> MonadIO Ghc
IO a -> Ghc a
forall a. IO a -> Ghc a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Ghc a
$cliftIO :: forall a. IO a -> Ghc a
$cp1MonadIO :: Monad Ghc
MTL.MonadIO
             ,Functor Ghc
a -> Ghc a
Functor Ghc
-> (forall a. a -> Ghc a)
-> (forall a b. Ghc (a -> b) -> Ghc a -> Ghc b)
-> (forall a b c. (a -> b -> c) -> Ghc a -> Ghc b -> Ghc c)
-> (forall a b. Ghc a -> Ghc b -> Ghc b)
-> (forall a b. Ghc a -> Ghc b -> Ghc a)
-> Applicative Ghc
Ghc a -> Ghc b -> Ghc b
Ghc a -> Ghc b -> Ghc a
Ghc (a -> b) -> Ghc a -> Ghc b
(a -> b -> c) -> Ghc a -> Ghc b -> Ghc c
forall a. a -> Ghc a
forall a b. Ghc a -> Ghc b -> Ghc a
forall a b. Ghc a -> Ghc b -> Ghc b
forall a b. Ghc (a -> b) -> Ghc a -> Ghc b
forall a b c. (a -> b -> c) -> Ghc a -> Ghc b -> Ghc c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Ghc a -> Ghc b -> Ghc a
$c<* :: forall a b. Ghc a -> Ghc b -> Ghc a
*> :: Ghc a -> Ghc b -> Ghc b
$c*> :: forall a b. Ghc a -> Ghc b -> Ghc b
liftA2 :: (a -> b -> c) -> Ghc a -> Ghc b -> Ghc c
$cliftA2 :: forall a b c. (a -> b -> c) -> Ghc a -> Ghc b -> Ghc c
<*> :: Ghc (a -> b) -> Ghc a -> Ghc b
$c<*> :: forall a b. Ghc (a -> b) -> Ghc a -> Ghc b
pure :: a -> Ghc a
$cpure :: forall a. a -> Ghc a
$cp1Applicative :: Functor Ghc
Applicative
#endif
             ,Functor Ghc
MonadIO Ghc
ExceptionMonad Ghc
HasDynFlags Ghc
Ghc HscEnv
Functor Ghc
-> MonadIO Ghc
-> ExceptionMonad Ghc
-> HasDynFlags Ghc
-> Ghc HscEnv
-> (HscEnv -> Ghc ())
-> GhcMonad Ghc
HscEnv -> Ghc ()
forall (m :: * -> *).
Functor m
-> MonadIO m
-> ExceptionMonad m
-> HasDynFlags m
-> m HscEnv
-> (HscEnv -> m ())
-> GhcMonad m
setSession :: HscEnv -> Ghc ()
$csetSession :: HscEnv -> Ghc ()
getSession :: Ghc HscEnv
$cgetSession :: Ghc HscEnv
$cp4GhcMonad :: HasDynFlags Ghc
$cp3GhcMonad :: ExceptionMonad Ghc
$cp2GhcMonad :: MonadIO Ghc
$cp1GhcMonad :: Functor Ghc
GHC.GhcMonad)


#if __GLASGOW_HASKELL__ < 708
instance Applicative Ghc where
  pure  = return
  (<*>) = ap

instance MTL.MonadIO Ghc where
    liftIO = GHC.liftIO
#endif

instance MonadThrow Ghc where
    throwM :: e -> Ghc a
throwM  = IO a -> Ghc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Ghc a) -> (e -> IO a) -> e -> Ghc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall e a. Exception e => e -> IO a
E.throwIO

instance MonadCatch Ghc where
    catch :: Ghc a -> (e -> Ghc a) -> Ghc a
catch   = Ghc a -> (e -> Ghc a) -> Ghc a
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
GHC.gcatch

instance MonadMask Ghc where
#if __GLASGOW_HASKELL__ >= 700
    -- @gmask@ is available...
    -- ...but it doesn't have a rank-n type like @mask@, so we need
    -- to use @Control.Exception.mask@ directly... (sigh)
    -- (this is type-directed, write only code)
    mask :: ((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
mask (forall a. Ghc a -> Ghc a) -> Ghc b
f = (Session -> IO b) -> Ghc b
forall a. (Session -> IO a) -> Ghc a
wrap ((Session -> IO b) -> Ghc b) -> (Session -> IO b) -> Ghc b
forall a b. (a -> b) -> a -> b
$ \Session
s ->
               ((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
io_restore ->
                 Ghc b -> Session -> IO b
forall a. Ghc a -> Session -> IO a
unwrap ((forall a. Ghc a -> Ghc a) -> Ghc b
f ((forall a. Ghc a -> Ghc a) -> Ghc b)
-> (forall a. Ghc a -> Ghc a) -> Ghc b
forall a b. (a -> b) -> a -> b
$ \Ghc a
m -> ((Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
wrap ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall a b. (a -> b) -> a -> b
$ \Session
s' -> IO a -> IO a
forall a. IO a -> IO a
io_restore (Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unwrap Ghc a
m Session
s'))) Session
s
     where
        wrap :: (Session -> IO a) -> Ghc a
wrap   = Ghc a -> Ghc a
forall a. Ghc a -> Ghc a
Ghc (Ghc a -> Ghc a)
-> ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
GHC.Ghc
        unwrap :: Ghc a -> Session -> IO a
unwrap = Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
GHC.unGhc (Ghc a -> Session -> IO a)
-> (Ghc a -> Ghc a) -> Ghc a -> Session -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ghc a -> Ghc a
forall a. Ghc a -> Ghc a
unGhc
#else
    -- this implementation, of course, offers less guarantees than the real @mask@,
    -- but we have no @mask@ available in the first place!
    mask io = GHC.gblock $ io GHC.gunblock
#endif

    uninterruptibleMask :: ((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
uninterruptibleMask = ((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask

runGhc :: Maybe FilePath -> Ghc a -> IO a
runGhc :: Maybe FilePath -> Ghc a -> IO a
runGhc Maybe FilePath
f (Ghc Ghc a
m) = Maybe FilePath -> Ghc a -> IO a
forall a. Maybe FilePath -> Ghc a -> IO a
GHC.runGhc Maybe FilePath
f Ghc a
m

newtype GhcT m a = GhcT { GhcT m a -> GhcT (MTLAdapter m) a
unGhcT :: GHC.GhcT (MTLAdapter m) a }
                 deriving (a -> GhcT m b -> GhcT m a
(a -> b) -> GhcT m a -> GhcT m b
(forall a b. (a -> b) -> GhcT m a -> GhcT m b)
-> (forall a b. a -> GhcT m b -> GhcT m a) -> Functor (GhcT m)
forall a b. a -> GhcT m b -> GhcT m a
forall a b. (a -> b) -> GhcT m a -> GhcT m b
forall (m :: * -> *) a b. Functor m => a -> GhcT m b -> GhcT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GhcT m a -> GhcT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GhcT m b -> GhcT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> GhcT m b -> GhcT m a
fmap :: (a -> b) -> GhcT m a -> GhcT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GhcT m a -> GhcT m b
Functor
                          ,Applicative (GhcT m)
a -> GhcT m a
Applicative (GhcT m)
-> (forall a b. GhcT m a -> (a -> GhcT m b) -> GhcT m b)
-> (forall a b. GhcT m a -> GhcT m b -> GhcT m b)
-> (forall a. a -> GhcT m a)
-> Monad (GhcT m)
GhcT m a -> (a -> GhcT m b) -> GhcT m b
GhcT m a -> GhcT m b -> GhcT m b
forall a. a -> GhcT m a
forall a b. GhcT m a -> GhcT m b -> GhcT m b
forall a b. GhcT m a -> (a -> GhcT m b) -> GhcT m b
forall (m :: * -> *). Monad m => Applicative (GhcT m)
forall (m :: * -> *) a. Monad m => a -> GhcT m a
forall (m :: * -> *) a b.
Monad m =>
GhcT m a -> GhcT m b -> GhcT m b
forall (m :: * -> *) a b.
Monad m =>
GhcT m a -> (a -> GhcT m b) -> GhcT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> GhcT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> GhcT m a
>> :: GhcT m a -> GhcT m b -> GhcT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
GhcT m a -> GhcT m b -> GhcT m b
>>= :: GhcT m a -> (a -> GhcT m b) -> GhcT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
GhcT m a -> (a -> GhcT m b) -> GhcT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (GhcT m)
Monad
#if __GLASGOW_HASKELL__ >= 706
                          ,GhcT m DynFlags
GhcT m DynFlags -> HasDynFlags (GhcT m)
forall (m :: * -> *). m DynFlags -> HasDynFlags m
forall (m :: * -> *). MonadIO m => GhcT m DynFlags
getDynFlags :: GhcT m DynFlags
$cgetDynFlags :: forall (m :: * -> *). MonadIO m => GhcT m DynFlags
GHC.HasDynFlags
#endif
                          )

instance (Functor m, Monad m) => Applicative (GhcT m) where
  pure :: a -> GhcT m a
pure  = a -> GhcT m a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: GhcT m (a -> b) -> GhcT m a -> GhcT m b
(<*>) = GhcT m (a -> b) -> GhcT m a -> GhcT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

runGhcT :: (Functor m, MonadIO m, MonadCatch m, MonadMask m) => Maybe FilePath -> GhcT m a -> m a
runGhcT :: Maybe FilePath -> GhcT m a -> m a
runGhcT Maybe FilePath
f = MTLAdapter m a -> m a
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (MTLAdapter m a -> m a)
-> (GhcT m a -> MTLAdapter m a) -> GhcT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> GhcT (MTLAdapter m) a -> MTLAdapter m a
forall (m :: * -> *) a.
ExceptionMonad m =>
Maybe FilePath -> GhcT m a -> m a
GHC.runGhcT Maybe FilePath
f (GhcT (MTLAdapter m) a -> MTLAdapter m a)
-> (GhcT m a -> GhcT (MTLAdapter m) a)
-> GhcT m a
-> MTLAdapter m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcT m a -> GhcT (MTLAdapter m) a
forall (m :: * -> *) a. GhcT m a -> GhcT (MTLAdapter m) a
unGhcT

instance MTL.MonadTrans GhcT where
    lift :: m a -> GhcT m a
lift = GhcT (MTLAdapter m) a -> GhcT m a
forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT (GhcT (MTLAdapter m) a -> GhcT m a)
-> (m a -> GhcT (MTLAdapter m) a) -> m a -> GhcT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MTLAdapter m a -> GhcT (MTLAdapter m) a
forall (m :: * -> *) a. m a -> GhcT m a
GHC.liftGhcT (MTLAdapter m a -> GhcT (MTLAdapter m) a)
-> (m a -> MTLAdapter m a) -> m a -> GhcT (MTLAdapter m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> MTLAdapter m a
forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter

instance MTL.MonadIO m => MTL.MonadIO (GhcT m) where
    liftIO :: IO a -> GhcT m a
liftIO = GhcT (MTLAdapter m) a -> GhcT m a
forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT (GhcT (MTLAdapter m) a -> GhcT m a)
-> (IO a -> GhcT (MTLAdapter m) a) -> IO a -> GhcT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> GhcT (MTLAdapter m) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
GHC.liftIO

#if __GLASGOW_HASKELL__ < 708
  -- ghc started using transformers at some point
instance MTL.MonadIO m => GHC.MonadIO (GhcT m) where
    liftIO = MTL.liftIO
#endif

instance MonadCatch m => MonadThrow (GhcT m) where
    throwM :: e -> GhcT m a
throwM = m a -> GhcT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GhcT m a) -> (e -> m a) -> e -> GhcT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance (MonadIO m,MonadCatch m, MonadMask m) => MonadCatch (GhcT m) where
    GhcT m a
m catch :: GhcT m a -> (e -> GhcT m a) -> GhcT m a
`catch` e -> GhcT m a
f = GhcT (MTLAdapter m) a -> GhcT m a
forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT ((GhcT m a -> GhcT (MTLAdapter m) a
forall (m :: * -> *) a. GhcT m a -> GhcT (MTLAdapter m) a
unGhcT GhcT m a
m) GhcT (MTLAdapter m) a
-> (e -> GhcT (MTLAdapter m) a) -> GhcT (MTLAdapter m) a
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
`GHC.gcatch` (GhcT m a -> GhcT (MTLAdapter m) a
forall (m :: * -> *) a. GhcT m a -> GhcT (MTLAdapter m) a
unGhcT (GhcT m a -> GhcT (MTLAdapter m) a)
-> (e -> GhcT m a) -> e -> GhcT (MTLAdapter m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> GhcT m a
f))

instance (MonadIO m, MonadMask m) => MonadMask (GhcT m) where
    mask :: ((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
mask (forall a. GhcT m a -> GhcT m a) -> GhcT m b
f = (Session -> m b) -> GhcT m b
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
wrap ((Session -> m b) -> GhcT m b) -> (Session -> m b) -> GhcT m b
forall a b. (a -> b) -> a -> b
$ \Session
s ->
               ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
io_restore ->
                 GhcT m b -> Session -> m b
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unwrap ((forall a. GhcT m a -> GhcT m a) -> GhcT m b
f ((forall a. GhcT m a -> GhcT m a) -> GhcT m b)
-> (forall a. GhcT m a -> GhcT m a) -> GhcT m b
forall a b. (a -> b) -> a -> b
$ \GhcT m a
m -> ((Session -> m a) -> GhcT m a
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
wrap ((Session -> m a) -> GhcT m a) -> (Session -> m a) -> GhcT m a
forall a b. (a -> b) -> a -> b
$ \Session
s' -> m a -> m a
forall a. m a -> m a
io_restore (GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unwrap GhcT m a
m Session
s'))) Session
s
      where
        wrap :: (Session -> m a) -> GhcT m a
wrap Session -> m a
g   = GhcT (MTLAdapter m) a -> GhcT m a
forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT (GhcT (MTLAdapter m) a -> GhcT m a)
-> GhcT (MTLAdapter m) a -> GhcT m a
forall a b. (a -> b) -> a -> b
$ (Session -> MTLAdapter m a) -> GhcT (MTLAdapter m) a
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GHC.GhcT ((Session -> MTLAdapter m a) -> GhcT (MTLAdapter m) a)
-> (Session -> MTLAdapter m a) -> GhcT (MTLAdapter m) a
forall a b. (a -> b) -> a -> b
$ \Session
s -> m a -> MTLAdapter m a
forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter (Session -> m a
g Session
s)
        unwrap :: GhcT m a -> Session -> m a
unwrap GhcT m a
m = \Session
s -> MTLAdapter m a -> m a
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA ((GhcT (MTLAdapter m) a -> Session -> MTLAdapter m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
GHC.unGhcT (GhcT (MTLAdapter m) a -> Session -> MTLAdapter m a)
-> GhcT (MTLAdapter m) a -> Session -> MTLAdapter m a
forall a b. (a -> b) -> a -> b
$ GhcT m a -> GhcT (MTLAdapter m) a
forall (m :: * -> *) a. GhcT m a -> GhcT (MTLAdapter m) a
unGhcT (GhcT m a -> GhcT (MTLAdapter m) a)
-> GhcT m a -> GhcT (MTLAdapter m) a
forall a b. (a -> b) -> a -> b
$  GhcT m a
m) Session
s)

    uninterruptibleMask :: ((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
uninterruptibleMask = ((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask

instance (MonadIO m, MonadCatch m, MonadMask m) => GHC.ExceptionMonad (GhcT m) where
    gcatch :: GhcT m a -> (e -> GhcT m a) -> GhcT m a
gcatch  = GhcT m a -> (e -> GhcT m a) -> GhcT m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch
#if __GLASGOW_HASKELL__ >= 700
    gmask :: ((GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
gmask (GhcT m a -> GhcT m a) -> GhcT m b
f = ((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (\forall a. GhcT m a -> GhcT m a
x -> (GhcT m a -> GhcT m a) -> GhcT m b
f GhcT m a -> GhcT m a
forall a. GhcT m a -> GhcT m a
x)
#else
    gblock = mask_
#endif


#if __GLASGOW_HASKELL__ < 702
instance MTL.MonadIO m => GHC.WarnLogMonad (GhcT m) where
    setWarnings = GhcT . GHC.setWarnings
    getWarnings = GhcT GHC.getWarnings
#endif

instance (Functor m, MonadIO m, MonadCatch m, MonadMask m) => GHC.GhcMonad (GhcT m) where
    getSession :: GhcT m HscEnv
getSession = GhcT (MTLAdapter m) HscEnv -> GhcT m HscEnv
forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT GhcT (MTLAdapter m) HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
GHC.getSession
    setSession :: HscEnv -> GhcT m ()
setSession = GhcT (MTLAdapter m) () -> GhcT m ()
forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT (GhcT (MTLAdapter m) () -> GhcT m ())
-> (HscEnv -> GhcT (MTLAdapter m) ()) -> HscEnv -> GhcT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> GhcT (MTLAdapter m) ()
forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
GHC.setSession

-- | We use the 'MTLAdapter' to convert between similar classes
--   like 'MTL'''s 'MonadIO' and 'GHC'''s 'MonadIO'.
newtype MTLAdapter m a = MTLAdapter {MTLAdapter m a -> m a
unMTLA :: m a} deriving (a -> MTLAdapter m b -> MTLAdapter m a
(a -> b) -> MTLAdapter m a -> MTLAdapter m b
(forall a b. (a -> b) -> MTLAdapter m a -> MTLAdapter m b)
-> (forall a b. a -> MTLAdapter m b -> MTLAdapter m a)
-> Functor (MTLAdapter m)
forall a b. a -> MTLAdapter m b -> MTLAdapter m a
forall a b. (a -> b) -> MTLAdapter m a -> MTLAdapter m b
forall (m :: * -> *) a b.
Functor m =>
a -> MTLAdapter m b -> MTLAdapter m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MTLAdapter m a -> MTLAdapter m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MTLAdapter m b -> MTLAdapter m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MTLAdapter m b -> MTLAdapter m a
fmap :: (a -> b) -> MTLAdapter m a -> MTLAdapter m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MTLAdapter m a -> MTLAdapter m b
Functor, Functor (MTLAdapter m)
a -> MTLAdapter m a
Functor (MTLAdapter m)
-> (forall a. a -> MTLAdapter m a)
-> (forall a b.
    MTLAdapter m (a -> b) -> MTLAdapter m a -> MTLAdapter m b)
-> (forall a b c.
    (a -> b -> c)
    -> MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m c)
-> (forall a b. MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b)
-> (forall a b. MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m a)
-> Applicative (MTLAdapter m)
MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b
MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m a
MTLAdapter m (a -> b) -> MTLAdapter m a -> MTLAdapter m b
(a -> b -> c) -> MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m c
forall a. a -> MTLAdapter m a
forall a b. MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m a
forall a b. MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b
forall a b.
MTLAdapter m (a -> b) -> MTLAdapter m a -> MTLAdapter m b
forall a b c.
(a -> b -> c) -> MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (MTLAdapter m)
forall (m :: * -> *) a. Applicative m => a -> MTLAdapter m a
forall (m :: * -> *) a b.
Applicative m =>
MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m a
forall (m :: * -> *) a b.
Applicative m =>
MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b
forall (m :: * -> *) a b.
Applicative m =>
MTLAdapter m (a -> b) -> MTLAdapter m a -> MTLAdapter m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m c
<* :: MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m a
*> :: MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b
liftA2 :: (a -> b -> c) -> MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m c
<*> :: MTLAdapter m (a -> b) -> MTLAdapter m a -> MTLAdapter m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
MTLAdapter m (a -> b) -> MTLAdapter m a -> MTLAdapter m b
pure :: a -> MTLAdapter m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> MTLAdapter m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (MTLAdapter m)
Applicative, Applicative (MTLAdapter m)
a -> MTLAdapter m a
Applicative (MTLAdapter m)
-> (forall a b.
    MTLAdapter m a -> (a -> MTLAdapter m b) -> MTLAdapter m b)
-> (forall a b. MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b)
-> (forall a. a -> MTLAdapter m a)
-> Monad (MTLAdapter m)
MTLAdapter m a -> (a -> MTLAdapter m b) -> MTLAdapter m b
MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b
forall a. a -> MTLAdapter m a
forall a b. MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b
forall a b.
MTLAdapter m a -> (a -> MTLAdapter m b) -> MTLAdapter m b
forall (m :: * -> *). Monad m => Applicative (MTLAdapter m)
forall (m :: * -> *) a. Monad m => a -> MTLAdapter m a
forall (m :: * -> *) a b.
Monad m =>
MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b
forall (m :: * -> *) a b.
Monad m =>
MTLAdapter m a -> (a -> MTLAdapter m b) -> MTLAdapter m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> MTLAdapter m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MTLAdapter m a
>> :: MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MTLAdapter m a -> MTLAdapter m b -> MTLAdapter m b
>>= :: MTLAdapter m a -> (a -> MTLAdapter m b) -> MTLAdapter m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MTLAdapter m a -> (a -> MTLAdapter m b) -> MTLAdapter m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (MTLAdapter m)
Monad)


instance MTL.MonadIO m => GHC.MonadIO (MTLAdapter m) where
    liftIO :: IO a -> MTLAdapter m a
liftIO = m a -> MTLAdapter m a
forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter (m a -> MTLAdapter m a) -> (IO a -> m a) -> IO a -> MTLAdapter m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MTL.liftIO


instance (MonadIO m, MonadCatch m, MonadMask m) => GHC.ExceptionMonad (MTLAdapter m) where
  MTLAdapter m a
m gcatch :: MTLAdapter m a -> (e -> MTLAdapter m a) -> MTLAdapter m a
`gcatch` e -> MTLAdapter m a
f = m a -> MTLAdapter m a
forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter (m a -> MTLAdapter m a) -> m a -> MTLAdapter m a
forall a b. (a -> b) -> a -> b
$ (MTLAdapter m a -> m a
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA MTLAdapter m a
m) m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (MTLAdapter m a -> m a
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (MTLAdapter m a -> m a) -> (e -> MTLAdapter m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> MTLAdapter m a
f)

#if __GLASGOW_HASKELL__ >= 700
  gmask :: ((MTLAdapter m a -> MTLAdapter m a) -> MTLAdapter m b)
-> MTLAdapter m b
gmask (MTLAdapter m a -> MTLAdapter m a) -> MTLAdapter m b
io = m b -> MTLAdapter m b
forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter (m b -> MTLAdapter m b) -> m b -> MTLAdapter m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (\forall a. m a -> m a
f -> MTLAdapter m b -> m b
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (MTLAdapter m b -> m b) -> MTLAdapter m b -> m b
forall a b. (a -> b) -> a -> b
$ (MTLAdapter m a -> MTLAdapter m a) -> MTLAdapter m b
io (m a -> MTLAdapter m a
forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter (m a -> MTLAdapter m a)
-> (MTLAdapter m a -> m a) -> MTLAdapter m a -> MTLAdapter m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m a
forall a. m a -> m a
f (m a -> m a) -> (MTLAdapter m a -> m a) -> MTLAdapter m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MTLAdapter m a -> m a
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA))
#else
  gblock = MTLAdapter . mask_ . unMTLA -- use block instead
#endif