{-# LANGUAGE FlexibleContexts, GADTs, RankNTypes, ScopedTypeVariables #-}
module Data.Machine.Concurrent.AsyncStep where
import Control.Concurrent.Async.Lifted (Async, async, wait)
import Control.Monad.Trans.Control (MonadBaseControl, StM)
import Data.Machine
type MachineStep m k o = Step k o (MachineT m k o)
type AsyncStep m k o = Async (StM m (MachineStep m k o))
awaitStep :: (a -> d) -> k' a -> d -> (d -> r) -> Step k' b r
awaitStep :: (a -> d) -> k' a -> d -> (d -> r) -> Step k' b r
awaitStep a -> d
f k' a
sel d
ff d -> r
k = (a -> r) -> k' a -> r -> Step k' b r
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (d -> r
k (d -> r) -> (a -> d) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> d
f) k' a
sel (d -> r
k d
ff)
asyncRun :: MonadBaseControl IO m => MachineT m k o -> m (AsyncStep m k o)
asyncRun :: MachineT m k o -> m (AsyncStep m k o)
asyncRun = m (Step k o (MachineT m k o)) -> m (AsyncStep m k o)
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async (m (Step k o (MachineT m k o)) -> m (AsyncStep m k o))
-> (MachineT m k o -> m (Step k o (MachineT m k o)))
-> MachineT m k o
-> m (AsyncStep m k o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MachineT m k o -> m (Step k o (MachineT m k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT
stepAsync :: forall m k k' a' d b.
MonadBaseControl IO m
=> (forall c. k c -> k' c)
-> AsyncStep m k a'
-> (a' -> d)
-> d
-> d
-> (AsyncStep m k a' -> d -> MachineT m k' b)
-> MachineT m k' b
stepAsync :: (forall c. k c -> k' c)
-> AsyncStep m k a'
-> (a' -> d)
-> d
-> d
-> (AsyncStep m k a' -> d -> MachineT m k' b)
-> MachineT m k' b
stepAsync forall c. k c -> k' c
sel AsyncStep m k a'
src a' -> d
f d
def d
prev AsyncStep m k a' -> d -> MachineT m k' b
go = m (Step k' b (MachineT m k' b)) -> MachineT m k' b
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k' b (MachineT m k' b)) -> MachineT m k' b)
-> m (Step k' b (MachineT m k' b)) -> MachineT m k' b
forall a b. (a -> b) -> a -> b
$ AsyncStep m k a' -> m (Step k a' (MachineT m k a'))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
Async (StM m a) -> m a
wait AsyncStep m k a'
src m (Step k a' (MachineT m k a'))
-> (Step k a' (MachineT m k a') -> m (Step k' b (MachineT m k' b)))
-> m (Step k' b (MachineT m k' b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step k a' (MachineT m k a')
u -> case Step k a' (MachineT m k a')
u of
Step k a' (MachineT m k a')
Stop -> MachineT m k a' -> d -> m (Step k' b (MachineT m k' b))
go' MachineT m k a'
forall (k :: * -> *) b. Machine k b
stopped d
def
Yield a'
a MachineT m k a'
k -> MachineT m k a' -> d -> m (Step k' b (MachineT m k' b))
go' MachineT m k a'
k (a' -> d
f a'
a)
Await t -> MachineT m k a'
g k t
kg MachineT m k a'
fg -> Step k' b (MachineT m k' b) -> m (Step k' b (MachineT m k' b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k' b (MachineT m k' b) -> m (Step k' b (MachineT m k' b)))
-> Step k' b (MachineT m k' b) -> m (Step k' b (MachineT m k' b))
forall a b. (a -> b) -> a -> b
$ (t -> MachineT m k a')
-> k' t
-> MachineT m k a'
-> (MachineT m k a' -> MachineT m k' b)
-> Step k' b (MachineT m k' b)
forall a d (k' :: * -> *) r b.
(a -> d) -> k' a -> d -> (d -> r) -> Step k' b r
awaitStep t -> MachineT m k a'
g (k t -> k' t
forall c. k c -> k' c
sel k t
kg) MachineT m k a'
fg (m (Step k' b (MachineT m k' b)) -> MachineT m k' b
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k' b (MachineT m k' b)) -> MachineT m k' b)
-> (MachineT m k a' -> m (Step k' b (MachineT m k' b)))
-> MachineT m k a'
-> MachineT m k' b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MachineT m k a' -> d -> m (Step k' b (MachineT m k' b)))
-> d -> MachineT m k a' -> m (Step k' b (MachineT m k' b))
forall a b c. (a -> b -> c) -> b -> a -> c
flip MachineT m k a' -> d -> m (Step k' b (MachineT m k' b))
go' d
prev)
where go' :: MachineT m k a' -> d -> m (MachineStep m k' b)
go' :: MachineT m k a' -> d -> m (Step k' b (MachineT m k' b))
go' MachineT m k a'
k d
d = MachineT m k a' -> m (AsyncStep m k a')
forall (m :: * -> *) (k :: * -> *) o.
MonadBaseControl IO m =>
MachineT m k o -> m (AsyncStep m k o)
asyncRun MachineT m k a'
k m (AsyncStep m k a')
-> (AsyncStep m k a' -> m (Step k' b (MachineT m k' b)))
-> m (Step k' b (MachineT m k' b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MachineT m k' b -> m (Step k' b (MachineT m k' b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k' b -> m (Step k' b (MachineT m k' b)))
-> (AsyncStep m k a' -> MachineT m k' b)
-> AsyncStep m k a'
-> m (Step k' b (MachineT m k' b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AsyncStep m k a' -> d -> MachineT m k' b)
-> d -> AsyncStep m k a' -> MachineT m k' b
forall a b c. (a -> b -> c) -> b -> a -> c
flip AsyncStep m k a' -> d -> MachineT m k' b
go d
d
asyncEncased :: MonadBaseControl IO m
=> (AsyncStep m k1 o1 -> MachineT m k o)
-> MachineT m k1 o1
-> MachineT m k o
asyncEncased :: (AsyncStep m k1 o1 -> MachineT m k o)
-> MachineT m k1 o1 -> MachineT m k o
asyncEncased AsyncStep m k1 o1 -> MachineT m k o
f MachineT m k1 o1
x = m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> m (Step k o (MachineT m k o)) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ MachineT m k1 o1 -> m (AsyncStep m k1 o1)
forall (m :: * -> *) (k :: * -> *) o.
MonadBaseControl IO m =>
MachineT m k o -> m (AsyncStep m k o)
asyncRun MachineT m k1 o1
x m (AsyncStep m k1 o1)
-> (AsyncStep m k1 o1 -> m (Step k o (MachineT m k o)))
-> m (Step k o (MachineT m k o))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MachineT m k o -> m (Step k o (MachineT m k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k o -> m (Step k o (MachineT m k o)))
-> (AsyncStep m k1 o1 -> MachineT m k o)
-> AsyncStep m k1 o1
-> m (Step k o (MachineT m k o))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsyncStep m k1 o1 -> MachineT m k o
f
asyncAwait :: MonadBaseControl IO m
=> (a -> MachineT m k o)
-> k' a
-> MachineT m k o
-> (AsyncStep m k o -> MachineT m k1 o1)
-> m (Step k' b (MachineT m k1 o1))
asyncAwait :: (a -> MachineT m k o)
-> k' a
-> MachineT m k o
-> (AsyncStep m k o -> MachineT m k1 o1)
-> m (Step k' b (MachineT m k1 o1))
asyncAwait a -> MachineT m k o
f k' a
sel MachineT m k o
ff = Step k' b (MachineT m k1 o1) -> m (Step k' b (MachineT m k1 o1))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k' b (MachineT m k1 o1) -> m (Step k' b (MachineT m k1 o1)))
-> ((AsyncStep m k o -> MachineT m k1 o1)
-> Step k' b (MachineT m k1 o1))
-> (AsyncStep m k o -> MachineT m k1 o1)
-> m (Step k' b (MachineT m k1 o1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> MachineT m k o)
-> k' a
-> MachineT m k o
-> (MachineT m k o -> MachineT m k1 o1)
-> Step k' b (MachineT m k1 o1)
forall a d (k' :: * -> *) r b.
(a -> d) -> k' a -> d -> (d -> r) -> Step k' b r
awaitStep a -> MachineT m k o
f k' a
sel MachineT m k o
ff ((MachineT m k o -> MachineT m k1 o1)
-> Step k' b (MachineT m k1 o1))
-> ((AsyncStep m k o -> MachineT m k1 o1)
-> MachineT m k o -> MachineT m k1 o1)
-> (AsyncStep m k o -> MachineT m k1 o1)
-> Step k' b (MachineT m k1 o1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AsyncStep m k o -> MachineT m k1 o1)
-> MachineT m k o -> MachineT m k1 o1
forall (m :: * -> *) (k1 :: * -> *) o1 (k :: * -> *) o.
MonadBaseControl IO m =>
(AsyncStep m k1 o1 -> MachineT m k o)
-> MachineT m k1 o1 -> MachineT m k o
asyncEncased