{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances,
ScopedTypeVariables #-}
module Control.Concurrent.MState
(
MState
, module Control.Monad.State.Class
, runMState
, evalMState
, execMState
, mapMState
, mapMState_
, modifyM
, modifyM_
, forkM
, forkM_
, killMState
, waitM
) where
import Control.Applicative
import Control.Monad
import Control.Monad.State.Class
import Control.Monad.Cont
import Control.Monad.Except
import qualified Control.Monad.Fail as Fail
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad.IO.Peel
import Control.Exception.Peel
import Control.Monad.Trans.Peel
newtype MState t m a = MState { forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' :: (TVar t, TVar [(ThreadId, TMVar ())]) -> m a }
waitForTermination :: MonadIO m
=> TVar [(ThreadId, TMVar ())]
-> m ()
waitForTermination :: forall (m :: * -> *).
MonadIO m =>
TVar [(ThreadId, TMVar ())] -> m ()
waitForTermination = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. TMVar a -> STM a
takeTMVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. TVar a -> STM a
readTVar)
runMState :: MonadPeelIO m
=> MState t m a
-> t
-> m (a,t)
runMState :: forall (m :: * -> *) t a.
MonadPeelIO m =>
MState t m a -> t -> m (a, t)
runMState MState t m a
m t
t = do
(a
a, Maybe t
t') <- forall (m :: * -> *) t a.
MonadPeelIO m =>
Bool -> MState t m a -> t -> m (a, Maybe t)
runAndWaitMaybe Bool
True MState t m a
m t
t
case Maybe t
t' of
Just t
t'' -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, t
t'')
Maybe t
_ -> forall a. HasCallStack => a
undefined
runAndWaitMaybe :: MonadPeelIO m
=> Bool
-> MState t m a
-> t
-> m (a, Maybe t)
runAndWaitMaybe :: forall (m :: * -> *) t a.
MonadPeelIO m =>
Bool -> MState t m a -> t -> m (a, Maybe t)
runAndWaitMaybe Bool
b MState t m a
m t
t = do
ThreadId
myI <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId
TMVar ()
myM <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (TMVar a)
newEmptyTMVarIO
TVar t
ref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (TVar a)
newTVarIO t
t
TVar [(ThreadId, TMVar ())]
c <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (TVar a)
newTVarIO [(ThreadId
myI, TMVar ()
myM)]
a
a <- forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
m (TVar t
ref, TVar [(ThreadId, TMVar ())]
c) forall (m :: * -> *) a b. MonadPeelIO m => m a -> m b -> m a
`finally` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM ()
putTMVar TMVar ()
myM ())
if Bool
b then do
forall (m :: * -> *).
MonadIO m =>
TVar [(ThreadId, TMVar ())] -> m ()
waitForTermination TVar [(ThreadId, TMVar ())]
c
t
t' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> IO a
readTVarIO TVar t
ref
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, forall a. a -> Maybe a
Just t
t')
else
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, forall a. Maybe a
Nothing)
evalMState :: MonadPeelIO m
=> Bool
-> MState t m a
-> t
-> m a
evalMState :: forall (m :: * -> *) t a.
MonadPeelIO m =>
Bool -> MState t m a -> t -> m a
evalMState Bool
b MState t m a
m t
t = forall (m :: * -> *) t a.
MonadPeelIO m =>
Bool -> MState t m a -> t -> m (a, Maybe t)
runAndWaitMaybe Bool
b MState t m a
m t
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
execMState :: MonadPeelIO m
=> MState t m a
-> t
-> m t
execMState :: forall (m :: * -> *) t a. MonadPeelIO m => MState t m a -> t -> m t
execMState MState t m a
m t
t = forall (m :: * -> *) t a.
MonadPeelIO m =>
MState t m a -> t -> m (a, t)
runMState MState t m a
m t
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
mapMState :: (MonadIO m, MonadIO n)
=> (m (a,t) -> n (b,t))
-> MState t m a
-> MState t n b
mapMState :: forall (m :: * -> *) (n :: * -> *) a t b.
(MonadIO m, MonadIO n) =>
(m (a, t) -> n (b, t)) -> MState t m a -> MState t n b
mapMState m (a, t) -> n (b, t)
f MState t m a
m = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \s :: (TVar t, TVar [(ThreadId, TMVar ())])
s@(TVar t
r,TVar [(ThreadId, TMVar ())]
_) -> do
~(b
b,t
v') <- m (a, t) -> n (b, t)
f forall a b. (a -> b) -> a -> b
$ do
a
a <- forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
m (TVar t, TVar [(ThreadId, TMVar ())])
s
t
v <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> IO a
readTVarIO TVar t
r
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,t
v)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> a -> STM ()
writeTVar TVar t
r t
v'
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
mapMState_ :: (MonadIO n)
=> (m a -> n b)
-> MState t m a
-> MState t n b
mapMState_ :: forall (n :: * -> *) (m :: * -> *) a b t.
MonadIO n =>
(m a -> n b) -> MState t m a -> MState t n b
mapMState_ m a -> n b
f MState t m a
m = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
s -> do
b
b <- m a -> n b
f forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
m (TVar t, TVar [(ThreadId, TMVar ())])
s
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
modifyM :: MonadIO m => (t -> (a,t)) -> MState t m a
modifyM :: forall (m :: * -> *) t a.
MonadIO m =>
(t -> (a, t)) -> MState t m a
modifyM t -> (a, t)
f = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t
t,TVar [(ThreadId, TMVar ())]
_) ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
t
v <- forall a. TVar a -> STM a
readTVar TVar t
t
let (a
a,t
v') = t -> (a, t)
f t
v
forall a. TVar a -> a -> STM ()
writeTVar TVar t
t t
v'
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
modifyM_ :: MonadIO m => (t -> t) -> MState t m ()
modifyM_ :: forall (m :: * -> *) t. MonadIO m => (t -> t) -> MState t m ()
modifyM_ t -> t
f = forall (m :: * -> *) t a.
MonadIO m =>
(t -> (a, t)) -> MState t m a
modifyM (\t
t -> ((), t -> t
f t
t))
fork :: MonadPeelIO m => m () -> m ThreadId
fork :: forall (m :: * -> *). MonadPeelIO m => m () -> m ThreadId
fork m ()
m = do
m () -> IO (m ())
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ m () -> IO (m ())
k m ()
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forkM :: MonadPeelIO m
=> MState t m ()
-> MState t m ThreadId
forkM :: forall (m :: * -> *) t.
MonadPeelIO m =>
MState t m () -> MState t m ThreadId
forkM MState t m ()
m = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \s :: (TVar t, TVar [(ThreadId, TMVar ())])
s@(TVar t
_,TVar [(ThreadId, TMVar ())]
c) -> do
TMVar ()
w <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (TMVar a)
newEmptyTMVarIO
ThreadId
tid <- forall (m :: * -> *). MonadPeelIO m => m () -> m ThreadId
fork forall a b. (a -> b) -> a -> b
$
forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m ()
m (TVar t, TVar [(ThreadId, TMVar ())])
s forall (m :: * -> *) a b. MonadPeelIO m => m a -> m b -> m a
`finally` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM ()
putTMVar TMVar ()
w ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
[(ThreadId, TMVar ())]
r <- forall a. TVar a -> STM a
readTVar TVar [(ThreadId, TMVar ())]
c
forall a. TVar a -> a -> STM ()
writeTVar TVar [(ThreadId, TMVar ())]
c ((ThreadId
tid,TMVar ()
w)forall a. a -> [a] -> [a]
:[(ThreadId, TMVar ())]
r)
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadId
tid
forkM_ :: MonadPeelIO m
=> MState t m ()
-> MState t m ()
forkM_ :: forall (m :: * -> *) t.
MonadPeelIO m =>
MState t m () -> MState t m ()
forkM_ MState t m ()
m = do
ThreadId
_ <- forall (m :: * -> *) t.
MonadPeelIO m =>
MState t m () -> MState t m ThreadId
forkM MState t m ()
m
forall (m :: * -> *) a. Monad m => a -> m a
return ()
killMState :: MonadPeelIO m => MState t m ()
killMState :: forall (m :: * -> *) t. MonadPeelIO m => MState t m ()
killMState = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t
_,TVar [(ThreadId, TMVar ())]
tv) -> do
[(ThreadId, TMVar ())]
tms <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> IO a
readTVarIO TVar [(ThreadId, TMVar ())]
tv
ThreadId
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ThreadId -> IO ()
killThread forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ThreadId, TMVar ())]
tms
forall (m :: * -> *) a. Monad m => a -> m a
return ()
waitM :: MonadPeelIO m => ThreadId -> MState t m ()
waitM :: forall (m :: * -> *) t. MonadPeelIO m => ThreadId -> MState t m ()
waitM ThreadId
tid = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t
_,TVar [(ThreadId, TMVar ())]
c) -> do
Maybe (TMVar ())
mw <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ThreadId
tid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. TVar a -> STM a
readTVar TVar [(ThreadId, TMVar ())]
c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall {m :: * -> *}. MonadIO m => TMVar () -> m ()
wait' Maybe (TMVar ())
mw
where
wait' :: TMVar () -> m ()
wait' TMVar ()
w = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
() <- forall a. TMVar a -> STM a
takeTMVar TMVar ()
w
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ()
w ()
instance (Fail.MonadFail m) => Fail.MonadFail (MState t m) where
fail :: forall a. String -> MState t m a
fail String
str = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
str
instance (Monad m) => Monad (MState t m) where
return :: forall a. a -> MState t m a
return a
a = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
MState t m a
m >>= :: forall a b. MState t m a -> (a -> MState t m b) -> MState t m b
>>= a -> MState t m b
k = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
t -> do
a
a <- forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
m (TVar t, TVar [(ThreadId, TMVar ())])
t
forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' (a -> MState t m b
k a
a) (TVar t, TVar [(ThreadId, TMVar ())])
t
instance (Functor f) => Functor (MState t f) where
fmap :: forall a b. (a -> b) -> MState t f a -> MState t f b
fmap a -> b
f MState t f a
m = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
t -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t f a
m (TVar t, TVar [(ThreadId, TMVar ())])
t)
instance (Applicative m, Monad m) => Applicative (MState t m) where
pure :: forall a. a -> MState t m a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. MState t m (a -> b) -> MState t m a -> MState t m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance (Alternative m, Monad m) => Alternative (MState t m) where
empty :: forall a. MState t m a
empty = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
MState t m a
m <|> :: forall a. MState t m a -> MState t m a -> MState t m a
<|> MState t m a
n = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
t -> forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
m (TVar t, TVar [(ThreadId, TMVar ())])
t forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
n (TVar t, TVar [(ThreadId, TMVar ())])
t
instance (MonadPlus m) => MonadPlus (MState t m) where
mzero :: forall a. MState t m a
mzero = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
MState t m a
m mplus :: forall a. MState t m a -> MState t m a -> MState t m a
`mplus` MState t m a
n = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
t -> forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
m (TVar t, TVar [(ThreadId, TMVar ())])
t forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
n (TVar t, TVar [(ThreadId, TMVar ())])
t
instance (MonadIO m) => MonadState t (MState t m) where
get :: MState t m t
get = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t
r,TVar [(ThreadId, TMVar ())]
_) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> IO a
readTVarIO TVar t
r
put :: t -> MState t m ()
put t
val = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t
r,TVar [(ThreadId, TMVar ())]
_) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> a -> STM ()
writeTVar TVar t
r t
val
instance (MonadFix m) => MonadFix (MState t m) where
mfix :: forall a. (a -> MState t m a) -> MState t m a
mfix a -> MState t m a
f = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
s -> forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \a
a -> forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' (a -> MState t m a
f a
a) (TVar t, TVar [(ThreadId, TMVar ())])
s
instance MonadTrans (MState t) where
lift :: forall (m :: * -> *) a. Monad m => m a -> MState t m a
lift m a
m = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
_ -> m a
m
instance (MonadIO m) => MonadIO (MState t m) where
liftIO :: forall a. IO a -> MState t m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance (MonadCont m) => MonadCont (MState t m) where
callCC :: forall a b. ((a -> MState t m b) -> MState t m a) -> MState t m a
callCC (a -> MState t m b) -> MState t m a
f = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
s ->
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC forall a b. (a -> b) -> a -> b
$ \a -> m b
c ->
forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' ((a -> MState t m b) -> MState t m a
f (\a
a -> forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
_ -> a -> m b
c a
a)) (TVar t, TVar [(ThreadId, TMVar ())])
s
instance (MonadError e m) => MonadError e (MState t m) where
throwError :: forall a. e -> MState t m a
throwError = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
MState t m a
m catchError :: forall a. MState t m a -> (e -> MState t m a) -> MState t m a
`catchError` e -> MState t m a
h = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
s ->
forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
m (TVar t, TVar [(ThreadId, TMVar ())])
s forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \e
e -> forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' (e -> MState t m a
h e
e) (TVar t, TVar [(ThreadId, TMVar ())])
s
instance (MonadReader r m) => MonadReader r (MState t m) where
ask :: MState t m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
local :: forall a. (r -> r) -> MState t m a -> MState t m a
local r -> r
f MState t m a
m = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
s -> forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
m (TVar t, TVar [(ThreadId, TMVar ())])
s)
instance (MonadWriter w m) => MonadWriter w (MState t m) where
tell :: w -> MState t m ()
tell = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
listen :: forall a. MState t m a -> MState t m (a, w)
listen MState t m a
m = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
m
pass :: forall a. MState t m (a, w -> w) -> MState t m a
pass MState t m (a, w -> w)
m = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m (a, w -> w)
m
instance MonadTransPeel (MState t) where
peel :: forall (m :: * -> *) (n :: * -> *) (o :: * -> *) a.
(Monad m, Monad n, Monad o) =>
MState t n (MState t m a -> m (MState t o a))
peel = forall t (m :: * -> *) a.
((TVar t, TVar [(ThreadId, TMVar ())]) -> m a) -> MState t m a
MState forall a b. (a -> b) -> a -> b
$ \(TVar t, TVar [(ThreadId, TMVar ())])
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \MState t m a
m -> do
a
a <- forall t (m :: * -> *) a.
MState t m a -> (TVar t, TVar [(ThreadId, TMVar ())]) -> m a
runMState' MState t m a
m (TVar t, TVar [(ThreadId, TMVar ())])
t
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return a
a
instance MonadPeelIO m => MonadPeelIO (MState t m) where
peelIO :: forall a. MState t m (MState t m a -> IO (MState t m a))
peelIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) (m' :: * -> *)
(n' :: * -> *) (o' :: * -> *) a.
(MonadTransPeel t, Monad m, Monad m', Monad n', Monad (t n'),
Monad o', Monad (t o')) =>
n' (m' (t o' a) -> m (o' (t o' a))) -> t n' (t m' a -> m (t o' a))
liftPeel forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO