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,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 -> 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
<$ :: 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, Applicative (GhcT m)
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)
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
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)

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

-- 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 <- IO (IORef HscEnv) -> MTLAdapter m (IORef HscEnv)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef HscEnv) -> MTLAdapter m (IORef HscEnv))
-> IO (IORef HscEnv) -> MTLAdapter m (IORef HscEnv)
forall a b. (a -> b) -> a -> b
$ HscEnv -> IO (IORef HscEnv)
forall a. a -> IO (IORef a)
newIORef (FilePath -> HscEnv
forall a. HasCallStack => FilePath -> a
error FilePath
"empty session")
  let session :: Session
session = IORef HscEnv -> Session
GHC.Session IORef HscEnv
ref
  (GhcT (MTLAdapter m) a -> Session -> MTLAdapter m a)
-> Session -> GhcT (MTLAdapter m) a -> MTLAdapter m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip GhcT (MTLAdapter m) a -> Session -> MTLAdapter m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
GHC.unGhcT Session
session (GhcT (MTLAdapter m) a -> MTLAdapter m a)
-> GhcT (MTLAdapter m) a -> MTLAdapter m a
forall a b. (a -> b) -> a -> b
$ {-GHC.withSignalHandlers $-} do -- do _not_ catch ^C
    Maybe FilePath -> GhcT (MTLAdapter m) ()
forall (m :: * -> *). GhcMonad m => Maybe FilePath -> m ()
GHC.initGhcMonad Maybe FilePath
mb_top_dir
    GhcT (MTLAdapter m) a -> GhcT (MTLAdapter m) a
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 = 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.
(MonadIO m, MonadMask m) =>
Maybe FilePath -> GhcT (MTLAdapter m) a -> MTLAdapter m a
rawRunGhcT 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 MonadTrans GhcT where
    lift :: forall (m :: * -> *) a. Monad m => 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 MonadIO m => MonadIO (GhcT m) where
    liftIO :: forall a. 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

instance MonadCatch m => MonadThrow (GhcT m) where
    throwM :: forall e a. Exception e => 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
#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 = 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.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (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))
#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 = (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 = MTLAdapter m a -> m a
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (MTLAdapter m a -> m a)
-> (Session -> MTLAdapter m a) -> Session -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcT (MTLAdapter m) a -> Session -> MTLAdapter m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
GHC.unGhcT (GhcT m a -> GhcT (MTLAdapter m) a
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 = (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
uninterruptibleMask (((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 = MTLAdapter m a -> m a
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (MTLAdapter m a -> m a)
-> (Session -> MTLAdapter m a) -> Session -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcT (MTLAdapter m) a -> Session -> MTLAdapter m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
GHC.unGhcT (GhcT m a -> GhcT (MTLAdapter m) a
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
      = (Session -> m (b, c)) -> GhcT m (b, c)
forall {m :: * -> *} {a}. (Session -> m a) -> GhcT m a
wrap ((Session -> m (b, c)) -> GhcT m (b, c))
-> (Session -> m (b, c)) -> GhcT m (b, c)
forall a b. (a -> b) -> a -> b
$ \Session
s -> m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket (GhcT m a -> Session -> m a
forall {m :: * -> *} {a}. GhcT m a -> Session -> m a
unwrap GhcT m a
acquire Session
s)
                                    (\a
a ExitCase b
exitCase -> GhcT m c -> Session -> m c
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 -> GhcT m b -> Session -> m b
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   = 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 = MTLAdapter m a -> m a
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (MTLAdapter m a -> m a)
-> (Session -> MTLAdapter m a) -> Session -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcT (MTLAdapter m) a -> Session -> MTLAdapter m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
GHC.unGhcT (GhcT m a -> GhcT (MTLAdapter m) a
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

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 {forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA :: m a} deriving ((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
<$ :: 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, Functor (MTLAdapter m)
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)
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, Applicative (MTLAdapter m)
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)
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 = 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
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 = 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)

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 = 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
$ (forall a. 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))
  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 = m b -> MTLAdapter m b
forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter (MTLAdapter m b -> m b
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (((forall a. MTLAdapter m a -> MTLAdapter m a) -> MTLAdapter m b)
-> MTLAdapter m b
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
    = m (b, c) -> MTLAdapter m (b, c)
forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter (m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket (MTLAdapter m a -> m a
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA MTLAdapter m a
acquire)
                                 (\a
a ExitCase b
exitCase -> MTLAdapter m c -> m c
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (a -> ExitCase b -> MTLAdapter m c
release a
a ExitCase b
exitCase))
                                 (MTLAdapter m b -> m b
forall (m :: * -> *) a. MTLAdapter m a -> m a
unMTLA (MTLAdapter m b -> m b) -> (a -> MTLAdapter m b) -> a -> m b
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 = m a -> MTLAdapter m a
forall (m :: * -> *) a. m a -> MTLAdapter m a
MTLAdapter (m a -> MTLAdapter m a) -> (e -> m a) -> e -> MTLAdapter 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
#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