{-# LANGUAGE CPP, UnicodeSyntax, GeneralizedNewtypeDeriving, ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PackageImports #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module HsDev.Tools.Ghc.MGhc (
	Session(..), sessionKey, sessionData,
	SessionState(..), sessionActive, sessionMap,
	MGhcT(..), runMGhcT, liftGhc,
	currentSession, getSessionData, setSessionData, hasSession, findSession, findSessionBy, saveSession,
	initSession, newSession,
	switchSession, switchSession_,
	deleteSession, restoreSession, usingSession, tempSession
	) where

import Control.Lens
import Control.Monad.Fail as Fail
import Control.Monad.Morph
import Control.Monad.Catch
import Control.Monad.Reader
import Control.Monad.State
import Data.Default as Def
import Data.IORef
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, isJust)
import System.Log.Simple.Monad (MonadLog(..))

import HsDev.Tools.Ghc.Compat (cleanTemps)

import "ghc" DynFlags
import "ghc" Exception hiding (catch, mask, uninterruptibleMask, bracket, finally)
import "ghc" GHC
import "ghc" GHCi
import "ghc" GhcMonad hiding (Session(..))
import qualified "ghc" GhcMonad (Session(..))
import "ghc" HscTypes
import "ghc" Outputable

data Session s d = Session {
	Session s d -> s
_sessionKey :: s,
	Session s d -> d
_sessionData :: d }
		deriving (Session s d -> Session s d -> Bool
(Session s d -> Session s d -> Bool)
-> (Session s d -> Session s d -> Bool) -> Eq (Session s d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s d. (Eq s, Eq d) => Session s d -> Session s d -> Bool
/= :: Session s d -> Session s d -> Bool
$c/= :: forall s d. (Eq s, Eq d) => Session s d -> Session s d -> Bool
== :: Session s d -> Session s d -> Bool
$c== :: forall s d. (Eq s, Eq d) => Session s d -> Session s d -> Bool
Eq, Eq (Session s d)
Eq (Session s d)
-> (Session s d -> Session s d -> Ordering)
-> (Session s d -> Session s d -> Bool)
-> (Session s d -> Session s d -> Bool)
-> (Session s d -> Session s d -> Bool)
-> (Session s d -> Session s d -> Bool)
-> (Session s d -> Session s d -> Session s d)
-> (Session s d -> Session s d -> Session s d)
-> Ord (Session s d)
Session s d -> Session s d -> Bool
Session s d -> Session s d -> Ordering
Session s d -> Session s d -> Session s d
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall s d. (Ord s, Ord d) => Eq (Session s d)
forall s d. (Ord s, Ord d) => Session s d -> Session s d -> Bool
forall s d.
(Ord s, Ord d) =>
Session s d -> Session s d -> Ordering
forall s d.
(Ord s, Ord d) =>
Session s d -> Session s d -> Session s d
min :: Session s d -> Session s d -> Session s d
$cmin :: forall s d.
(Ord s, Ord d) =>
Session s d -> Session s d -> Session s d
max :: Session s d -> Session s d -> Session s d
$cmax :: forall s d.
(Ord s, Ord d) =>
Session s d -> Session s d -> Session s d
>= :: Session s d -> Session s d -> Bool
$c>= :: forall s d. (Ord s, Ord d) => Session s d -> Session s d -> Bool
> :: Session s d -> Session s d -> Bool
$c> :: forall s d. (Ord s, Ord d) => Session s d -> Session s d -> Bool
<= :: Session s d -> Session s d -> Bool
$c<= :: forall s d. (Ord s, Ord d) => Session s d -> Session s d -> Bool
< :: Session s d -> Session s d -> Bool
$c< :: forall s d. (Ord s, Ord d) => Session s d -> Session s d -> Bool
compare :: Session s d -> Session s d -> Ordering
$ccompare :: forall s d.
(Ord s, Ord d) =>
Session s d -> Session s d -> Ordering
$cp1Ord :: forall s d. (Ord s, Ord d) => Eq (Session s d)
Ord, ReadPrec [Session s d]
ReadPrec (Session s d)
Int -> ReadS (Session s d)
ReadS [Session s d]
(Int -> ReadS (Session s d))
-> ReadS [Session s d]
-> ReadPrec (Session s d)
-> ReadPrec [Session s d]
-> Read (Session s d)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall s d. (Read s, Read d) => ReadPrec [Session s d]
forall s d. (Read s, Read d) => ReadPrec (Session s d)
forall s d. (Read s, Read d) => Int -> ReadS (Session s d)
forall s d. (Read s, Read d) => ReadS [Session s d]
readListPrec :: ReadPrec [Session s d]
$creadListPrec :: forall s d. (Read s, Read d) => ReadPrec [Session s d]
readPrec :: ReadPrec (Session s d)
$creadPrec :: forall s d. (Read s, Read d) => ReadPrec (Session s d)
readList :: ReadS [Session s d]
$creadList :: forall s d. (Read s, Read d) => ReadS [Session s d]
readsPrec :: Int -> ReadS (Session s d)
$creadsPrec :: forall s d. (Read s, Read d) => Int -> ReadS (Session s d)
Read, Int -> Session s d -> ShowS
[Session s d] -> ShowS
Session s d -> String
(Int -> Session s d -> ShowS)
-> (Session s d -> String)
-> ([Session s d] -> ShowS)
-> Show (Session s d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s d. (Show s, Show d) => Int -> Session s d -> ShowS
forall s d. (Show s, Show d) => [Session s d] -> ShowS
forall s d. (Show s, Show d) => Session s d -> String
showList :: [Session s d] -> ShowS
$cshowList :: forall s d. (Show s, Show d) => [Session s d] -> ShowS
show :: Session s d -> String
$cshow :: forall s d. (Show s, Show d) => Session s d -> String
showsPrec :: Int -> Session s d -> ShowS
$cshowsPrec :: forall s d. (Show s, Show d) => Int -> Session s d -> ShowS
Show)

sessionKey :: Lens' (Session s d) s
sessionKey :: (s -> f s) -> Session s d -> f (Session s d)
sessionKey = (Session s d -> s)
-> (Session s d -> s -> Session s d)
-> Lens (Session s d) (Session s d) s s
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Session s d -> s
forall s d. Session s d -> s
g Session s d -> s -> Session s d
forall s d s. Session s d -> s -> Session s d
s where
	g :: Session s d -> s
g = Session s d -> s
forall s d. Session s d -> s
_sessionKey
	s :: Session s d -> s -> Session s d
s Session s d
sess s
k = Session s d
sess { _sessionKey :: s
_sessionKey = s
k }

sessionData :: Lens' (Session s d) d
sessionData :: (d -> f d) -> Session s d -> f (Session s d)
sessionData = (Session s d -> d)
-> (Session s d -> d -> Session s d)
-> Lens (Session s d) (Session s d) d d
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Session s d -> d
forall s d. Session s d -> d
g Session s d -> d -> Session s d
forall s d d. Session s d -> d -> Session s d
s where
	g :: Session s d -> d
g = Session s d -> d
forall s d. Session s d -> d
_sessionData
	s :: Session s d -> d -> Session s d
s Session s d
sess d
dat = Session s d
sess { _sessionData :: d
_sessionData = d
dat }

data SessionState s d = SessionState {
	SessionState s d -> Maybe (Session s d)
_sessionActive :: Maybe (Session s d),
	SessionState s d -> Map s (HscEnv, d)
_sessionMap :: Map s (HscEnv, d) }

instance Default (SessionState s d) where
	def :: SessionState s d
def = Maybe (Session s d) -> Map s (HscEnv, d) -> SessionState s d
forall s d.
Maybe (Session s d) -> Map s (HscEnv, d) -> SessionState s d
SessionState Maybe (Session s d)
forall a. Maybe a
Nothing Map s (HscEnv, d)
forall k a. Map k a
M.empty

sessionActive :: Lens' (SessionState s d) (Maybe (Session s d))
sessionActive :: (Maybe (Session s d) -> f (Maybe (Session s d)))
-> SessionState s d -> f (SessionState s d)
sessionActive = (SessionState s d -> Maybe (Session s d))
-> (SessionState s d -> Maybe (Session s d) -> SessionState s d)
-> Lens
     (SessionState s d)
     (SessionState s d)
     (Maybe (Session s d))
     (Maybe (Session s d))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SessionState s d -> Maybe (Session s d)
forall s d. SessionState s d -> Maybe (Session s d)
g SessionState s d -> Maybe (Session s d) -> SessionState s d
forall s d.
SessionState s d -> Maybe (Session s d) -> SessionState s d
s where
	g :: SessionState s d -> Maybe (Session s d)
g = SessionState s d -> Maybe (Session s d)
forall s d. SessionState s d -> Maybe (Session s d)
_sessionActive
	s :: SessionState s d -> Maybe (Session s d) -> SessionState s d
s SessionState s d
st Maybe (Session s d)
nm = SessionState s d
st { _sessionActive :: Maybe (Session s d)
_sessionActive = Maybe (Session s d)
nm }

sessionMap :: Lens' (SessionState s d) (Map s (HscEnv, d))
sessionMap :: (Map s (HscEnv, d) -> f (Map s (HscEnv, d)))
-> SessionState s d -> f (SessionState s d)
sessionMap = (SessionState s d -> Map s (HscEnv, d))
-> (SessionState s d -> Map s (HscEnv, d) -> SessionState s d)
-> Lens
     (SessionState s d)
     (SessionState s d)
     (Map s (HscEnv, d))
     (Map s (HscEnv, d))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SessionState s d -> Map s (HscEnv, d)
forall s d. SessionState s d -> Map s (HscEnv, d)
g SessionState s d -> Map s (HscEnv, d) -> SessionState s d
forall s d.
SessionState s d -> Map s (HscEnv, d) -> SessionState s d
s where
	g :: SessionState s d -> Map s (HscEnv, d)
g = SessionState s d -> Map s (HscEnv, d)
forall s d. SessionState s d -> Map s (HscEnv, d)
_sessionMap
	s :: SessionState s d -> Map s (HscEnv, d) -> SessionState s d
s SessionState s d
st Map s (HscEnv, d)
m = SessionState s d
st { _sessionMap :: Map s (HscEnv, d)
_sessionMap = Map s (HscEnv, d)
m }

instance ExceptionMonad m => ExceptionMonad (StateT s m) where
	gcatch :: StateT s m a -> (e -> StateT s m a) -> StateT s m a
gcatch StateT s m a
act e -> StateT s m a
onErr = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
st -> m (a, s) -> (e -> m (a, s)) -> m (a, s)
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
gcatch (StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
act s
st) (\e
e -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (e -> StateT s m a
onErr e
e) s
st)
	gmask :: ((StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b
gmask (StateT s m a -> StateT s m a) -> StateT s m b
f = (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ ((m (a, s) -> m (a, s)) -> m (b, s)) -> m (b, s)
forall (m :: * -> *) a b.
ExceptionMonad m =>
((m a -> m a) -> m b) -> m b
gmask (((m (a, s) -> m (a, s)) -> m (b, s)) -> m (b, s))
-> (s -> (m (a, s) -> m (a, s)) -> m (b, s)) -> s -> m (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> (m (a, s) -> m (a, s)) -> m (b, s)
f' where
		f' :: s -> (m (a, s) -> m (a, s)) -> m (b, s)
f' s
st' m (a, s) -> m (a, s)
act' = StateT s m b -> s -> m (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((StateT s m a -> StateT s m a) -> StateT s m b
f StateT s m a -> StateT s m a
act) s
st' where
			act :: StateT s m a -> StateT s m a
act StateT s m a
st = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ m (a, s) -> m (a, s)
act' (m (a, s) -> m (a, s)) -> (s -> m (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
st

instance ExceptionMonad m => ExceptionMonad (ReaderT r m) where
	gcatch :: ReaderT r m a -> (e -> ReaderT r m a) -> ReaderT r m a
gcatch ReaderT r m a
act e -> ReaderT r m a
onErr = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \r
v -> m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
gcatch (ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
act r
v) (\e
e -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (e -> ReaderT r m a
onErr e
e) r
v)
	gmask :: ((ReaderT r m a -> ReaderT r m a) -> ReaderT r m b)
-> ReaderT r m b
gmask (ReaderT r m a -> ReaderT r m a) -> ReaderT r m b
f = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ ((m a -> m a) -> m b) -> m b
forall (m :: * -> *) a b.
ExceptionMonad m =>
((m a -> m a) -> m b) -> m b
gmask (((m a -> m a) -> m b) -> m b)
-> (r -> (m a -> m a) -> m b) -> r -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> (m a -> m a) -> m b
f' where
		f' :: r -> (m a -> m a) -> m b
f' r
v' m a -> m a
act' = ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((ReaderT r m a -> ReaderT r m a) -> ReaderT r m b
f ReaderT r m a -> ReaderT r m a
forall r. ReaderT r m a -> ReaderT r m a
act) r
v' where
			act :: ReaderT r m a -> ReaderT r m a
act ReaderT r m a
v = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ m a -> m a
act' (m a -> m a) -> (r -> m a) -> r -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
v

-- | Multi-session ghc monad
newtype MGhcT s d m a = MGhcT { MGhcT s d m a
-> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
unMGhcT :: GhcT (ReaderT (Maybe FilePath) (StateT (SessionState s d) m)) a }
	deriving (a -> MGhcT s d m b -> MGhcT s d m a
(a -> b) -> MGhcT s d m a -> MGhcT s d m b
(forall a b. (a -> b) -> MGhcT s d m a -> MGhcT s d m b)
-> (forall a b. a -> MGhcT s d m b -> MGhcT s d m a)
-> Functor (MGhcT s d m)
forall a b. a -> MGhcT s d m b -> MGhcT s d m a
forall a b. (a -> b) -> MGhcT s d m a -> MGhcT s d m b
forall s d (m :: * -> *) a b.
Functor m =>
a -> MGhcT s d m b -> MGhcT s d m a
forall s d (m :: * -> *) a b.
Functor m =>
(a -> b) -> MGhcT s d m a -> MGhcT s d m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MGhcT s d m b -> MGhcT s d m a
$c<$ :: forall s d (m :: * -> *) a b.
Functor m =>
a -> MGhcT s d m b -> MGhcT s d m a
fmap :: (a -> b) -> MGhcT s d m a -> MGhcT s d m b
$cfmap :: forall s d (m :: * -> *) a b.
Functor m =>
(a -> b) -> MGhcT s d m a -> MGhcT s d m b
Functor, Functor (MGhcT s d m)
a -> MGhcT s d m a
Functor (MGhcT s d m)
-> (forall a. a -> MGhcT s d m a)
-> (forall a b.
    MGhcT s d m (a -> b) -> MGhcT s d m a -> MGhcT s d m b)
-> (forall a b c.
    (a -> b -> c) -> MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m c)
-> (forall a b. MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b)
-> (forall a b. MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a)
-> Applicative (MGhcT s d m)
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a
MGhcT s d m (a -> b) -> MGhcT s d m a -> MGhcT s d m b
(a -> b -> c) -> MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m c
forall a. a -> MGhcT s d m a
forall a b. MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a
forall a b. MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b
forall a b. MGhcT s d m (a -> b) -> MGhcT s d m a -> MGhcT s d m b
forall a b c.
(a -> b -> c) -> MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m c
forall s d (m :: * -> *). Monad m => Functor (MGhcT s d m)
forall s d (m :: * -> *) a. Monad m => a -> MGhcT s d m a
forall s d (m :: * -> *) a b.
Monad m =>
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a
forall s d (m :: * -> *) a b.
Monad m =>
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b
forall s d (m :: * -> *) a b.
Monad m =>
MGhcT s d m (a -> b) -> MGhcT s d m a -> MGhcT s d m b
forall s d (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MGhcT s d m a -> MGhcT s d m b -> MGhcT s d 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
<* :: MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a
$c<* :: forall s d (m :: * -> *) a b.
Monad m =>
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a
*> :: MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b
$c*> :: forall s d (m :: * -> *) a b.
Monad m =>
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b
liftA2 :: (a -> b -> c) -> MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m c
$cliftA2 :: forall s d (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m c
<*> :: MGhcT s d m (a -> b) -> MGhcT s d m a -> MGhcT s d m b
$c<*> :: forall s d (m :: * -> *) a b.
Monad m =>
MGhcT s d m (a -> b) -> MGhcT s d m a -> MGhcT s d m b
pure :: a -> MGhcT s d m a
$cpure :: forall s d (m :: * -> *) a. Monad m => a -> MGhcT s d m a
$cp1Applicative :: forall s d (m :: * -> *). Monad m => Functor (MGhcT s d m)
Applicative, Applicative (MGhcT s d m)
a -> MGhcT s d m a
Applicative (MGhcT s d m)
-> (forall a b.
    MGhcT s d m a -> (a -> MGhcT s d m b) -> MGhcT s d m b)
-> (forall a b. MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b)
-> (forall a. a -> MGhcT s d m a)
-> Monad (MGhcT s d m)
MGhcT s d m a -> (a -> MGhcT s d m b) -> MGhcT s d m b
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b
forall a. a -> MGhcT s d m a
forall a b. MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b
forall a b. MGhcT s d m a -> (a -> MGhcT s d m b) -> MGhcT s d m b
forall s d (m :: * -> *). Monad m => Applicative (MGhcT s d m)
forall s d (m :: * -> *) a. Monad m => a -> MGhcT s d m a
forall s d (m :: * -> *) a b.
Monad m =>
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b
forall s d (m :: * -> *) a b.
Monad m =>
MGhcT s d m a -> (a -> MGhcT s d m b) -> MGhcT s d m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> MGhcT s d m a
$creturn :: forall s d (m :: * -> *) a. Monad m => a -> MGhcT s d m a
>> :: MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b
$c>> :: forall s d (m :: * -> *) a b.
Monad m =>
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m b
>>= :: MGhcT s d m a -> (a -> MGhcT s d m b) -> MGhcT s d m b
$c>>= :: forall s d (m :: * -> *) a b.
Monad m =>
MGhcT s d m a -> (a -> MGhcT s d m b) -> MGhcT s d m b
$cp1Monad :: forall s d (m :: * -> *). Monad m => Applicative (MGhcT s d m)
Monad, Monad (MGhcT s d m)
Monad (MGhcT s d m)
-> (forall a. String -> MGhcT s d m a) -> MonadFail (MGhcT s d m)
String -> MGhcT s d m a
forall a. String -> MGhcT s d m a
forall s d (m :: * -> *). MonadFail m => Monad (MGhcT s d m)
forall s d (m :: * -> *) a. MonadFail m => String -> MGhcT s d m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> MGhcT s d m a
$cfail :: forall s d (m :: * -> *) a. MonadFail m => String -> MGhcT s d m a
$cp1MonadFail :: forall s d (m :: * -> *). MonadFail m => Monad (MGhcT s d m)
MonadFail, Monad (MGhcT s d m)
Monad (MGhcT s d m)
-> (forall a. IO a -> MGhcT s d m a) -> MonadIO (MGhcT s d m)
IO a -> MGhcT s d m a
forall a. IO a -> MGhcT s d m a
forall s d (m :: * -> *). MonadIO m => Monad (MGhcT s d m)
forall s d (m :: * -> *) a. MonadIO m => IO a -> MGhcT s d m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> MGhcT s d m a
$cliftIO :: forall s d (m :: * -> *) a. MonadIO m => IO a -> MGhcT s d m a
$cp1MonadIO :: forall s d (m :: * -> *). MonadIO m => Monad (MGhcT s d m)
MonadIO, MonadIO (MGhcT s d m)
MonadIO (MGhcT s d m)
-> (forall e a.
    Exception e =>
    MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a)
-> (forall a b.
    ((MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
    -> MGhcT s d m b)
-> (forall a b c.
    MGhcT s d m a
    -> (a -> MGhcT s d m b) -> (a -> MGhcT s d m c) -> MGhcT s d m c)
-> (forall a b. MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a)
-> ExceptionMonad (MGhcT s d m)
MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a
MGhcT s d m a
-> (a -> MGhcT s d m b) -> (a -> MGhcT s d m c) -> MGhcT s d m c
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a
((MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
forall e a.
Exception e =>
MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a
forall a b. MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a
forall a b.
((MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
forall a b c.
MGhcT s d m a
-> (a -> MGhcT s d m b) -> (a -> MGhcT s d m c) -> MGhcT s d m c
forall s d (m :: * -> *). ExceptionMonad m => MonadIO (MGhcT s d m)
forall s d (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a
forall s d (m :: * -> *) a b.
ExceptionMonad m =>
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a
forall s d (m :: * -> *) a b.
ExceptionMonad m =>
((MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
forall s d (m :: * -> *) a b c.
ExceptionMonad m =>
MGhcT s d m a
-> (a -> MGhcT s d m b) -> (a -> MGhcT s d m c) -> MGhcT s d m c
forall (m :: * -> *).
MonadIO m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. ((m a -> m a) -> m b) -> m b)
-> (forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c)
-> (forall a b. m a -> m b -> m a)
-> ExceptionMonad m
gfinally :: MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a
$cgfinally :: forall s d (m :: * -> *) a b.
ExceptionMonad m =>
MGhcT s d m a -> MGhcT s d m b -> MGhcT s d m a
gbracket :: MGhcT s d m a
-> (a -> MGhcT s d m b) -> (a -> MGhcT s d m c) -> MGhcT s d m c
$cgbracket :: forall s d (m :: * -> *) a b c.
ExceptionMonad m =>
MGhcT s d m a
-> (a -> MGhcT s d m b) -> (a -> MGhcT s d m c) -> MGhcT s d m c
gmask :: ((MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
$cgmask :: forall s d (m :: * -> *) a b.
ExceptionMonad m =>
((MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
gcatch :: MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a
$cgcatch :: forall s d (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a
$cp1ExceptionMonad :: forall s d (m :: * -> *). ExceptionMonad m => MonadIO (MGhcT s d m)
ExceptionMonad, MGhcT s d m DynFlags
MGhcT s d m DynFlags -> HasDynFlags (MGhcT s d m)
forall s d (m :: * -> *). MonadIO m => MGhcT s d m DynFlags
forall (m :: * -> *). m DynFlags -> HasDynFlags m
getDynFlags :: MGhcT s d m DynFlags
$cgetDynFlags :: forall s d (m :: * -> *). MonadIO m => MGhcT s d m DynFlags
HasDynFlags, Functor (MGhcT s d m)
MonadIO (MGhcT s d m)
HasDynFlags (MGhcT s d m)
ExceptionMonad (MGhcT s d m)
MGhcT s d m HscEnv
Functor (MGhcT s d m)
-> MonadIO (MGhcT s d m)
-> ExceptionMonad (MGhcT s d m)
-> HasDynFlags (MGhcT s d m)
-> MGhcT s d m HscEnv
-> (HscEnv -> MGhcT s d m ())
-> GhcMonad (MGhcT s d m)
HscEnv -> MGhcT s d m ()
forall s d (m :: * -> *). ExceptionMonad m => Functor (MGhcT s d m)
forall s d (m :: * -> *). ExceptionMonad m => MonadIO (MGhcT s d m)
forall s d (m :: * -> *).
ExceptionMonad m =>
HasDynFlags (MGhcT s d m)
forall s d (m :: * -> *).
ExceptionMonad m =>
ExceptionMonad (MGhcT s d m)
forall s d (m :: * -> *). ExceptionMonad m => MGhcT s d m HscEnv
forall s d (m :: * -> *).
ExceptionMonad m =>
HscEnv -> MGhcT s d m ()
forall (m :: * -> *).
Functor m
-> MonadIO m
-> ExceptionMonad m
-> HasDynFlags m
-> m HscEnv
-> (HscEnv -> m ())
-> GhcMonad m
setSession :: HscEnv -> MGhcT s d m ()
$csetSession :: forall s d (m :: * -> *).
ExceptionMonad m =>
HscEnv -> MGhcT s d m ()
getSession :: MGhcT s d m HscEnv
$cgetSession :: forall s d (m :: * -> *). ExceptionMonad m => MGhcT s d m HscEnv
$cp4GhcMonad :: forall s d (m :: * -> *).
ExceptionMonad m =>
HasDynFlags (MGhcT s d m)
$cp3GhcMonad :: forall s d (m :: * -> *).
ExceptionMonad m =>
ExceptionMonad (MGhcT s d m)
$cp2GhcMonad :: forall s d (m :: * -> *). ExceptionMonad m => MonadIO (MGhcT s d m)
$cp1GhcMonad :: forall s d (m :: * -> *). ExceptionMonad m => Functor (MGhcT s d m)
GhcMonad, MonadState (SessionState s d), MonadReader (Maybe FilePath), Monad (MGhcT s d m)
e -> MGhcT s d m a
Monad (MGhcT s d m)
-> (forall e a. Exception e => e -> MGhcT s d m a)
-> MonadThrow (MGhcT s d m)
forall e a. Exception e => e -> MGhcT s d m a
forall s d (m :: * -> *). MonadThrow m => Monad (MGhcT s d m)
forall s d (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> MGhcT s d m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> MGhcT s d m a
$cthrowM :: forall s d (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> MGhcT s d m a
$cp1MonadThrow :: forall s d (m :: * -> *). MonadThrow m => Monad (MGhcT s d m)
MonadThrow, MonadThrow (MGhcT s d m)
MonadThrow (MGhcT s d m)
-> (forall e a.
    Exception e =>
    MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a)
-> MonadCatch (MGhcT s d m)
MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a
forall e a.
Exception e =>
MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a
forall s d (m :: * -> *). MonadCatch m => MonadThrow (MGhcT s d m)
forall s d (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a
$ccatch :: forall s d (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
MGhcT s d m a -> (e -> MGhcT s d m a) -> MGhcT s d m a
$cp1MonadCatch :: forall s d (m :: * -> *). MonadCatch m => MonadThrow (MGhcT s d m)
MonadCatch, MonadCatch (MGhcT s d m)
MonadCatch (MGhcT s d m)
-> (forall b.
    ((forall a. MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
    -> MGhcT s d m b)
-> (forall b.
    ((forall a. MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
    -> MGhcT s d m b)
-> (forall a b c.
    MGhcT s d m a
    -> (a -> ExitCase b -> MGhcT s d m c)
    -> (a -> MGhcT s d m b)
    -> MGhcT s d m (b, c))
-> MonadMask (MGhcT s d m)
MGhcT s d m a
-> (a -> ExitCase b -> MGhcT s d m c)
-> (a -> MGhcT s d m b)
-> MGhcT s d m (b, c)
((forall a. MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
((forall a. MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
forall b.
((forall a. MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
forall a b c.
MGhcT s d m a
-> (a -> ExitCase b -> MGhcT s d m c)
-> (a -> MGhcT s d m b)
-> MGhcT s d m (b, c)
forall s d (m :: * -> *). MonadMask m => MonadCatch (MGhcT s d m)
forall s d (m :: * -> *) b.
MonadMask m =>
((forall a. MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
forall s d (m :: * -> *) a b c.
MonadMask m =>
MGhcT s d m a
-> (a -> ExitCase b -> MGhcT s d m c)
-> (a -> MGhcT s d m b)
-> MGhcT s d m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: MGhcT s d m a
-> (a -> ExitCase b -> MGhcT s d m c)
-> (a -> MGhcT s d m b)
-> MGhcT s d m (b, c)
$cgeneralBracket :: forall s d (m :: * -> *) a b c.
MonadMask m =>
MGhcT s d m a
-> (a -> ExitCase b -> MGhcT s d m c)
-> (a -> MGhcT s d m b)
-> MGhcT s d m (b, c)
uninterruptibleMask :: ((forall a. MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
$cuninterruptibleMask :: forall s d (m :: * -> *) b.
MonadMask m =>
((forall a. MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
mask :: ((forall a. MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
$cmask :: forall s d (m :: * -> *) b.
MonadMask m =>
((forall a. MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m b)
-> MGhcT s d m b
$cp1MonadMask :: forall s d (m :: * -> *). MonadMask m => MonadCatch (MGhcT s d m)
MonadMask, MonadIO (MGhcT s d m)
MonadMask (MGhcT s d m)
MGhcT s d m Log
MonadIO (MGhcT s d m)
-> MonadMask (MGhcT s d m)
-> MGhcT s d m Log
-> (forall a. (Log -> Log) -> MGhcT s d m a -> MGhcT s d m a)
-> MonadLog (MGhcT s d m)
(Log -> Log) -> MGhcT s d m a -> MGhcT s d m a
forall a. (Log -> Log) -> MGhcT s d m a -> MGhcT s d m a
forall s d (m :: * -> *). MonadLog m => MonadIO (MGhcT s d m)
forall s d (m :: * -> *). MonadLog m => MonadMask (MGhcT s d m)
forall s d (m :: * -> *). MonadLog m => MGhcT s d m Log
forall s d (m :: * -> *) a.
MonadLog m =>
(Log -> Log) -> MGhcT s d m a -> MGhcT s d m a
forall (m :: * -> *).
MonadIO m
-> MonadMask m
-> m Log
-> (forall a. (Log -> Log) -> m a -> m a)
-> MonadLog m
localLog :: (Log -> Log) -> MGhcT s d m a -> MGhcT s d m a
$clocalLog :: forall s d (m :: * -> *) a.
MonadLog m =>
(Log -> Log) -> MGhcT s d m a -> MGhcT s d m a
askLog :: MGhcT s d m Log
$caskLog :: forall s d (m :: * -> *). MonadLog m => MGhcT s d m Log
$cp2MonadLog :: forall s d (m :: * -> *). MonadLog m => MonadMask (MGhcT s d m)
$cp1MonadLog :: forall s d (m :: * -> *). MonadLog m => MonadIO (MGhcT s d m)
MonadLog)

instance MonadTrans GhcT where
	lift :: m a -> GhcT m a
lift = m a -> GhcT m a
forall (m :: * -> *) a. m a -> GhcT m a
liftGhcT

instance MFunctor GhcT where
	hoist :: (forall a. m a -> n a) -> GhcT m b -> GhcT n b
hoist forall a. m a -> n a
fn = (Session -> n b) -> GhcT n b
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> n b) -> GhcT n b)
-> (GhcT m b -> Session -> n b) -> GhcT m b -> GhcT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m b -> n b
forall a. m a -> n a
fn (m b -> n b) -> (Session -> m b) -> Session -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Session -> m b) -> Session -> n b)
-> (GhcT m b -> Session -> m b) -> GhcT m b -> Session -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcT m b -> Session -> m b
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT

instance MonadFail m => MonadFail (GhcT m) where
	fail :: String -> GhcT m a
fail = m a -> GhcT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GhcT m a) -> (String -> m a) -> String -> GhcT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail

instance MonadState st m => MonadState st (GhcT m) where
	get :: GhcT m st
get = m st -> GhcT m st
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m st
forall s (m :: * -> *). MonadState s m => m s
get
	put :: st -> GhcT m ()
put = m () -> GhcT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GhcT m ()) -> (st -> m ()) -> st -> GhcT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
	state :: (st -> (a, st)) -> GhcT m a
state = m a -> GhcT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GhcT m a)
-> ((st -> (a, st)) -> m a) -> (st -> (a, st)) -> GhcT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (st -> (a, st)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance MonadReader r m => MonadReader r (GhcT m) where
	ask :: GhcT m r
ask = m r -> GhcT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
	local :: (r -> r) -> GhcT m a -> GhcT m a
local r -> r
f GhcT m a
act = (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
$ (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (m a -> m a) -> (Session -> m a) -> Session -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT GhcT m a
act

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

instance MonadCatch m => MonadCatch (GhcT m) where
	catch :: GhcT m a -> (e -> GhcT m a) -> GhcT m a
catch GhcT m a
act e -> GhcT m a
onError = (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
sess -> m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT GhcT m a
act Session
sess) ((GhcT m a -> Session -> m a) -> Session -> GhcT m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT Session
sess (GhcT m a -> m a) -> (e -> GhcT m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> GhcT m a
onError)

instance MonadMask m => MonadMask (GhcT m) where
	mask :: ((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
GhcT ((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
g -> GhcT m b -> Session -> m b
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT ((forall a. GhcT m a -> GhcT m a) -> GhcT m b
f ((forall a. GhcT m a -> GhcT m a) -> GhcT m b)
-> (forall a. GhcT m a -> GhcT m a) -> GhcT m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> GhcT m a -> GhcT m a
forall (m :: * -> *) a (m :: * -> *) a.
(m a -> m a) -> GhcT m a -> GhcT m a
q m a -> m a
forall a. m a -> m a
g) Session
s where
		q :: (m a -> m a) -> GhcT m a -> GhcT m a
q m a -> m a
g' GhcT m a
act = (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
$ m a -> m a
g' (m a -> m a) -> (Session -> m a) -> Session -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT GhcT m a
act
	uninterruptibleMask :: ((forall a. GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
uninterruptibleMask (forall a. GhcT m a -> GhcT m a) -> GhcT m b
f = (Session -> m b) -> GhcT m b
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((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
g -> GhcT m b -> Session -> m b
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT ((forall a. GhcT m a -> GhcT m a) -> GhcT m b
f ((forall a. GhcT m a -> GhcT m a) -> GhcT m b)
-> (forall a. GhcT m a -> GhcT m a) -> GhcT m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> GhcT m a -> GhcT m a
forall (m :: * -> *) a (m :: * -> *) a.
(m a -> m a) -> GhcT m a -> GhcT m a
q m a -> m a
forall a. m a -> m a
g) Session
s where
		q :: (m a -> m a) -> GhcT m a -> GhcT m a
q m a -> m a
g' GhcT m a
act = (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
$ m a -> m a
g' (m a -> m a) -> (Session -> m a) -> Session -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT GhcT m a
act
#if MIN_VERSION_exceptions(0,10,0)
	generalBracket :: GhcT m a
-> (a -> ExitCase b -> GhcT m c)
-> (a -> GhcT m b)
-> GhcT m (b, c)
generalBracket GhcT m a
acq a -> ExitCase b -> GhcT m c
rel a -> GhcT m b
act = (Session -> m (b, c)) -> GhcT m (b, c)
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m (b, c)) -> GhcT m (b, c))
-> (Session -> m (b, c)) -> GhcT m (b, c)
forall a b. (a -> b) -> a -> b
$ \Session
r -> 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
unGhcT GhcT m a
acq Session
r)
		(\a
res ExitCase b
exitCase -> case ExitCase b
exitCase of
			ExitCaseSuccess b
v -> GhcT m c -> Session -> m c
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT (a -> ExitCase b -> GhcT m c
rel a
res (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
v)) Session
r
			ExitCaseException SomeException
e -> GhcT m c -> Session -> m c
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT (a -> ExitCase b -> GhcT m c
rel a
res (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e)) Session
r
			ExitCase b
ExitCaseAbort -> GhcT m c -> Session -> m c
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT (a -> ExitCase b -> GhcT m c
rel a
res ExitCase b
forall a. ExitCase a
ExitCaseAbort) Session
r)
		(\a
res -> GhcT m b -> Session -> m b
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT (a -> GhcT m b
act a
res) Session
r)
#elif MIN_VERSION_exceptions(0,9,0)
	generalBracket acq rel clean act = GhcT $ \r -> generalBracket
		(unGhcT acq r)
		(\res -> unGhcT (rel res) r)
		(\res e -> unGhcT (clean res e) r)
		(\res -> unGhcT (act res) r)
#endif

-- | Run multi-session ghc
runMGhcT :: (MonadIO m, ExceptionMonad m, Ord s, Monoid d) => Maybe FilePath -> MGhcT s d m a -> m a
runMGhcT :: Maybe String -> MGhcT s d m a -> m a
runMGhcT Maybe String
lib MGhcT s d m a
act = do
	IORef HscEnv
ref <- IO (IORef HscEnv) -> m (IORef HscEnv)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef HscEnv) -> m (IORef HscEnv))
-> IO (IORef HscEnv) -> m (IORef HscEnv)
forall a b. (a -> b) -> a -> b
$ HscEnv -> IO (IORef HscEnv)
forall a. a -> IO (IORef a)
newIORef (String -> HscEnv
forall a. String -> a
panic String
"empty session")
	let
		session :: Session
session = IORef HscEnv -> Session
GhcMonad.Session IORef HscEnv
ref
	(StateT (SessionState s d) m a -> SessionState s d -> m a)
-> SessionState s d -> StateT (SessionState s d) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (SessionState s d) m a -> SessionState s d -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT SessionState s d
forall a. Default a => a
Def.def (StateT (SessionState s d) m a -> m a)
-> StateT (SessionState s d) m a -> m a
forall a b. (a -> b) -> a -> b
$ (ReaderT (Maybe String) (StateT (SessionState s d) m) a
 -> Maybe String -> StateT (SessionState s d) m a)
-> Maybe String
-> ReaderT (Maybe String) (StateT (SessionState s d) m) a
-> StateT (SessionState s d) m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (Maybe String) (StateT (SessionState s d) m) a
-> Maybe String -> StateT (SessionState s d) m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Maybe String
lib (ReaderT (Maybe String) (StateT (SessionState s d) m) a
 -> StateT (SessionState s d) m a)
-> ReaderT (Maybe String) (StateT (SessionState s d) m) a
-> StateT (SessionState s d) m a
forall a b. (a -> b) -> a -> b
$ (GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
 -> Session
 -> ReaderT (Maybe String) (StateT (SessionState s d) m) a)
-> Session
-> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
-> ReaderT (Maybe String) (StateT (SessionState s d) m) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
-> Session
-> ReaderT (Maybe String) (StateT (SessionState s d) m) a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT Session
session (GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
 -> ReaderT (Maybe String) (StateT (SessionState s d) m) a)
-> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
-> ReaderT (Maybe String) (StateT (SessionState s d) m) a
forall a b. (a -> b) -> a -> b
$ MGhcT s d m a
-> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
forall s d (m :: * -> *) a.
MGhcT s d m a
-> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
unMGhcT (MGhcT s d m a
 -> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a)
-> MGhcT s d m a
-> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
forall a b. (a -> b) -> a -> b
$ MGhcT s d m a
act MGhcT s d m a -> MGhcT s d m () -> MGhcT s d m a
forall (m :: * -> *) a b. ExceptionMonad m => m a -> m b -> m a
`gfinally` MGhcT s d m ()
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s, Monoid d) =>
MGhcT s d m ()
cleanup
	where
		cleanup :: (MonadIO m, ExceptionMonad m, Ord s, Monoid d) => MGhcT s d m ()
		cleanup :: MGhcT s d m ()
cleanup = do
			MGhcT s d m (Maybe (Session s d)) -> MGhcT s d m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void MGhcT s d m (Maybe (Session s d))
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s) =>
MGhcT s d m (Maybe (Session s d))
saveSession
			[(HscEnv, d)]
sessions <- (SessionState s d -> [(HscEnv, d)]) -> MGhcT s d m [(HscEnv, d)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Map s (HscEnv, d) -> [(HscEnv, d)]
forall k a. Map k a -> [a]
M.elems (Map s (HscEnv, d) -> [(HscEnv, d)])
-> (SessionState s d -> Map s (HscEnv, d))
-> SessionState s d
-> [(HscEnv, d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Map s (HscEnv, d)) (SessionState s d) (Map s (HscEnv, d))
-> SessionState s d -> Map s (HscEnv, d)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map s (HscEnv, d)) (SessionState s d) (Map s (HscEnv, d))
forall s d. Lens' (SessionState s d) (Map s (HscEnv, d))
sessionMap)
			IO () -> MGhcT s d m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MGhcT s d m ()) -> IO () -> MGhcT s d m ()
forall a b. (a -> b) -> a -> b
$ ((HscEnv, d) -> IO ()) -> [(HscEnv, d)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HscEnv -> IO ()
cleanupSession (HscEnv -> IO ())
-> ((HscEnv, d) -> HscEnv) -> (HscEnv, d) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting HscEnv (HscEnv, d) HscEnv -> (HscEnv, d) -> HscEnv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting HscEnv (HscEnv, d) HscEnv
forall s t a b. Field1 s t a b => Lens s t a b
_1) [(HscEnv, d)]
sessions
			(SessionState s d -> SessionState s d) -> MGhcT s d m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter
  (SessionState s d)
  (SessionState s d)
  (Map s (HscEnv, d))
  (Map s (HscEnv, d))
-> Map s (HscEnv, d) -> SessionState s d -> SessionState s d
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (SessionState s d)
  (SessionState s d)
  (Map s (HscEnv, d))
  (Map s (HscEnv, d))
forall s d. Lens' (SessionState s d) (Map s (HscEnv, d))
sessionMap Map s (HscEnv, d)
forall k a. Map k a
M.empty)

-- | Lift `Ghc` monad onto `MGhc`
liftGhc :: MonadIO m => Ghc a -> MGhcT s d m a
liftGhc :: Ghc a -> MGhcT s d m a
liftGhc (Ghc Session -> IO a
act) = GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
-> MGhcT s d m a
forall s d (m :: * -> *) a.
GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
-> MGhcT s d m a
MGhcT (GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
 -> MGhcT s d m a)
-> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
-> MGhcT s d m a
forall a b. (a -> b) -> a -> b
$ (Session -> ReaderT (Maybe String) (StateT (SessionState s d) m) a)
-> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session
  -> ReaderT (Maybe String) (StateT (SessionState s d) m) a)
 -> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a)
-> (Session
    -> ReaderT (Maybe String) (StateT (SessionState s d) m) a)
-> GhcT (ReaderT (Maybe String) (StateT (SessionState s d) m)) a
forall a b. (a -> b) -> a -> b
$ IO a -> ReaderT (Maybe String) (StateT (SessionState s d) m) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ReaderT (Maybe String) (StateT (SessionState s d) m) a)
-> (Session -> IO a)
-> Session
-> ReaderT (Maybe String) (StateT (SessionState s d) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> IO a
act

-- | Get current session
currentSession :: MonadIO m => MGhcT s d m (Maybe (Session s d))
currentSession :: MGhcT s d m (Maybe (Session s d))
currentSession = (SessionState s d -> Maybe (Session s d))
-> MGhcT s d m (Maybe (Session s d))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting
  (Maybe (Session s d)) (SessionState s d) (Maybe (Session s d))
-> SessionState s d -> Maybe (Session s d)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (Session s d)) (SessionState s d) (Maybe (Session s d))
forall s d. Lens' (SessionState s d) (Maybe (Session s d))
sessionActive)

-- | Get current session data
getSessionData :: MonadIO m => MGhcT s d m (Maybe d)
getSessionData :: MGhcT s d m (Maybe d)
getSessionData = (SessionState s d -> Maybe d) -> MGhcT s d m (Maybe d)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting (First d) (SessionState s d) d
-> SessionState s d -> Maybe d
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Maybe (Session s d) -> Const (First d) (Maybe (Session s d)))
-> SessionState s d -> Const (First d) (SessionState s d)
forall s d. Lens' (SessionState s d) (Maybe (Session s d))
sessionActive ((Maybe (Session s d) -> Const (First d) (Maybe (Session s d)))
 -> SessionState s d -> Const (First d) (SessionState s d))
-> ((d -> Const (First d) d)
    -> Maybe (Session s d) -> Const (First d) (Maybe (Session s d)))
-> Getting (First d) (SessionState s d) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Session s d -> Const (First d) (Session s d))
-> Maybe (Session s d) -> Const (First d) (Maybe (Session s d))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Session s d -> Const (First d) (Session s d))
 -> Maybe (Session s d) -> Const (First d) (Maybe (Session s d)))
-> ((d -> Const (First d) d)
    -> Session s d -> Const (First d) (Session s d))
-> (d -> Const (First d) d)
-> Maybe (Session s d)
-> Const (First d) (Maybe (Session s d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (d -> Const (First d) d)
-> Session s d -> Const (First d) (Session s d)
forall s d. Lens' (Session s d) d
sessionData))

-- | Set current session data
setSessionData :: MonadIO m => d -> MGhcT s d m ()
setSessionData :: d -> MGhcT s d m ()
setSessionData d
sdata = (SessionState s d -> SessionState s d) -> MGhcT s d m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter (SessionState s d) (SessionState s d) d d
-> d -> SessionState s d -> SessionState s d
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Maybe (Session s d) -> Identity (Maybe (Session s d)))
-> SessionState s d -> Identity (SessionState s d)
forall s d. Lens' (SessionState s d) (Maybe (Session s d))
sessionActive ((Maybe (Session s d) -> Identity (Maybe (Session s d)))
 -> SessionState s d -> Identity (SessionState s d))
-> ((d -> Identity d)
    -> Maybe (Session s d) -> Identity (Maybe (Session s d)))
-> ASetter (SessionState s d) (SessionState s d) d d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Session s d -> Identity (Session s d))
-> Maybe (Session s d) -> Identity (Maybe (Session s d))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Session s d -> Identity (Session s d))
 -> Maybe (Session s d) -> Identity (Maybe (Session s d)))
-> ((d -> Identity d) -> Session s d -> Identity (Session s d))
-> (d -> Identity d)
-> Maybe (Session s d)
-> Identity (Maybe (Session s d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (d -> Identity d) -> Session s d -> Identity (Session s d)
forall s d. Lens' (Session s d) d
sessionData) d
sdata)

-- | Does session exist
hasSession :: (MonadIO m, Ord s) => s -> MGhcT s d m Bool
hasSession :: s -> MGhcT s d m Bool
hasSession s
key = do
	Maybe (Session s d)
msess <- s -> MGhcT s d m (Maybe (Session s d))
forall (m :: * -> *) s d.
(MonadIO m, Ord s) =>
s -> MGhcT s d m (Maybe (Session s d))
findSession s
key
	Bool -> MGhcT s d m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> MGhcT s d m Bool) -> Bool -> MGhcT s d m Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Session s d) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Session s d)
msess

-- | Find session
findSession :: (MonadIO m, Ord s) => s -> MGhcT s d m (Maybe (Session s d))
findSession :: s -> MGhcT s d m (Maybe (Session s d))
findSession s
key = do
	Maybe d
sdata <- (SessionState s d -> Maybe d) -> MGhcT s d m (Maybe d)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting (First d) (SessionState s d) d
-> SessionState s d -> Maybe d
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map s (HscEnv, d) -> Const (First d) (Map s (HscEnv, d)))
-> SessionState s d -> Const (First d) (SessionState s d)
forall s d. Lens' (SessionState s d) (Map s (HscEnv, d))
sessionMap ((Map s (HscEnv, d) -> Const (First d) (Map s (HscEnv, d)))
 -> SessionState s d -> Const (First d) (SessionState s d))
-> ((d -> Const (First d) d)
    -> Map s (HscEnv, d) -> Const (First d) (Map s (HscEnv, d)))
-> Getting (First d) (SessionState s d) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map s (HscEnv, d))
-> Traversal' (Map s (HscEnv, d)) (IxValue (Map s (HscEnv, d)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix s
Index (Map s (HscEnv, d))
key (((HscEnv, d) -> Const (First d) (HscEnv, d))
 -> Map s (HscEnv, d) -> Const (First d) (Map s (HscEnv, d)))
-> ((d -> Const (First d) d)
    -> (HscEnv, d) -> Const (First d) (HscEnv, d))
-> (d -> Const (First d) d)
-> Map s (HscEnv, d)
-> Const (First d) (Map s (HscEnv, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (d -> Const (First d) d)
-> (HscEnv, d) -> Const (First d) (HscEnv, d)
forall s t a b. Field2 s t a b => Lens s t a b
_2))
	Maybe (Session s d) -> MGhcT s d m (Maybe (Session s d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Session s d) -> MGhcT s d m (Maybe (Session s d)))
-> Maybe (Session s d) -> MGhcT s d m (Maybe (Session s d))
forall a b. (a -> b) -> a -> b
$ (d -> Session s d) -> Maybe d -> Maybe (Session s d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> d -> Session s d
forall s d. s -> d -> Session s d
Session s
key) Maybe d
sdata

-- | Find session by
findSessionBy :: MonadIO m => (s -> Bool) -> MGhcT s d m [Session s d]
findSessionBy :: (s -> Bool) -> MGhcT s d m [Session s d]
findSessionBy s -> Bool
p = do
	[(s, (HscEnv, d))]
sessions <- (SessionState s d -> [(s, (HscEnv, d))])
-> MGhcT s d m [(s, (HscEnv, d))]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Map s (HscEnv, d) -> [(s, (HscEnv, d))]
forall k a. Map k a -> [(k, a)]
M.toList (Map s (HscEnv, d) -> [(s, (HscEnv, d))])
-> (SessionState s d -> Map s (HscEnv, d))
-> SessionState s d
-> [(s, (HscEnv, d))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Map s (HscEnv, d)) (SessionState s d) (Map s (HscEnv, d))
-> SessionState s d -> Map s (HscEnv, d)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map s (HscEnv, d)) (SessionState s d) (Map s (HscEnv, d))
forall s d. Lens' (SessionState s d) (Map s (HscEnv, d))
sessionMap)
	[Session s d] -> MGhcT s d m [Session s d]
forall (m :: * -> *) a. Monad m => a -> m a
return [s -> d -> Session s d
forall s d. s -> d -> Session s d
Session s
key d
sdata | (s
key, (HscEnv
_, d
sdata)) <- [(s, (HscEnv, d))]
sessions, s -> Bool
p s
key]

-- | Save current session
saveSession :: (MonadIO m, ExceptionMonad m, Ord s) => MGhcT s d m (Maybe (Session s d))
saveSession :: MGhcT s d m (Maybe (Session s d))
saveSession = do
	Maybe (Session s d)
msess <- MGhcT s d m (Maybe (Session s d))
forall (m :: * -> *) s d.
MonadIO m =>
MGhcT s d m (Maybe (Session s d))
currentSession
	case Maybe (Session s d)
msess of
		Just (Session s
key' d
dat') -> do
			HscEnv
sess <- MGhcT s d m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
			(SessionState s d -> SessionState s d) -> MGhcT s d m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter
  (SessionState s d)
  (SessionState s d)
  (Maybe (HscEnv, d))
  (Maybe (HscEnv, d))
-> Maybe (HscEnv, d) -> SessionState s d -> SessionState s d
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Map s (HscEnv, d) -> Identity (Map s (HscEnv, d)))
-> SessionState s d -> Identity (SessionState s d)
forall s d. Lens' (SessionState s d) (Map s (HscEnv, d))
sessionMap ((Map s (HscEnv, d) -> Identity (Map s (HscEnv, d)))
 -> SessionState s d -> Identity (SessionState s d))
-> ((Maybe (HscEnv, d) -> Identity (Maybe (HscEnv, d)))
    -> Map s (HscEnv, d) -> Identity (Map s (HscEnv, d)))
-> ASetter
     (SessionState s d)
     (SessionState s d)
     (Maybe (HscEnv, d))
     (Maybe (HscEnv, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map s (HscEnv, d))
-> Lens' (Map s (HscEnv, d)) (Maybe (IxValue (Map s (HscEnv, d))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at s
Index (Map s (HscEnv, d))
key') ((HscEnv, d) -> Maybe (HscEnv, d)
forall a. a -> Maybe a
Just (HscEnv
sess, d
dat')))
		Maybe (Session s d)
Nothing -> () -> MGhcT s d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
	Maybe (Session s d) -> MGhcT s d m (Maybe (Session s d))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Session s d)
msess

-- | Initialize new session
initSession :: (MonadIO m, ExceptionMonad m, Ord s) => MGhcT s d m ()
initSession :: MGhcT s d m ()
initSession = do
	Maybe String
lib <- MGhcT s d m (Maybe String)
forall r (m :: * -> *). MonadReader r m => m r
ask
	Maybe String -> MGhcT s d m ()
forall (m :: * -> *). GhcMonad m => Maybe String -> m ()
initGhcMonad Maybe String
lib
	MGhcT s d m (Maybe (Session s d)) -> MGhcT s d m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void MGhcT s d m (Maybe (Session s d))
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s) =>
MGhcT s d m (Maybe (Session s d))
saveSession

activateSession :: (MonadIO m, ExceptionMonad m, Ord s, Monoid d) => s -> MGhcT s d m (Maybe HscEnv)
activateSession :: s -> MGhcT s d m (Maybe HscEnv)
activateSession s
key = do
	MGhcT s d m (Maybe (Session s d)) -> MGhcT s d m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void MGhcT s d m (Maybe (Session s d))
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s) =>
MGhcT s d m (Maybe (Session s d))
saveSession
	d
sdata <- (SessionState s d -> d) -> MGhcT s d m d
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting d (SessionState s d) d -> SessionState s d -> d
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Map s (HscEnv, d) -> Const d (Map s (HscEnv, d)))
-> SessionState s d -> Const d (SessionState s d)
forall s d. Lens' (SessionState s d) (Map s (HscEnv, d))
sessionMap ((Map s (HscEnv, d) -> Const d (Map s (HscEnv, d)))
 -> SessionState s d -> Const d (SessionState s d))
-> ((d -> Const d d)
    -> Map s (HscEnv, d) -> Const d (Map s (HscEnv, d)))
-> Getting d (SessionState s d) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map s (HscEnv, d))
-> Traversal' (Map s (HscEnv, d)) (IxValue (Map s (HscEnv, d)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix s
Index (Map s (HscEnv, d))
key (((HscEnv, d) -> Const d (HscEnv, d))
 -> Map s (HscEnv, d) -> Const d (Map s (HscEnv, d)))
-> ((d -> Const d d) -> (HscEnv, d) -> Const d (HscEnv, d))
-> (d -> Const d d)
-> Map s (HscEnv, d)
-> Const d (Map s (HscEnv, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (d -> Const d d) -> (HscEnv, d) -> Const d (HscEnv, d)
forall s t a b. Field2 s t a b => Lens s t a b
_2))
	(SessionState s d -> SessionState s d) -> MGhcT s d m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter
  (SessionState s d)
  (SessionState s d)
  (Maybe (Session s d))
  (Maybe (Session s d))
-> Maybe (Session s d) -> SessionState s d -> SessionState s d
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (SessionState s d)
  (SessionState s d)
  (Maybe (Session s d))
  (Maybe (Session s d))
forall s d. Lens' (SessionState s d) (Maybe (Session s d))
sessionActive (Maybe (Session s d) -> SessionState s d -> SessionState s d)
-> Maybe (Session s d) -> SessionState s d -> SessionState s d
forall a b. (a -> b) -> a -> b
$ Session s d -> Maybe (Session s d)
forall a. a -> Maybe a
Just (s -> d -> Session s d
forall s d. s -> d -> Session s d
Session s
key d
sdata))
	(SessionState s d -> Maybe HscEnv) -> MGhcT s d m (Maybe HscEnv)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting (First HscEnv) (SessionState s d) HscEnv
-> SessionState s d -> Maybe HscEnv
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map s (HscEnv, d) -> Const (First HscEnv) (Map s (HscEnv, d)))
-> SessionState s d -> Const (First HscEnv) (SessionState s d)
forall s d. Lens' (SessionState s d) (Map s (HscEnv, d))
sessionMap ((Map s (HscEnv, d) -> Const (First HscEnv) (Map s (HscEnv, d)))
 -> SessionState s d -> Const (First HscEnv) (SessionState s d))
-> ((HscEnv -> Const (First HscEnv) HscEnv)
    -> Map s (HscEnv, d) -> Const (First HscEnv) (Map s (HscEnv, d)))
-> Getting (First HscEnv) (SessionState s d) HscEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map s (HscEnv, d))
-> Traversal' (Map s (HscEnv, d)) (IxValue (Map s (HscEnv, d)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix s
Index (Map s (HscEnv, d))
key (((HscEnv, d) -> Const (First HscEnv) (HscEnv, d))
 -> Map s (HscEnv, d) -> Const (First HscEnv) (Map s (HscEnv, d)))
-> ((HscEnv -> Const (First HscEnv) HscEnv)
    -> (HscEnv, d) -> Const (First HscEnv) (HscEnv, d))
-> (HscEnv -> Const (First HscEnv) HscEnv)
-> Map s (HscEnv, d)
-> Const (First HscEnv) (Map s (HscEnv, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HscEnv -> Const (First HscEnv) HscEnv)
-> (HscEnv, d) -> Const (First HscEnv) (HscEnv, d)
forall s t a b. Field1 s t a b => Lens s t a b
_1))

-- | Create new named session, deleting existing session
newSession :: (MonadIO m, ExceptionMonad m, Ord s, Monoid d) => s -> MGhcT s d m ()
newSession :: s -> MGhcT s d m ()
newSession s
key = do
	Maybe HscEnv
msess <- s -> MGhcT s d m (Maybe HscEnv)
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s, Monoid d) =>
s -> MGhcT s d m (Maybe HscEnv)
activateSession s
key
	MGhcT s d m ()
-> (HscEnv -> MGhcT s d m ()) -> Maybe HscEnv -> MGhcT s d m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> MGhcT s d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> MGhcT s d m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MGhcT s d m ())
-> (HscEnv -> IO ()) -> HscEnv -> MGhcT s d m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> IO ()
cleanupSession) Maybe HscEnv
msess
	MGhcT s d m ()
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s) =>
MGhcT s d m ()
initSession

-- | Switch to session, creating if not exist, returns True if session was created
switchSession :: (MonadIO m, ExceptionMonad m, Ord s, Monoid d) => s -> MGhcT s d m Bool
switchSession :: s -> MGhcT s d m Bool
switchSession s
key = do
	Maybe HscEnv
msess <- s -> MGhcT s d m (Maybe HscEnv)
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s, Monoid d) =>
s -> MGhcT s d m (Maybe HscEnv)
activateSession s
key
	case Maybe HscEnv
msess of
		Maybe HscEnv
Nothing -> MGhcT s d m ()
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s) =>
MGhcT s d m ()
initSession MGhcT s d m () -> MGhcT s d m Bool -> MGhcT s d m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MGhcT s d m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
		Just HscEnv
sess -> HscEnv -> MGhcT s d m ()
forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
setSession HscEnv
sess MGhcT s d m () -> MGhcT s d m Bool -> MGhcT s d m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MGhcT s d m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Switch to session, creating if not exist and initializing with passed function
switchSession_ :: (MonadIO m, ExceptionMonad m, Ord s, Monoid d) => s -> Maybe (MGhcT s d m ()) -> MGhcT s d m ()
switchSession_ :: s -> Maybe (MGhcT s d m ()) -> MGhcT s d m ()
switchSession_ s
key Maybe (MGhcT s d m ())
f = do
	Bool
new <- s -> MGhcT s d m Bool
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s, Monoid d) =>
s -> MGhcT s d m Bool
switchSession s
key
	Bool -> MGhcT s d m () -> MGhcT s d m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
new (MGhcT s d m () -> MGhcT s d m ())
-> MGhcT s d m () -> MGhcT s d m ()
forall a b. (a -> b) -> a -> b
$ MGhcT s d m () -> Maybe (MGhcT s d m ()) -> MGhcT s d m ()
forall a. a -> Maybe a -> a
fromMaybe (() -> MGhcT s d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (MGhcT s d m ())
f

-- | Delete existing session
deleteSession :: (MonadIO m, ExceptionMonad m, Ord s, Monoid d) => s -> MGhcT s d m ()
deleteSession :: s -> MGhcT s d m ()
deleteSession s
key = do
	Maybe (Session s d)
cur <- MGhcT s d m (Maybe (Session s d))
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s) =>
MGhcT s d m (Maybe (Session s d))
saveSession
	Bool -> MGhcT s d m () -> MGhcT s d m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Getting (First s) (Maybe (Session s d)) s
-> Maybe (Session s d) -> Maybe s
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Session s d -> Const (First s) (Session s d))
-> Maybe (Session s d) -> Const (First s) (Maybe (Session s d))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Session s d -> Const (First s) (Session s d))
 -> Maybe (Session s d) -> Const (First s) (Maybe (Session s d)))
-> ((s -> Const (First s) s)
    -> Session s d -> Const (First s) (Session s d))
-> Getting (First s) (Maybe (Session s d)) s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Const (First s) s)
-> Session s d -> Const (First s) (Session s d)
forall s d. Lens' (Session s d) s
sessionKey) Maybe (Session s d)
cur Maybe s -> Maybe s -> Bool
forall a. Eq a => a -> a -> Bool
== s -> Maybe s
forall a. a -> Maybe a
Just s
key) (MGhcT s d m () -> MGhcT s d m ())
-> MGhcT s d m () -> MGhcT s d m ()
forall a b. (a -> b) -> a -> b
$
		(SessionState s d -> SessionState s d) -> MGhcT s d m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter
  (SessionState s d)
  (SessionState s d)
  (Maybe (Session s d))
  (Maybe (Session s d))
-> Maybe (Session s d) -> SessionState s d -> SessionState s d
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (SessionState s d)
  (SessionState s d)
  (Maybe (Session s d))
  (Maybe (Session s d))
forall s d. Lens' (SessionState s d) (Maybe (Session s d))
sessionActive Maybe (Session s d)
forall a. Maybe a
Nothing)
	Maybe HscEnv
msess <- (SessionState s d -> Maybe HscEnv) -> MGhcT s d m (Maybe HscEnv)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting (First HscEnv) (SessionState s d) HscEnv
-> SessionState s d -> Maybe HscEnv
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map s (HscEnv, d) -> Const (First HscEnv) (Map s (HscEnv, d)))
-> SessionState s d -> Const (First HscEnv) (SessionState s d)
forall s d. Lens' (SessionState s d) (Map s (HscEnv, d))
sessionMap ((Map s (HscEnv, d) -> Const (First HscEnv) (Map s (HscEnv, d)))
 -> SessionState s d -> Const (First HscEnv) (SessionState s d))
-> ((HscEnv -> Const (First HscEnv) HscEnv)
    -> Map s (HscEnv, d) -> Const (First HscEnv) (Map s (HscEnv, d)))
-> Getting (First HscEnv) (SessionState s d) HscEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map s (HscEnv, d))
-> Traversal' (Map s (HscEnv, d)) (IxValue (Map s (HscEnv, d)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix s
Index (Map s (HscEnv, d))
key (((HscEnv, d) -> Const (First HscEnv) (HscEnv, d))
 -> Map s (HscEnv, d) -> Const (First HscEnv) (Map s (HscEnv, d)))
-> ((HscEnv -> Const (First HscEnv) HscEnv)
    -> (HscEnv, d) -> Const (First HscEnv) (HscEnv, d))
-> (HscEnv -> Const (First HscEnv) HscEnv)
-> Map s (HscEnv, d)
-> Const (First HscEnv) (Map s (HscEnv, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HscEnv -> Const (First HscEnv) HscEnv)
-> (HscEnv, d) -> Const (First HscEnv) (HscEnv, d)
forall s t a b. Field1 s t a b => Lens s t a b
_1))
	(SessionState s d -> SessionState s d) -> MGhcT s d m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter
  (SessionState s d)
  (SessionState s d)
  (Maybe (HscEnv, d))
  (Maybe (HscEnv, d))
-> Maybe (HscEnv, d) -> SessionState s d -> SessionState s d
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Map s (HscEnv, d) -> Identity (Map s (HscEnv, d)))
-> SessionState s d -> Identity (SessionState s d)
forall s d. Lens' (SessionState s d) (Map s (HscEnv, d))
sessionMap ((Map s (HscEnv, d) -> Identity (Map s (HscEnv, d)))
 -> SessionState s d -> Identity (SessionState s d))
-> ((Maybe (HscEnv, d) -> Identity (Maybe (HscEnv, d)))
    -> Map s (HscEnv, d) -> Identity (Map s (HscEnv, d)))
-> ASetter
     (SessionState s d)
     (SessionState s d)
     (Maybe (HscEnv, d))
     (Maybe (HscEnv, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map s (HscEnv, d))
-> Lens' (Map s (HscEnv, d)) (Maybe (IxValue (Map s (HscEnv, d))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at s
Index (Map s (HscEnv, d))
key) Maybe (HscEnv, d)
forall a. Maybe a
Nothing)
	case Maybe HscEnv
msess of
		Maybe HscEnv
Nothing -> () -> MGhcT s d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
		Just HscEnv
sess -> IO () -> MGhcT s d m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MGhcT s d m ()) -> IO () -> MGhcT s d m ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> IO ()
cleanupSession HscEnv
sess

-- | Save and restore session
restoreSession :: (MonadIO m, MonadMask m, ExceptionMonad m, Ord s, Monoid d) => MGhcT s d m a -> MGhcT s d m a
restoreSession :: MGhcT s d m a -> MGhcT s d m a
restoreSession MGhcT s d m a
act = MGhcT s d m (Maybe (Session s d))
-> (Maybe (Session s d) -> MGhcT s d m ())
-> (Maybe (Session s d) -> MGhcT s d m a)
-> MGhcT s d m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket MGhcT s d m (Maybe (Session s d))
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s) =>
MGhcT s d m (Maybe (Session s d))
saveSession (MGhcT s d m ()
-> (Session s d -> MGhcT s d m ())
-> Maybe (Session s d)
-> MGhcT s d m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> MGhcT s d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (MGhcT s d m Bool -> MGhcT s d m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MGhcT s d m Bool -> MGhcT s d m ())
-> (Session s d -> MGhcT s d m Bool)
-> Session s d
-> MGhcT s d m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> MGhcT s d m Bool
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s, Monoid d) =>
s -> MGhcT s d m Bool
switchSession (s -> MGhcT s d m Bool)
-> (Session s d -> s) -> Session s d -> MGhcT s d m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting s (Session s d) s -> Session s d -> s
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting s (Session s d) s
forall s d. Lens' (Session s d) s
sessionKey)) ((Maybe (Session s d) -> MGhcT s d m a) -> MGhcT s d m a)
-> (Maybe (Session s d) -> MGhcT s d m a) -> MGhcT s d m a
forall a b. (a -> b) -> a -> b
$ MGhcT s d m a -> Maybe (Session s d) -> MGhcT s d m a
forall a b. a -> b -> a
const MGhcT s d m a
act

-- | Run action using session, restoring session back
usingSession :: (MonadIO m, MonadMask m, ExceptionMonad m, Ord s, Monoid d) => s -> MGhcT s d m a -> MGhcT s d m a
usingSession :: s -> MGhcT s d m a -> MGhcT s d m a
usingSession s
key MGhcT s d m a
act = MGhcT s d m a -> MGhcT s d m a
forall (m :: * -> *) s d a.
(MonadIO m, MonadMask m, ExceptionMonad m, Ord s, Monoid d) =>
MGhcT s d m a -> MGhcT s d m a
restoreSession (MGhcT s d m a -> MGhcT s d m a) -> MGhcT s d m a -> MGhcT s d m a
forall a b. (a -> b) -> a -> b
$ do
	MGhcT s d m Bool -> MGhcT s d m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MGhcT s d m Bool -> MGhcT s d m ())
-> MGhcT s d m Bool -> MGhcT s d m ()
forall a b. (a -> b) -> a -> b
$ s -> MGhcT s d m Bool
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s, Monoid d) =>
s -> MGhcT s d m Bool
switchSession s
key
	MGhcT s d m a
act

-- | Run with temporary session, like @usingSession@, but deletes self session
tempSession :: (MonadIO m, MonadMask m, ExceptionMonad m, Ord s, Monoid d) => s -> MGhcT s d m a -> MGhcT s d m a
tempSession :: s -> MGhcT s d m a -> MGhcT s d m a
tempSession s
key MGhcT s d m a
act = do
	Bool
exist' <- s -> MGhcT s d m Bool
forall (m :: * -> *) s d.
(MonadIO m, Ord s) =>
s -> MGhcT s d m Bool
hasSession s
key
	s -> MGhcT s d m a -> MGhcT s d m a
forall (m :: * -> *) s d a.
(MonadIO m, MonadMask m, ExceptionMonad m, Ord s, Monoid d) =>
s -> MGhcT s d m a -> MGhcT s d m a
usingSession s
key MGhcT s d m a
act MGhcT s d m a -> MGhcT s d m () -> MGhcT s d m a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` Bool -> MGhcT s d m () -> MGhcT s d m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exist' (s -> MGhcT s d m ()
forall (m :: * -> *) s d.
(MonadIO m, ExceptionMonad m, Ord s, Monoid d) =>
s -> MGhcT s d m ()
deleteSession s
key)

-- | Cleanup session
cleanupSession :: HscEnv -> IO ()
cleanupSession :: HscEnv -> IO ()
cleanupSession HscEnv
env = do
	DynFlags -> IO ()
cleanTemps DynFlags
df
	HscEnv -> IO ()
stopIServ HscEnv
env
	where
		df :: DynFlags
df = HscEnv -> DynFlags
hsc_dflags HscEnv
env