    module Hint.InterpreterT (
        InterpreterT, Interpreter,
        runInterpreter, runInterpreterWithArgs, runInterpreterWithArgsLibdir,
        MultipleInstancesNotAllowed(..)
    ) where

    import Control.Applicative
    import Prelude

    import Hint.Base
    import Hint.Context
    import Hint.Configuration
    import Hint.Extension

    import Control.Monad (ap, unless)
    import Control.Monad.IO.Class
    import Control.Monad.Trans.Class
    import Control.Monad.Trans.Reader
    import Control.Monad.Catch as MC

    import Data.Typeable (Typeable)
    import Control.Concurrent.MVar
    import System.IO.Unsafe (unsafePerformIO)

    import Data.IORef
    import Data.Maybe

    import qualified GHC.Paths

    import qualified Hint.GHC as GHC

    type Interpreter = InterpreterT IO

    newtype InterpreterT m a = InterpreterT {
                                 forall (m :: * -> *) a.
    InterpreterT m a -> ReaderT InterpreterSession (GhcT m) a
    unInterpreterT :: ReaderT InterpreterSession (GHC.GhcT m) a
                               }
        deriving ((forall a b. (a -> b) -> InterpreterT m a -> InterpreterT m b)
    -> (forall a b. a -> InterpreterT m b -> InterpreterT m a)
    -> Functor (InterpreterT m)
    forall a b. a -> InterpreterT m b -> InterpreterT m a
    forall a b. (a -> b) -> InterpreterT m a -> InterpreterT m b
    forall (m :: * -> *) a b.
    Functor m =>
    a -> InterpreterT m b -> InterpreterT m a
    forall (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> InterpreterT m a -> InterpreterT 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) -> InterpreterT m a -> InterpreterT m b
    fmap :: forall a b. (a -> b) -> InterpreterT m a -> InterpreterT m b
    $c<$ :: forall (m :: * -> *) a b.
    Functor m =>
    a -> InterpreterT m b -> InterpreterT m a
    <$ :: forall a b. a -> InterpreterT m b -> InterpreterT m a
    Functor, Applicative (InterpreterT m)
    Applicative (InterpreterT m) =>
    (forall a b.
     InterpreterT m a -> (a -> InterpreterT m b) -> InterpreterT m b)
    -> (forall a b.
        InterpreterT m a -> InterpreterT m b -> InterpreterT m b)
    -> (forall a. a -> InterpreterT m a)
    -> Monad (InterpreterT m)
    forall a. a -> InterpreterT m a
    forall a b.
    InterpreterT m a -> InterpreterT m b -> InterpreterT m b
    forall a b.
    InterpreterT m a -> (a -> InterpreterT m b) -> InterpreterT m b
    forall (m :: * -> *). Monad m => Applicative (InterpreterT m)
    forall (m :: * -> *) a. Monad m => a -> InterpreterT m a
    forall (m :: * -> *) a b.
    Monad m =>
    InterpreterT m a -> InterpreterT m b -> InterpreterT m b
    forall (m :: * -> *) a b.
    Monad m =>
    InterpreterT m a -> (a -> InterpreterT m b) -> InterpreterT 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 =>
    InterpreterT m a -> (a -> InterpreterT m b) -> InterpreterT m b
    >>= :: forall a b.
    InterpreterT m a -> (a -> InterpreterT m b) -> InterpreterT m b
    $c>> :: forall (m :: * -> *) a b.
    Monad m =>
    InterpreterT m a -> InterpreterT m b -> InterpreterT m b
    >> :: forall a b.
    InterpreterT m a -> InterpreterT m b -> InterpreterT m b
    $creturn :: forall (m :: * -> *) a. Monad m => a -> InterpreterT m a
    return :: forall a. a -> InterpreterT m a
    Monad, Monad (InterpreterT m)
    Monad (InterpreterT m) =>
    (forall a. IO a -> InterpreterT m a) -> MonadIO (InterpreterT m)
    forall a. IO a -> InterpreterT m a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    forall (m :: * -> *). MonadIO m => Monad (InterpreterT m)
    forall (m :: * -> *) a. MonadIO m => IO a -> InterpreterT m a
    $cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> InterpreterT m a
    liftIO :: forall a. IO a -> InterpreterT m a
    MonadIO, Monad (InterpreterT m)
    Monad (InterpreterT m) =>
    (forall e a. (HasCallStack, Exception e) => e -> InterpreterT m a)
    -> MonadThrow (InterpreterT m)
    forall e a. (HasCallStack, Exception e) => e -> InterpreterT m a
    forall (m :: * -> *).
    Monad m =>
    (forall e a. (HasCallStack, Exception e) => e -> m a)
    -> MonadThrow m
    forall (m :: * -> *). MonadCatch m => Monad (InterpreterT m)
    forall (m :: * -> *) e a.
    (MonadCatch m, HasCallStack, Exception e) =>
    e -> InterpreterT m a
    $cthrowM :: forall (m :: * -> *) e a.
    (MonadCatch m, HasCallStack, Exception e) =>
    e -> InterpreterT m a
    throwM :: forall e a. (HasCallStack, Exception e) => e -> InterpreterT m a
    MonadThrow, MonadThrow (InterpreterT m)
    MonadThrow (InterpreterT m) =>
    (forall e a.
     (HasCallStack, Exception e) =>
     InterpreterT m a -> (e -> InterpreterT m a) -> InterpreterT m a)
    -> MonadCatch (InterpreterT m)
    forall e a.
    (HasCallStack, Exception e) =>
    InterpreterT m a -> (e -> InterpreterT m a) -> InterpreterT m a
    forall (m :: * -> *).
    (MonadIO m, MonadMask m) =>
    MonadThrow (InterpreterT m)
    forall (m :: * -> *) e a.
    (MonadIO m, MonadMask m, HasCallStack, Exception e) =>
    InterpreterT m a -> (e -> InterpreterT m a) -> InterpreterT 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.
    (MonadIO m, MonadMask m, HasCallStack, Exception e) =>
    InterpreterT m a -> (e -> InterpreterT m a) -> InterpreterT m a
    catch :: forall e a.
    (HasCallStack, Exception e) =>
    InterpreterT m a -> (e -> InterpreterT m a) -> InterpreterT m a
    MonadCatch, MonadCatch (InterpreterT m)
    MonadCatch (InterpreterT m) =>
    (forall b.
     HasCallStack =>
     ((forall a. InterpreterT m a -> InterpreterT m a)
      -> InterpreterT m b)
     -> InterpreterT m b)
    -> (forall b.
        HasCallStack =>
        ((forall a. InterpreterT m a -> InterpreterT m a)
         -> InterpreterT m b)
        -> InterpreterT m b)
    -> (forall a b c.
        HasCallStack =>
        InterpreterT m a
        -> (a -> ExitCase b -> InterpreterT m c)
        -> (a -> InterpreterT m b)
        -> InterpreterT m (b, c))
    -> MonadMask (InterpreterT m)
    forall b.
    HasCallStack =>
    ((forall a. InterpreterT m a -> InterpreterT m a)
     -> InterpreterT m b)
    -> InterpreterT m b
    forall a b c.
    HasCallStack =>
    InterpreterT m a
    -> (a -> ExitCase b -> InterpreterT m c)
    -> (a -> InterpreterT m b)
    -> InterpreterT m (b, c)
    forall (m :: * -> *).
    (MonadIO m, MonadMask m) =>
    MonadCatch (InterpreterT m)
    forall (m :: * -> *) b.
    (MonadIO m, MonadMask m, HasCallStack) =>
    ((forall a. InterpreterT m a -> InterpreterT m a)
     -> InterpreterT m b)
    -> InterpreterT m b
    forall (m :: * -> *) a b c.
    (MonadIO m, MonadMask m, HasCallStack) =>
    InterpreterT m a
    -> (a -> ExitCase b -> InterpreterT m c)
    -> (a -> InterpreterT m b)
    -> InterpreterT 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.
    (MonadIO m, MonadMask m, HasCallStack) =>
    ((forall a. InterpreterT m a -> InterpreterT m a)
     -> InterpreterT m b)
    -> InterpreterT m b
    mask :: forall b.
    HasCallStack =>
    ((forall a. InterpreterT m a -> InterpreterT m a)
     -> InterpreterT m b)
    -> InterpreterT m b
    $cuninterruptibleMask :: forall (m :: * -> *) b.
    (MonadIO m, MonadMask m, HasCallStack) =>
    ((forall a. InterpreterT m a -> InterpreterT m a)
     -> InterpreterT m b)
    -> InterpreterT m b
    uninterruptibleMask :: forall b.
    HasCallStack =>
    ((forall a. InterpreterT m a -> InterpreterT m a)
     -> InterpreterT m b)
    -> InterpreterT m b
    $cgeneralBracket :: forall (m :: * -> *) a b c.
    (MonadIO m, MonadMask m, HasCallStack) =>
    InterpreterT m a
    -> (a -> ExitCase b -> InterpreterT m c)
    -> (a -> InterpreterT m b)
    -> InterpreterT m (b, c)
    generalBracket :: forall a b c.
    HasCallStack =>
    InterpreterT m a
    -> (a -> ExitCase b -> InterpreterT m c)
    -> (a -> InterpreterT m b)
    -> InterpreterT m (b, c)
    MonadMask)

    execute :: (MonadIO m, MonadMask m)
            => String
            -> InterpreterSession
            -> InterpreterT m a
            -> m (Either InterpreterError a)
    execute :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    String
    -> InterpreterSession
    -> InterpreterT m a
    -> m (Either InterpreterError a)
    execute String
    libdir InterpreterSession
    s = m a -> m (Either InterpreterError a)
    forall (m :: * -> *) e a.
    (HasCallStack, MonadCatch m, Exception e) =>
    m a -> m (Either e a)
    try
                     (m a -> m (Either InterpreterError a))
    -> (InterpreterT m a -> m a)
    -> InterpreterT m a
    -> m (Either InterpreterError a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe String -> GhcT m a -> m a
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    Maybe String -> GhcT m a -> m a
    GHC.runGhcT (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    libdir)
                     (GhcT m a -> m a)
    -> (InterpreterT m a -> GhcT m a) -> InterpreterT m a -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ReaderT InterpreterSession (GhcT m) a
     -> InterpreterSession -> GhcT m a)
    -> InterpreterSession
    -> ReaderT InterpreterSession (GhcT m) a
    -> GhcT m a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT InterpreterSession (GhcT m) a
    -> InterpreterSession -> GhcT m a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT InterpreterSession
    s
                     (ReaderT InterpreterSession (GhcT m) a -> GhcT m a)
    -> (InterpreterT m a -> ReaderT InterpreterSession (GhcT m) a)
    -> InterpreterT m a
    -> GhcT m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InterpreterT m a -> ReaderT InterpreterSession (GhcT m) a
    forall (m :: * -> *) a.
    InterpreterT m a -> ReaderT InterpreterSession (GhcT m) a
    unInterpreterT

    instance MonadTrans InterpreterT where
        lift :: forall (m :: * -> *) a. Monad m => m a -> InterpreterT m a
    lift = ReaderT InterpreterSession (GhcT m) a -> InterpreterT m a
    forall (m :: * -> *) a.
    ReaderT InterpreterSession (GhcT m) a -> InterpreterT m a
    InterpreterT (ReaderT InterpreterSession (GhcT m) a -> InterpreterT m a)
    -> (m a -> ReaderT InterpreterSession (GhcT m) a)
    -> m a
    -> InterpreterT m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GhcT m a -> ReaderT InterpreterSession (GhcT m) a
    forall (m :: * -> *) a.
    Monad m =>
    m a -> ReaderT InterpreterSession m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (GhcT m a -> ReaderT InterpreterSession (GhcT m) a)
    -> (m a -> GhcT m a)
    -> m a
    -> ReaderT InterpreterSession (GhcT m) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m a -> GhcT m a
    forall (m :: * -> *) a. Monad m => m a -> GhcT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift

    runGhcImpl :: (MonadIO m, MonadMask m)
               => RunGhc (InterpreterT m) a
    runGhcImpl :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    RunGhc (InterpreterT m) a
    runGhcImpl forall (n :: * -> *). (MonadIO n, MonadMask n) => GhcT n a
    a =
      ReaderT InterpreterSession (GhcT m) a -> InterpreterT m a
    forall (m :: * -> *) a.
    ReaderT InterpreterSession (GhcT m) a -> InterpreterT m a
    InterpreterT (GhcT m a -> ReaderT InterpreterSession (GhcT m) a
    forall (m :: * -> *) a.
    Monad m =>
    m a -> ReaderT InterpreterSession m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift GhcT m a
    forall (n :: * -> *). (MonadIO n, MonadMask n) => GhcT n a
    a)
       InterpreterT m a
    -> [Handler (InterpreterT m) a] -> InterpreterT m a
    forall (f :: * -> *) (m :: * -> *) a.
    (HasCallStack, Foldable f, MonadCatch m) =>
    m a -> f (Handler m a) -> m a
    `catches`
       [(SourceError -> InterpreterT m a) -> Handler (InterpreterT m) a
    forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
    Handler (\(SourceError
    e :: GHC.SourceError)  -> do
         dynFlags <- RunGhc (InterpreterT m) DynFlags
    forall a. RunGhc (InterpreterT m) a
    forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
    runGhc GhcT n DynFlags
    forall {n :: * -> *}. (MonadIO n, MonadMask n) => GhcT n DynFlags
    forall (m :: * -> *). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
         throwM $ compilationError dynFlags e)
       ,(GhcApiError -> InterpreterT m a) -> Handler (InterpreterT m) a
    forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
    Handler (\(GhcApiError
    e :: GHC.GhcApiError)  -> InterpreterError -> InterpreterT m a
    forall e a. (HasCallStack, Exception e) => e -> InterpreterT m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (InterpreterError -> InterpreterT m a)
    -> InterpreterError -> InterpreterT m a
    forall a b. (a -> b) -> a -> b
    $ String -> InterpreterError
    GhcException (String -> InterpreterError) -> String -> InterpreterError
    forall a b. (a -> b) -> a -> b
    $ GhcApiError -> String
    forall a. Show a => a -> String
    show GhcApiError
    e)
       ,(GhcException -> InterpreterT m a) -> Handler (InterpreterT m) a
    forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
    Handler (\(GhcException
    e :: GHC.GhcException) -> InterpreterError -> InterpreterT m a
    forall e a. (HasCallStack, Exception e) => e -> InterpreterT m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (InterpreterError -> InterpreterT m a)
    -> InterpreterError -> InterpreterT m a
    forall a b. (a -> b) -> a -> b
    $ String -> InterpreterError
    GhcException (String -> InterpreterError) -> String -> InterpreterError
    forall a b. (a -> b) -> a -> b
    $ GhcException -> String
    showGhcEx GhcException
    e)
       ]
      where
        compilationError :: DynFlags -> SourceError -> InterpreterError
    compilationError DynFlags
    dynFlags
          = [GhcError] -> InterpreterError
    WontCompile
          ([GhcError] -> InterpreterError)
    -> (SourceError -> [GhcError]) -> SourceError -> InterpreterError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SDoc -> GhcError) -> [SDoc] -> [GhcError]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> GhcError
    GhcError (String -> GhcError) -> (SDoc -> String) -> SDoc -> GhcError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynFlags -> SDoc -> String
    GHC.showSDoc DynFlags
    dynFlags)
          ([SDoc] -> [GhcError])
    -> (SourceError -> [SDoc]) -> SourceError -> [GhcError]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ErrorMessages -> [SDoc]
    GHC.pprErrorMessages
          (ErrorMessages -> [SDoc])
    -> (SourceError -> ErrorMessages) -> SourceError -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SourceError -> ErrorMessages
    GHC.srcErrorMessages

    showGhcEx :: GHC.GhcException -> String
    showGhcEx :: GhcException -> String
    showGhcEx = (GhcException -> String -> String)
    -> String -> GhcException -> String
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (SDocContext -> GhcException -> String -> String
    GHC.showGhcException SDocContext
    GHC.defaultSDocContext) String
    ""

    -- ================= Executing the interpreter ==================

    initialize :: (MonadIO m, MonadThrow m, MonadMask m, Functor m)
               => [String]
               -> InterpreterT m ()
    initialize :: forall (m :: * -> *).
    (MonadIO m, MonadThrow m, MonadMask m, Functor m) =>
    [String] -> InterpreterT m ()
    initialize [String]
    args =
        do logger <- FromSession (InterpreterT m) Logger
    forall a. FromSession (InterpreterT m) a
    forall (m :: * -> *) a. MonadInterpreter m => FromSession m a
    fromSession InterpreterSession -> Logger
    forall a. SessionData a -> Logger
    ghcLogger
           -- Set a custom log handler, to intercept error messages :S
           df0 <- runGhc GHC.getSessionDynFlags

           let df1 = DynFlags -> DynFlags
    configureDynFlags DynFlags
    df0
           (df2, extra) <- runGhc $ parseDynamicFlags logger df1 args
           unless (null extra) $
                throwM $ UnknownError (concat [ "flags: '"
                                              , unwords extra
                                              , "' not recognized"])

           -- Observe that, setSessionDynFlags loads info on packages
           -- available; calling this function once is mandatory!
           runGhc $ GHC.modifyLogger (const logger)
           _ <- runGhc $ GHC.setSessionDynFlags df2

           let extMap      = [ (FlagSpec Extension -> String
    forall flag. FlagSpec flag -> String
    GHC.flagSpecName FlagSpec Extension
    flagSpec, FlagSpec Extension -> Extension
    forall flag. FlagSpec flag -> flag
    GHC.flagSpecFlag FlagSpec Extension
    flagSpec)
                             | FlagSpec Extension
    flagSpec <- [FlagSpec Extension]
    GHC.xFlags
                             ]
           let toOpt String
    e     = let err :: a
    err = String -> a
    forall a. HasCallStack => String -> a
    error (String
    "init error: unknown ext:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    e)
                             in Extension -> Maybe Extension -> Extension
    forall a. a -> Maybe a -> a
    fromMaybe Extension
    forall {a}. a
    err (String -> [(String, Extension)] -> Maybe Extension
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    e [(String, Extension)]
    extMap)
           let getOptVal String
    e = (String -> Extension
    asExtension String
    e, Extension -> DynFlags -> Bool
    GHC.xopt (String -> Extension
    toOpt String
    e) DynFlags
    df2)
           let defExts = (String -> (Extension, Bool)) -> [String] -> [(Extension, Bool)]
    forall a b. (a -> b) -> [a] -> [b]
    map  String -> (Extension, Bool)
    getOptVal [String]
    supportedExtensions

           onState (\InterpreterState
    s -> InterpreterState
    s{defaultExts = defExts})

           reset

    -- | Executes the interpreter. Returns @Left InterpreterError@ in case of error.
    --
    -- NB. In hint-0.7.0 and earlier, the underlying ghc was accidentally
    -- overwriting certain signal handlers (SIGINT, SIGHUP, SIGTERM, SIGQUIT on
    -- Posix systems, Ctrl-C handler on Windows).
    runInterpreter :: (MonadIO m, MonadMask m)
                   => InterpreterT m a
                   -> m (Either InterpreterError a)
    runInterpreter :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    InterpreterT m a -> m (Either InterpreterError a)
    runInterpreter = [String] -> InterpreterT m a -> m (Either InterpreterError a)
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    [String] -> InterpreterT m a -> m (Either InterpreterError a)
    runInterpreterWithArgs []

    -- | Executes the interpreter, setting args passed in as though they
    -- were command-line args. Returns @Left InterpreterError@ in case of
    -- error.
    runInterpreterWithArgs :: (MonadIO m, MonadMask m)
                           => [String]
                           -> InterpreterT m a
                           -> m (Either InterpreterError a)
    runInterpreterWithArgs :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    [String] -> InterpreterT m a -> m (Either InterpreterError a)
    runInterpreterWithArgs [String]
    args = [String]
    -> String -> InterpreterT m a -> m (Either InterpreterError a)
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    [String]
    -> String -> InterpreterT m a -> m (Either InterpreterError a)
    runInterpreterWithArgsLibdir [String]
    args String
    GHC.Paths.libdir

    runInterpreterWithArgsLibdir :: (MonadIO m, MonadMask m)
                                 => [String]
                                 -> String
                                 -> InterpreterT m a
                                 -> m (Either InterpreterError a)
    runInterpreterWithArgsLibdir :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    [String]
    -> String -> InterpreterT m a -> m (Either InterpreterError a)
    runInterpreterWithArgsLibdir [String]
    args String
    libdir InterpreterT m a
    action =
    #ifndef THREAD_SAFE_LINKER
      ifInterpreterNotRunning $
    #endif
        do s <- m InterpreterSession
    newInterpreterSession m InterpreterSession
    -> (GhcException -> m InterpreterSession) -> m InterpreterSession
    forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
    forall (m :: * -> *) e a.
    (MonadCatch m, HasCallStack, Exception e) =>
    m a -> (e -> m a) -> m a
    `MC.catch` GhcException -> m InterpreterSession
    forall {a}. GhcException -> m a
    rethrowGhcException
           execute libdir s (initialize args >> action `finally` cleanSession)
        where rethrowGhcException :: GhcException -> m a
    rethrowGhcException   = InterpreterError -> m a
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (InterpreterError -> m a)
    -> (GhcException -> InterpreterError) -> GhcException -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> InterpreterError
    GhcException (String -> InterpreterError)
    -> (GhcException -> String) -> GhcException -> InterpreterError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GhcException -> String
    showGhcEx
              newInterpreterSession :: m InterpreterSession
    newInterpreterSession = () -> m InterpreterSession
    forall (m :: * -> *) a. MonadIO m => a -> m (SessionData a)
    newSessionData ()
              cleanSession :: InterpreterT m ()
    cleanSession = InterpreterT m ()
    forall (m :: * -> *). MonadInterpreter m => m ()
    cleanPhantomModules

    #ifndef THREAD_SAFE_LINKER
    {-# NOINLINE uniqueToken #-}
    uniqueToken :: MVar ()
    uniqueToken = unsafePerformIO $ newMVar ()

    ifInterpreterNotRunning :: (MonadIO m, MonadMask m) => m a -> m a
    ifInterpreterNotRunning action = liftIO (tryTakeMVar uniqueToken) >>= \ case
        Nothing -> throwM MultipleInstancesNotAllowed
        Just x  -> action `finally` liftIO (putMVar uniqueToken x)
    #endif

    -- | The installed version of ghc is not thread-safe. This exception
    --   is thrown whenever you try to execute @runInterpreter@ while another
    --   instance is already running.
    data MultipleInstancesNotAllowed = MultipleInstancesNotAllowed deriving Typeable

    instance Exception MultipleInstancesNotAllowed

    instance Show MultipleInstancesNotAllowed where
        show :: MultipleInstancesNotAllowed -> String
    show MultipleInstancesNotAllowed
    _ = String
    "This version of GHC is not thread-safe," String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                 String
    "can't safely run two instances of the interpreter simultaneously"

    initialState :: InterpreterState
    initialState :: InterpreterState
    initialState = St {
                       activePhantoms :: [PhantomModule]
    activePhantoms    = [],
                       zombiePhantoms :: [PhantomModule]
    zombiePhantoms    = [],
                       phantomDirectory :: Maybe String
    phantomDirectory  = Maybe String
    forall a. Maybe a
    Nothing,
                       hintSupportModule :: PhantomModule
    hintSupportModule = String -> PhantomModule
    forall a. HasCallStack => String -> a
    error String
    "No support module loaded!",
                       importQualHackMod :: Maybe PhantomModule
    importQualHackMod = Maybe PhantomModule
    forall a. Maybe a
    Nothing,
                       qualImports :: [ModuleImport]
    qualImports       = [],
                       defaultExts :: [(Extension, Bool)]
    defaultExts       = String -> [(Extension, Bool)]
    forall a. HasCallStack => String -> a
    error String
    "defaultExts missing!",
                       configuration :: InterpreterConfiguration
    configuration     = InterpreterConfiguration
    defaultConf
                      }

    newSessionData :: MonadIO m => a -> m (SessionData a)
    newSessionData :: forall (m :: * -> *) a. MonadIO m => a -> m (SessionData a)
    newSessionData a
    a =
        do initial_state    <- IO (IORef InterpreterState) -> m (IORef InterpreterState)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef InterpreterState) -> m (IORef InterpreterState))
    -> IO (IORef InterpreterState) -> m (IORef InterpreterState)
    forall a b. (a -> b) -> a -> b
    $ InterpreterState -> IO (IORef InterpreterState)
    forall a. a -> IO (IORef a)
    newIORef InterpreterState
    initialState
           ghc_err_list_ref <- liftIO $ newIORef []
           logger           <- liftIO $ GHC.initLogger
           return SessionData {
             internalState   = initial_state,
             versionSpecific = a,
             ghcErrListRef   = ghc_err_list_ref,
             ghcLogger       = GHC.pushLogHook (const $ GHC.mkLogAction GhcError ghc_err_list_ref) logger
           }

    -- The MonadInterpreter instance

    instance (MonadIO m, MonadMask m, Functor m) => MonadInterpreter (InterpreterT m) where
        fromSession :: forall a. FromSession (InterpreterT m) a
    fromSession InterpreterSession -> a
    f = ReaderT InterpreterSession (GhcT m) a -> InterpreterT m a
    forall (m :: * -> *) a.
    ReaderT InterpreterSession (GhcT m) a -> InterpreterT m a
    InterpreterT (ReaderT InterpreterSession (GhcT m) a -> InterpreterT m a)
    -> ReaderT InterpreterSession (GhcT m) a -> InterpreterT m a
    forall a b. (a -> b) -> a -> b
    $ (InterpreterSession -> a) -> ReaderT InterpreterSession (GhcT m) a
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks InterpreterSession -> a
    f
        --
        modifySessionRef :: forall a. ModifySessionRef (InterpreterT m) a
    modifySessionRef InterpreterSession -> IORef a
    target a -> a
    f =
            do ref <- FromSession (InterpreterT m) (IORef a)
    forall a. FromSession (InterpreterT m) a
    forall (m :: * -> *) a. MonadInterpreter m => FromSession m a
    fromSession InterpreterSession -> IORef a
    target
               liftIO $ atomicModifyIORef ref (\a
    a -> (a -> a
    f a
    a, a
    a))
        --
        runGhc :: forall a. RunGhc (InterpreterT m) a
    runGhc = RunGhc (InterpreterT m) a
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    RunGhc (InterpreterT m) a
    runGhcImpl

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