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
HasDynFlags Ghc
ExceptionMonad 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
mask :: ((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
mask f :: (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
$ \s :: 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
$ \io_restore :: 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
$ \m :: 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
$ \s' :: 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
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 f :: Maybe FilePath
f (Ghc m :: 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 f :: 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
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
m :: GhcT m a
m catch :: GhcT m a -> (e -> GhcT m a) -> GhcT m a
`catch` f :: 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 f :: (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
$ \s :: 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
$ \io_restore :: 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
$ \m :: 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
$ \s' :: 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 g :: 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
$ \s :: 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 m :: GhcT m a
m = \s :: 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 f :: (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 (\x :: 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
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
m :: MTLAdapter m a
m gcatch :: MTLAdapter m a -> (e -> MTLAdapter m a) -> MTLAdapter m a
`gcatch` f :: 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 io :: (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 (\f :: 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
#endif