module Control.Monad.Ghc (
    GhcT, runGhcT
) where

import Control.Applicative
import Prelude

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class

import Control.Monad.Catch

import Data.IORef

import qualified GHC
#if MIN_VERSION_ghc(9,2,0)
import qualified GHC.Utils.Logger as GHC
#endif
#if MIN_VERSION_ghc(9,0,0)
import qualified GHC.Utils.Monad as GHC
import qualified GHC.Utils.Exception as GHC
import qualified GHC.Driver.Monad as GHC

import qualified GHC.Driver.Session as GHC
#else
import qualified MonadUtils as GHC
import qualified Exception as GHC
import qualified GhcMonad as GHC

import qualified DynFlags as GHC
#endif

newtype GhcT m a = GhcT { forall (m :: * -> *) a. GhcT m a -> GhcT (MTLAdapter m) a
unGhcT :: GHC.GhcT (MTLAdapter m) a }
                 deriving (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
<$ :: forall a b. a -> GhcT m b -> GhcT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> GhcT m b -> GhcT m a
fmap :: forall a b. (a -> b) -> GhcT m a -> GhcT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GhcT m a -> GhcT m b
Functor, 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 :: forall a. a -> GhcT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> GhcT m a
>> :: forall a b. 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
>>= :: forall a 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
Monad, GhcT m DynFlags
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)

instance (Functor m, Monad m) => Applicative (GhcT m) where
  pure :: forall a. a -> GhcT m a
pure  = forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: forall a 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

-- adapted from https://github.com/ghc/ghc/blob/ghc-8.2/compiler/main/GHC.hs#L450-L459
-- modified to _not_ catch ^C
rawRunGhcT :: (MonadIO m, MonadMask m) => Maybe FilePath -> GHC.GhcT (MTLAdapter m) a -> MTLAdapter m a
rawRunGhcT :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Maybe FilePath -> GhcT (MTLAdapter m) a -> MTLAdapter m a
rawRunGhcT Maybe FilePath
mb_top_dir GhcT (MTLAdapter m) a
ghct = do
  IORef HscEnv
ref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef (forall a. HasCallStack => FilePath -> a
error FilePath
"empty session")
  let session :: Session
session = IORef HscEnv -> Session
GHC.Session IORef HscEnv
ref
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. GhcT m a -> Session -> m a
GHC.unGhcT Session
session forall a b. (a -> b) -> a -> b
$ {-GHC.withSignalHandlers $-} do -- do _not_ catch ^C
    forall (m :: * -> *). GhcMonad m => Maybe FilePath -> m ()
GHC.initGhcMonad Maybe FilePath
mb_top_dir
    forall (m :: * -> *) a. GhcMonad m => m a -> m a
GHC.withCleanupSession GhcT (MTLAdapter m) a
ghct

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

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

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

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

instance (MonadIO m, MonadCatch m, MonadMask m) => MonadCatch (GhcT m) where
#if MIN_VERSION_ghc(9,0,0)
    GhcT m a
m catch :: forall e a. Exception e => GhcT m a -> (e -> GhcT m a) -> GhcT m a
`catch` e -> GhcT m a
f = forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT (forall (m :: * -> *) a. GhcT m a -> GhcT (MTLAdapter m) a
unGhcT GhcT m a
m forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (forall (m :: * -> *) a. GhcT m a -> GhcT (MTLAdapter m) a
unGhcT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> GhcT m a
f))
#else
    m `catch` f = GhcT (unGhcT m `GHC.gcatch` (unGhcT . f))
#endif

instance (MonadIO m, MonadMask m) => MonadMask (GhcT m) where
    mask :: forall b.
((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 = forall {m :: * -> *} {a}. (Session -> m a) -> GhcT m a
wrap forall a b. (a -> b) -> a -> b
$ \Session
s ->
               forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
io_restore ->
                 forall {m :: * -> *} {a}. GhcT m a -> Session -> m a
unwrap ((forall a. GhcT m a -> GhcT m a) -> GhcT m b
f forall a b. (a -> b) -> a -> b
$ \GhcT m a
m -> (forall {m :: * -> *} {a}. (Session -> m a) -> GhcT m a
wrap forall a b. (a -> b) -> a -> b
$ \Session
s' -> forall a. m a -> m a
io_restore (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   = forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GHC.GhcT forall a b. (a -> b) -> a -> b
$ \Session
s -> 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 = forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. GhcT m a -> Session -> m a
GHC.unGhcT (forall (m :: * -> *) a. GhcT m a -> GhcT (MTLAdapter m) a
unGhcT GhcT m a
m)

    uninterruptibleMask :: forall b.
((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
f = forall {m :: * -> *} {a}. (Session -> m a) -> GhcT m a
wrap forall a b. (a -> b) -> a -> b
$ \Session
s ->
                              forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
io_restore ->
                                forall {m :: * -> *} {a}. GhcT m a -> Session -> m a
unwrap ((forall a. GhcT m a -> GhcT m a) -> GhcT m b
f forall a b. (a -> b) -> a -> b
$ \GhcT m a
m -> (forall {m :: * -> *} {a}. (Session -> m a) -> GhcT m a
wrap forall a b. (a -> b) -> a -> b
$ \Session
s' -> forall a. m a -> m a
io_restore (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   = forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GHC.GhcT forall a b. (a -> b) -> a -> b
$ \Session
s -> 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 = forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. GhcT m a -> Session -> m a
GHC.unGhcT (forall (m :: * -> *) a. GhcT m a -> GhcT (MTLAdapter m) a
unGhcT GhcT m a
m)

    generalBracket :: forall a b c.
GhcT m a
-> (a -> ExitCase b -> GhcT m c)
-> (a -> GhcT m b)
-> GhcT m (b, c)
generalBracket GhcT m a
acquire a -> ExitCase b -> GhcT m c
release a -> GhcT m b
body
      = forall {m :: * -> *} {a}. (Session -> m a) -> GhcT m a
wrap forall a b. (a -> b) -> a -> b
$ \Session
s -> forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket (forall {m :: * -> *} {a}. GhcT m a -> Session -> m a
unwrap GhcT m a
acquire Session
s)
                                    (\a
a ExitCase b
exitCase -> forall {m :: * -> *} {a}. GhcT m a -> Session -> m a
unwrap (a -> ExitCase b -> GhcT m c
release a
a ExitCase b
exitCase) Session
s)
                                    (\a
a -> forall {m :: * -> *} {a}. GhcT m a -> Session -> m a
unwrap (a -> GhcT m b
body a
a) Session
s)
      where
        wrap :: (Session -> m a) -> GhcT m a
wrap Session -> m a
g   = forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GHC.GhcT forall a b. (a -> b) -> a -> b
$ \Session
s -> 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 = forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. GhcT m a -> Session -> m a
GHC.unGhcT (forall (m :: * -> *) a. GhcT m a -> GhcT (MTLAdapter m) a
unGhcT GhcT m a
m)

#if !MIN_VERSION_ghc(9,0,0)
instance (MonadIO m, MonadCatch m, MonadMask m) => GHC.ExceptionMonad (GhcT m) where
    gcatch = catch
    gmask  = mask
#endif

#if MIN_VERSION_ghc(9,2,0)
instance MonadIO m => GHC.HasLogger (GhcT m) where
    getLogger :: GhcT m Logger
getLogger = forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT forall (m :: * -> *). HasLogger m => m Logger
GHC.getLogger
#endif

instance (Functor m, MonadIO m, MonadCatch m, MonadMask m) => GHC.GhcMonad (GhcT m) where
    getSession :: GhcT m HscEnv
getSession = forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT forall (m :: * -> *). GhcMonad m => m HscEnv
GHC.getSession
    setSession :: HscEnv -> GhcT m ()
setSession = forall (m :: * -> *) a. GhcT (MTLAdapter m) a -> GhcT m a
GhcT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 {forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA :: m a} deriving (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
<$ :: forall a b. a -> MTLAdapter m b -> MTLAdapter m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MTLAdapter m b -> MTLAdapter m a
fmap :: forall a b. (a -> b) -> MTLAdapter m a -> MTLAdapter m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MTLAdapter m a -> MTLAdapter m b
Functor, 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
<* :: forall a b. 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
*> :: forall a b. 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 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> MTLAdapter m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> MTLAdapter m a
Applicative, 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 :: forall a. a -> MTLAdapter m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MTLAdapter m a
>> :: forall a b. 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
>>= :: forall a 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
Monad)

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

#if MIN_VERSION_ghc(9,0,0)
instance MonadCatch m => MonadCatch (MTLAdapter m) where
  MTLAdapter m a
m catch :: forall e a.
Exception e =>
MTLAdapter m a -> (e -> MTLAdapter m a) -> MTLAdapter m a
`catch` e -> MTLAdapter m a
f = forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA MTLAdapter m a
m forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> MTLAdapter m a
f)

instance MonadMask m => MonadMask (MTLAdapter m) where
  mask :: forall b.
((forall a. MTLAdapter m a -> MTLAdapter m a) -> MTLAdapter m b)
-> MTLAdapter m b
mask (forall a. MTLAdapter m a -> MTLAdapter m a) -> MTLAdapter m b
io = forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (\forall a. m a -> m a
f -> forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA forall a b. (a -> b) -> a -> b
$ (forall a. MTLAdapter m a -> MTLAdapter m a) -> MTLAdapter m b
io (forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA))
  uninterruptibleMask :: forall b.
((forall a. MTLAdapter m a -> MTLAdapter m a) -> MTLAdapter m b)
-> MTLAdapter m b
uninterruptibleMask (forall a. MTLAdapter m a -> MTLAdapter m a) -> MTLAdapter m b
f = forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter (forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (forall a. MTLAdapter m a -> MTLAdapter m a) -> MTLAdapter m b
f))
  generalBracket :: forall a b c.
MTLAdapter m a
-> (a -> ExitCase b -> MTLAdapter m c)
-> (a -> MTLAdapter m b)
-> MTLAdapter m (b, c)
generalBracket MTLAdapter m a
acquire a -> ExitCase b -> MTLAdapter m c
release a -> MTLAdapter m b
body
    = forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter (forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket (forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA MTLAdapter m a
acquire)
                                 (\a
a ExitCase b
exitCase -> forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (a -> ExitCase b -> MTLAdapter m c
release a
a ExitCase b
exitCase))
                                 (forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MTLAdapter m b
body))

instance MonadThrow m => MonadThrow (MTLAdapter m) where
  throwM :: forall e a. Exception e => e -> MTLAdapter m a
throwM = forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
#else
instance (MonadIO m, MonadCatch m, MonadMask m) => GHC.ExceptionMonad (MTLAdapter m) where
  m `gcatch` f = MTLAdapter $ unMTLA m `catch` (unMTLA . f)
  gmask io = MTLAdapter $ mask (\f -> unMTLA $ io (MTLAdapter . f . unMTLA))
#endif