{-# LANGUAGE DerivingVia, NoPolyKinds #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module GHC.Driver.Monad (
GhcMonad(..),
Ghc(..),
GhcT(..), liftGhcT,
reflectGhc, reifyGhc,
getSessionDynFlags,
liftIO,
Session(..), withSession, modifySession, modifySessionM,
withTempSession,
modifyLogger,
pushLogHookM,
popLogHookM,
pushJsonLogHookM,
popJsonLogHookM,
putLogMsgM,
putMsgM,
withTimingM,
logDiagnostics, printException,
WarnErrLogger, defaultWarnErrLogger
) where
import GHC.Prelude
import GHC.Driver.DynFlags
import GHC.Driver.Env
import GHC.Driver.Errors ( printOrThrowDiagnostics, printMessages )
import GHC.Driver.Errors.Types
import GHC.Driver.Config.Diagnostic
import GHC.Utils.Monad
import GHC.Utils.Exception
import GHC.Utils.Error
import GHC.Utils.Logger
import GHC.Types.SrcLoc
import GHC.Types.SourceError
import Control.Monad
import Control.Monad.Catch as MC
import Control.Monad.Trans.Reader
import Data.IORef
class (Functor m, ExceptionMonad m, HasDynFlags m, HasLogger m ) => GhcMonad m where
getSession :: m HscEnv
setSession :: HscEnv -> m ()
withSession :: GhcMonad m => (HscEnv -> m a) -> m a
withSession :: forall (m :: * -> *) a. GhcMonad m => (HscEnv -> m a) -> m a
withSession HscEnv -> m a
f = m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession m HscEnv -> (HscEnv -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HscEnv -> m a
f
getSessionDynFlags :: GhcMonad m => m DynFlags
getSessionDynFlags :: forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags = (HscEnv -> m DynFlags) -> m DynFlags
forall (m :: * -> *) a. GhcMonad m => (HscEnv -> m a) -> m a
withSession (DynFlags -> m DynFlags
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags -> m DynFlags)
-> (HscEnv -> DynFlags) -> HscEnv -> m DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> DynFlags
hsc_dflags)
modifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m ()
modifySession :: forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
modifySession HscEnv -> HscEnv
f = do h <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
setSession $! f h
modifySessionM :: GhcMonad m => (HscEnv -> m HscEnv) -> m ()
modifySessionM :: forall (m :: * -> *). GhcMonad m => (HscEnv -> m HscEnv) -> m ()
modifySessionM HscEnv -> m HscEnv
f = do h <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
h' <- f h
setSession $! h'
withSavedSession :: GhcMonad m => m a -> m a
withSavedSession :: forall (m :: * -> *) a. GhcMonad m => m a -> m a
withSavedSession m a
m = do
saved_session <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
m `MC.finally` setSession saved_session
withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a
withTempSession :: forall (m :: * -> *) a.
GhcMonad m =>
(HscEnv -> HscEnv) -> m a -> m a
withTempSession HscEnv -> HscEnv
f m a
m =
m a -> m a
forall (m :: * -> *) a. GhcMonad m => m a -> m a
withSavedSession (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ (HscEnv -> HscEnv) -> m ()
forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
modifySession HscEnv -> HscEnv
f m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
m
modifyLogger :: GhcMonad m => (Logger -> Logger) -> m ()
modifyLogger :: forall (m :: * -> *). GhcMonad m => (Logger -> Logger) -> m ()
modifyLogger Logger -> Logger
f = (HscEnv -> HscEnv) -> m ()
forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
modifySession ((HscEnv -> HscEnv) -> m ()) -> (HscEnv -> HscEnv) -> m ()
forall a b. (a -> b) -> a -> b
$ \HscEnv
hsc_env ->
HscEnv
hsc_env { hsc_logger = f (hsc_logger hsc_env) }
pushLogHookM :: GhcMonad m => (LogAction -> LogAction) -> m ()
pushLogHookM :: forall (m :: * -> *).
GhcMonad m =>
(LogAction -> LogAction) -> m ()
pushLogHookM = (Logger -> Logger) -> m ()
forall (m :: * -> *). GhcMonad m => (Logger -> Logger) -> m ()
modifyLogger ((Logger -> Logger) -> m ())
-> ((LogAction -> LogAction) -> Logger -> Logger)
-> (LogAction -> LogAction)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogAction -> LogAction) -> Logger -> Logger
pushLogHook
popLogHookM :: GhcMonad m => m ()
popLogHookM :: forall (m :: * -> *). GhcMonad m => m ()
popLogHookM = (Logger -> Logger) -> m ()
forall (m :: * -> *). GhcMonad m => (Logger -> Logger) -> m ()
modifyLogger Logger -> Logger
popLogHook
pushJsonLogHookM :: GhcMonad m => (LogJsonAction -> LogJsonAction) -> m ()
pushJsonLogHookM :: forall (m :: * -> *).
GhcMonad m =>
(LogJsonAction -> LogJsonAction) -> m ()
pushJsonLogHookM = (Logger -> Logger) -> m ()
forall (m :: * -> *). GhcMonad m => (Logger -> Logger) -> m ()
modifyLogger ((Logger -> Logger) -> m ())
-> ((LogJsonAction -> LogJsonAction) -> Logger -> Logger)
-> (LogJsonAction -> LogJsonAction)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogJsonAction -> LogJsonAction) -> Logger -> Logger
pushJsonLogHook
popJsonLogHookM :: GhcMonad m => m ()
popJsonLogHookM :: forall (m :: * -> *). GhcMonad m => m ()
popJsonLogHookM = (Logger -> Logger) -> m ()
forall (m :: * -> *). GhcMonad m => (Logger -> Logger) -> m ()
modifyLogger Logger -> Logger
popJsonLogHook
putMsgM :: GhcMonad m => SDoc -> m ()
putMsgM :: forall (m :: * -> *). GhcMonad m => SDoc -> m ()
putMsgM SDoc
doc = do
logger <- m Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
liftIO $ putMsg logger doc
putLogMsgM :: GhcMonad m => MessageClass -> SrcSpan -> SDoc -> m ()
putLogMsgM :: forall (m :: * -> *).
GhcMonad m =>
MessageClass -> SrcSpan -> SDoc -> m ()
putLogMsgM MessageClass
msg_class SrcSpan
loc SDoc
doc = do
logger <- m Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
liftIO $ logMsg logger msg_class loc doc
withTimingM :: GhcMonad m => SDoc -> (b -> ()) -> m b -> m b
withTimingM :: forall (m :: * -> *) b.
GhcMonad m =>
SDoc -> (b -> ()) -> m b -> m b
withTimingM SDoc
doc b -> ()
force m b
action = do
logger <- m Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
withTiming logger doc force action
logDiagnostics :: GhcMonad m => Messages GhcMessage -> m ()
logDiagnostics :: forall (m :: * -> *). GhcMonad m => Messages GhcMessage -> m ()
logDiagnostics Messages GhcMessage
warns = do
dflags <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
logger <- getLogger
let !diag_opts = DynFlags -> DiagOpts
initDiagOpts DynFlags
dflags
!print_config = DynFlags -> DiagnosticOpts GhcMessage
initPrintConfig DynFlags
dflags
liftIO $ printOrThrowDiagnostics logger print_config diag_opts warns
newtype Ghc a = Ghc { forall a. Ghc a -> Session -> IO a
unGhc :: Session -> IO a }
deriving stock ((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
$cfmap :: forall a b. (a -> b) -> Ghc a -> Ghc b
fmap :: forall a b. (a -> b) -> Ghc a -> Ghc b
$c<$ :: forall a b. a -> Ghc b -> Ghc a
<$ :: forall a b. a -> Ghc b -> Ghc a
Functor)
deriving (Functor Ghc
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
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
$cpure :: forall a. a -> Ghc a
pure :: forall a. a -> Ghc a
$c<*> :: forall a b. Ghc (a -> b) -> Ghc a -> Ghc b
<*> :: forall a b. Ghc (a -> b) -> Ghc a -> Ghc b
$cliftA2 :: forall a b c. (a -> b -> c) -> Ghc a -> Ghc b -> Ghc c
liftA2 :: forall a b c. (a -> b -> c) -> Ghc a -> Ghc b -> Ghc c
$c*> :: forall a b. Ghc a -> Ghc b -> Ghc b
*> :: forall a b. Ghc a -> Ghc b -> Ghc b
$c<* :: forall a b. Ghc a -> Ghc b -> Ghc a
<* :: forall a b. Ghc a -> Ghc b -> Ghc a
Applicative, Applicative Ghc
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
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
$c>>= :: forall a b. Ghc a -> (a -> Ghc b) -> Ghc b
>>= :: forall a b. Ghc a -> (a -> Ghc b) -> Ghc b
$c>> :: forall a b. Ghc a -> Ghc b -> Ghc b
>> :: forall a b. Ghc a -> Ghc b -> Ghc b
$creturn :: forall a. a -> Ghc a
return :: forall a. a -> Ghc a
Monad, Monad Ghc
Monad Ghc => (forall a. String -> Ghc a) -> MonadFail Ghc
forall a. String -> Ghc a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall a. String -> Ghc a
fail :: forall a. String -> Ghc a
MonadFail, Monad Ghc
Monad Ghc => (forall a. (a -> Ghc a) -> Ghc a) -> MonadFix Ghc
forall a. (a -> Ghc a) -> Ghc a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall a. (a -> Ghc a) -> Ghc a
mfix :: forall a. (a -> Ghc a) -> Ghc a
MonadFix, Monad Ghc
Monad Ghc =>
(forall e a. (HasCallStack, Exception e) => e -> Ghc a)
-> MonadThrow Ghc
forall e a. (HasCallStack, Exception e) => e -> Ghc a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> Ghc a
throwM :: forall e a. (HasCallStack, Exception e) => e -> Ghc a
MonadThrow, MonadThrow Ghc
MonadThrow Ghc =>
(forall e a.
(HasCallStack, Exception e) =>
Ghc a -> (e -> Ghc a) -> Ghc a)
-> MonadCatch Ghc
forall e a.
(HasCallStack, Exception e) =>
Ghc a -> (e -> Ghc a) -> Ghc a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
Ghc a -> (e -> Ghc a) -> Ghc a
catch :: forall e a.
(HasCallStack, Exception e) =>
Ghc a -> (e -> Ghc a) -> Ghc a
MonadCatch, MonadCatch Ghc
MonadCatch Ghc =>
(forall b.
HasCallStack =>
((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b)
-> (forall b.
HasCallStack =>
((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b)
-> (forall a b c.
HasCallStack =>
Ghc a -> (a -> ExitCase b -> Ghc c) -> (a -> Ghc b) -> Ghc (b, c))
-> MonadMask Ghc
forall b.
HasCallStack =>
((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall a b c.
HasCallStack =>
Ghc a -> (a -> ExitCase b -> Ghc c) -> (a -> Ghc b) -> Ghc (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
HasCallStack =>
((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
mask :: forall b.
HasCallStack =>
((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
$cgeneralBracket :: forall a b c.
HasCallStack =>
Ghc a -> (a -> ExitCase b -> Ghc c) -> (a -> Ghc b) -> Ghc (b, c)
generalBracket :: forall a b c.
HasCallStack =>
Ghc a -> (a -> ExitCase b -> Ghc c) -> (a -> Ghc b) -> Ghc (b, c)
MonadMask, Monad Ghc
Monad Ghc => (forall a. IO a -> Ghc a) -> MonadIO Ghc
forall a. IO a -> Ghc a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Ghc a
liftIO :: forall a. IO a -> Ghc a
MonadIO) via (ReaderT Session IO)
data Session = Session !(IORef HscEnv)
instance HasDynFlags Ghc where
getDynFlags :: Ghc DynFlags
getDynFlags = Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
instance HasLogger Ghc where
getLogger :: Ghc Logger
getLogger = HscEnv -> Logger
hsc_logger (HscEnv -> Logger) -> Ghc HscEnv -> Ghc Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghc HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
instance GhcMonad Ghc where
getSession :: Ghc HscEnv
getSession = (Session -> IO HscEnv) -> Ghc HscEnv
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO HscEnv) -> Ghc HscEnv)
-> (Session -> IO HscEnv) -> Ghc HscEnv
forall a b. (a -> b) -> a -> b
$ \(Session IORef HscEnv
r) -> IORef HscEnv -> IO HscEnv
forall a. IORef a -> IO a
readIORef IORef HscEnv
r
setSession :: HscEnv -> Ghc ()
setSession HscEnv
s' = (Session -> IO ()) -> Ghc ()
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO ()) -> Ghc ()) -> (Session -> IO ()) -> Ghc ()
forall a b. (a -> b) -> a -> b
$ \(Session IORef HscEnv
r) -> IORef HscEnv -> HscEnv -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef HscEnv
r HscEnv
s'
reflectGhc :: Ghc a -> Session -> IO a
reflectGhc :: forall a. Ghc a -> Session -> IO a
reflectGhc Ghc a
m = Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unGhc Ghc a
m
reifyGhc :: (Session -> IO a) -> Ghc a
reifyGhc :: forall a. (Session -> IO a) -> Ghc a
reifyGhc Session -> IO a
act = (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall a b. (a -> b) -> a -> b
$ Session -> IO a
act
newtype GhcT m a = GhcT { forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT :: Session -> m a }
deriving stock ((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
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GhcT m a -> GhcT m b
fmap :: forall a b. (a -> b) -> GhcT m a -> GhcT m b
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> GhcT m b -> GhcT m a
<$ :: forall a b. a -> GhcT m b -> GhcT m a
Functor)
deriving (Functor (GhcT m)
Functor (GhcT m) =>
(forall a. a -> GhcT m a)
-> (forall a b. GhcT m (a -> b) -> GhcT m a -> GhcT m b)
-> (forall a b c.
(a -> b -> c) -> GhcT m a -> GhcT m b -> GhcT m c)
-> (forall a b. GhcT m a -> GhcT m b -> GhcT m b)
-> (forall a b. GhcT m a -> GhcT m b -> GhcT m a)
-> Applicative (GhcT m)
forall a. a -> GhcT m a
forall a b. GhcT m a -> GhcT m b -> GhcT m a
forall a b. GhcT m a -> GhcT m b -> GhcT m b
forall a b. GhcT m (a -> b) -> GhcT m a -> GhcT m b
forall a b c. (a -> b -> c) -> GhcT m a -> GhcT m b -> GhcT 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 (GhcT m)
forall (m :: * -> *) a. Applicative m => a -> GhcT m a
forall (m :: * -> *) a b.
Applicative m =>
GhcT m a -> GhcT m b -> GhcT m a
forall (m :: * -> *) a b.
Applicative m =>
GhcT m a -> GhcT m b -> GhcT m b
forall (m :: * -> *) a b.
Applicative m =>
GhcT m (a -> b) -> GhcT m a -> GhcT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> GhcT m a -> GhcT m b -> GhcT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> GhcT m a
pure :: forall a. a -> GhcT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
GhcT m (a -> b) -> GhcT m a -> GhcT m b
<*> :: forall a b. GhcT m (a -> b) -> GhcT m a -> GhcT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> GhcT m a -> GhcT m b -> GhcT m c
liftA2 :: forall a b c. (a -> b -> c) -> GhcT m a -> GhcT m b -> GhcT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
GhcT m a -> GhcT m b -> GhcT m b
*> :: forall a b. GhcT m a -> GhcT m b -> GhcT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
GhcT m a -> GhcT m b -> GhcT m a
<* :: forall a b. GhcT m a -> GhcT m b -> GhcT m a
Applicative, 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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
GhcT m a -> (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 -> GhcT m b -> GhcT m b
>> :: forall a b. GhcT m a -> GhcT m b -> GhcT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> GhcT m a
return :: forall a. a -> GhcT m a
Monad, Monad (GhcT m)
Monad (GhcT m) =>
(forall a. String -> GhcT m a) -> MonadFail (GhcT m)
forall a. String -> GhcT m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (GhcT m)
forall (m :: * -> *) a. MonadFail m => String -> GhcT m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> GhcT m a
fail :: forall a. String -> GhcT m a
MonadFail, Monad (GhcT m)
Monad (GhcT m) =>
(forall a. (a -> GhcT m a) -> GhcT m a) -> MonadFix (GhcT m)
forall a. (a -> GhcT m a) -> GhcT m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
forall (m :: * -> *). MonadFix m => Monad (GhcT m)
forall (m :: * -> *) a. MonadFix m => (a -> GhcT m a) -> GhcT m a
$cmfix :: forall (m :: * -> *) a. MonadFix m => (a -> GhcT m a) -> GhcT m a
mfix :: forall a. (a -> GhcT m a) -> GhcT m a
MonadFix, Monad (GhcT m)
Monad (GhcT m) =>
(forall e a. (HasCallStack, Exception e) => e -> GhcT m a)
-> MonadThrow (GhcT m)
forall e a. (HasCallStack, Exception e) => e -> GhcT m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (GhcT m)
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> GhcT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> GhcT m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> GhcT m a
MonadThrow, MonadThrow (GhcT m)
MonadThrow (GhcT m) =>
(forall e a.
(HasCallStack, Exception e) =>
GhcT m a -> (e -> GhcT m a) -> GhcT m a)
-> MonadCatch (GhcT m)
forall e a.
(HasCallStack, Exception e) =>
GhcT m a -> (e -> GhcT m a) -> GhcT m a
forall (m :: * -> *). MonadCatch m => MonadThrow (GhcT m)
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
GhcT m a -> (e -> GhcT m a) -> GhcT m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
GhcT m a -> (e -> GhcT m a) -> GhcT m a
catch :: forall e a.
(HasCallStack, Exception e) =>
GhcT m a -> (e -> GhcT m a) -> GhcT m a
MonadCatch, MonadCatch (GhcT m)
MonadCatch (GhcT m) =>
(forall b.
HasCallStack =>
((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b)
-> (forall b.
HasCallStack =>
((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b)
-> (forall a b c.
HasCallStack =>
GhcT m a
-> (a -> ExitCase b -> GhcT m c)
-> (a -> GhcT m b)
-> GhcT m (b, c))
-> MonadMask (GhcT m)
forall b.
HasCallStack =>
((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
forall a b c.
HasCallStack =>
GhcT m a
-> (a -> ExitCase b -> GhcT m c)
-> (a -> GhcT m b)
-> GhcT m (b, c)
forall (m :: * -> *). MonadMask m => MonadCatch (GhcT m)
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
GhcT m a
-> (a -> ExitCase b -> GhcT m c)
-> (a -> GhcT m b)
-> GhcT m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
HasCallStack =>
((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
mask :: forall b.
HasCallStack =>
((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
$cgeneralBracket :: forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
GhcT m a
-> (a -> ExitCase b -> GhcT m c)
-> (a -> GhcT m b)
-> GhcT m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
GhcT m a
-> (a -> ExitCase b -> GhcT m c)
-> (a -> GhcT m b)
-> GhcT m (b, c)
MonadMask, Monad (GhcT m)
Monad (GhcT m) => (forall a. IO a -> GhcT m a) -> MonadIO (GhcT m)
forall a. IO a -> GhcT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (GhcT m)
forall (m :: * -> *) a. MonadIO m => IO a -> GhcT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> GhcT m a
liftIO :: forall a. IO a -> GhcT m a
MonadIO) via (ReaderT Session m)
liftGhcT :: m a -> GhcT m a
liftGhcT :: forall (m :: * -> *) a. m a -> GhcT m a
liftGhcT m a
m = (Session -> m a) -> GhcT m a
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m a) -> GhcT m a) -> (Session -> m a) -> GhcT m a
forall a b. (a -> b) -> a -> b
$ \Session
_ -> m a
m
instance MonadIO m => HasDynFlags (GhcT m) where
getDynFlags :: GhcT m DynFlags
getDynFlags = (Session -> m DynFlags) -> GhcT m DynFlags
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m DynFlags) -> GhcT m DynFlags)
-> (Session -> m DynFlags) -> GhcT m DynFlags
forall a b. (a -> b) -> a -> b
$ \(Session IORef HscEnv
r) -> (HscEnv -> DynFlags) -> m HscEnv -> m DynFlags
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM HscEnv -> DynFlags
hsc_dflags (IO HscEnv -> m HscEnv
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnv -> m HscEnv) -> IO HscEnv -> m HscEnv
forall a b. (a -> b) -> a -> b
$ IORef HscEnv -> IO HscEnv
forall a. IORef a -> IO a
readIORef IORef HscEnv
r)
instance MonadIO m => HasLogger (GhcT m) where
getLogger :: GhcT m Logger
getLogger = (Session -> m Logger) -> GhcT m Logger
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m Logger) -> GhcT m Logger)
-> (Session -> m Logger) -> GhcT m Logger
forall a b. (a -> b) -> a -> b
$ \(Session IORef HscEnv
r) -> (HscEnv -> Logger) -> m HscEnv -> m Logger
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM HscEnv -> Logger
hsc_logger (IO HscEnv -> m HscEnv
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnv -> m HscEnv) -> IO HscEnv -> m HscEnv
forall a b. (a -> b) -> a -> b
$ IORef HscEnv -> IO HscEnv
forall a. IORef a -> IO a
readIORef IORef HscEnv
r)
instance ExceptionMonad m => GhcMonad (GhcT m) where
getSession :: GhcT m HscEnv
getSession = (Session -> m HscEnv) -> GhcT m HscEnv
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m HscEnv) -> GhcT m HscEnv)
-> (Session -> m HscEnv) -> GhcT m HscEnv
forall a b. (a -> b) -> a -> b
$ \(Session IORef HscEnv
r) -> IO HscEnv -> m HscEnv
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnv -> m HscEnv) -> IO HscEnv -> m HscEnv
forall a b. (a -> b) -> a -> b
$ IORef HscEnv -> IO HscEnv
forall a. IORef a -> IO a
readIORef IORef HscEnv
r
setSession :: HscEnv -> GhcT m ()
setSession HscEnv
s' = (Session -> m ()) -> GhcT m ()
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m ()) -> GhcT m ()) -> (Session -> m ()) -> GhcT m ()
forall a b. (a -> b) -> a -> b
$ \(Session IORef HscEnv
r) -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef HscEnv -> HscEnv -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef HscEnv
r HscEnv
s'
printException :: (HasLogger m, MonadIO m, HasDynFlags m) => SourceError -> m ()
printException :: forall (m :: * -> *).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
printException SourceError
err = do
dflags <- m DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
logger <- getLogger
let !diag_opts = DynFlags -> DiagOpts
initDiagOpts DynFlags
dflags
!print_config = DynFlags -> DiagnosticOpts GhcMessage
initPrintConfig DynFlags
dflags
liftIO $ printMessages logger print_config diag_opts (srcErrorMessages err)
type WarnErrLogger = forall m. (HasDynFlags m , MonadIO m, HasLogger m) => Maybe SourceError -> m ()
defaultWarnErrLogger :: WarnErrLogger
defaultWarnErrLogger :: WarnErrLogger
defaultWarnErrLogger Maybe SourceError
Nothing = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
defaultWarnErrLogger (Just SourceError
e) = SourceError -> m ()
forall (m :: * -> *).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
printException SourceError
e