{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
module Crem.StateMachine where
import Crem.BaseMachine as BaseMachine
import Crem.Render.RenderableVertices (RenderableVertices)
import Crem.Topology (AllowAllTopology, Topology)
import "base" Control.Arrow (Arrow (arr, first), ArrowChoice (left))
import "base" Control.Category (Category (..))
import "base" Data.Bifunctor (Bifunctor (second), bimap)
import "base" Data.Foldable (foldlM)
import "base" Data.Kind (Type)
import "profunctors" Data.Profunctor (Choice (..), Profunctor (..), Strong (..))
import "singletons-base" Data.Singletons (Demote, SingI, SingKind)
import Prelude hiding ((.))
data StateMachineT m input output where
Basic
:: forall m vertex (topology :: Topology vertex) input output
. ( Demote vertex ~ vertex
, SingKind vertex
, SingI topology
, Eq vertex
, Show vertex
, RenderableVertices vertex
)
=> BaseMachineT m topology input output
-> StateMachineT m input output
Sequential
:: StateMachineT m a b
-> StateMachineT m b c
-> StateMachineT m a c
Parallel
:: StateMachineT m a b
-> StateMachineT m c d
-> StateMachineT m (a, c) (b, d)
Alternative
:: StateMachineT m a b
-> StateMachineT m c d
-> StateMachineT m (Either a c) (Either b d)
Feedback
:: (Foldable n, Monoid (n a), Monoid (n b))
=> StateMachineT m a (n b)
-> StateMachineT m b (n a)
-> StateMachineT m a (n b)
Kleisli
:: (Foldable n, Monoid (n c))
=> StateMachineT m a (n b)
-> StateMachineT m b (n c)
-> StateMachineT m a (n c)
type StateMachine a b = forall m. Monad m => StateMachineT m a b
hoist :: (forall x. m x -> n x) -> StateMachineT m a b -> StateMachineT n a b
hoist :: forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist forall x. m x -> n x
f StateMachineT m a b
machine = case StateMachineT m a b
machine of
Basic BaseMachineT m topology a b
baseMachine -> BaseMachineT n topology a b -> StateMachineT n a b
forall (m :: * -> *) n (c :: Topology n) input output.
(Demote n ~ n, SingKind n, SingI c, Eq n, Show n,
RenderableVertices n) =>
BaseMachineT m c input output -> StateMachineT m input output
Basic (BaseMachineT n topology a b -> StateMachineT n a b)
-> BaseMachineT n topology a b -> StateMachineT n a b
forall a b. (a -> b) -> a -> b
$ (forall x. m x -> n x)
-> BaseMachineT m topology a b -> BaseMachineT n topology a b
forall {vertex} (m :: * -> *) (n :: * -> *)
(topology :: Topology vertex) a b.
(forall x. m x -> n x)
-> BaseMachineT m topology a b -> BaseMachineT n topology a b
baseHoist m x -> n x
forall x. m x -> n x
f BaseMachineT m topology a b
baseMachine
Sequential StateMachineT m a b
machine1 StateMachineT m b b
machine2 -> StateMachineT n a b -> StateMachineT n b b -> StateMachineT n a b
forall (m :: * -> *) a n c.
StateMachineT m a n -> StateMachineT m n c -> StateMachineT m a c
Sequential ((forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist m x -> n x
forall x. m x -> n x
f StateMachineT m a b
machine1) ((forall x. m x -> n x)
-> StateMachineT m b b -> StateMachineT n b b
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist m x -> n x
forall x. m x -> n x
f StateMachineT m b b
machine2)
Parallel StateMachineT m a b
machine1 StateMachineT m c d
machine2 -> StateMachineT n a b
-> StateMachineT n c d -> StateMachineT n (a, c) (b, d)
forall (m :: * -> *) n c b d.
StateMachineT m n c
-> StateMachineT m b d -> StateMachineT m (n, b) (c, d)
Parallel ((forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist m x -> n x
forall x. m x -> n x
f StateMachineT m a b
machine1) ((forall x. m x -> n x)
-> StateMachineT m c d -> StateMachineT n c d
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist m x -> n x
forall x. m x -> n x
f StateMachineT m c d
machine2)
Alternative StateMachineT m a b
machine1 StateMachineT m c d
machine2 -> StateMachineT n a b
-> StateMachineT n c d -> StateMachineT n (Either a c) (Either b d)
forall (m :: * -> *) n c b d.
StateMachineT m n c
-> StateMachineT m b d -> StateMachineT m (Either n b) (Either c d)
Alternative ((forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist m x -> n x
forall x. m x -> n x
f StateMachineT m a b
machine1) ((forall x. m x -> n x)
-> StateMachineT m c d -> StateMachineT n c d
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist m x -> n x
forall x. m x -> n x
f StateMachineT m c d
machine2)
Feedback StateMachineT m a (n b)
machine1 StateMachineT m b (n a)
machine2 -> StateMachineT n a (n b)
-> StateMachineT n b (n a) -> StateMachineT n a (n b)
forall (n :: * -> *) a c (m :: * -> *).
(Foldable n, Monoid (n a), Monoid (n c)) =>
StateMachineT m a (n c)
-> StateMachineT m c (n a) -> StateMachineT m a (n c)
Feedback ((forall x. m x -> n x)
-> StateMachineT m a (n b) -> StateMachineT n a (n b)
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist m x -> n x
forall x. m x -> n x
f StateMachineT m a (n b)
machine1) ((forall x. m x -> n x)
-> StateMachineT m b (n a) -> StateMachineT n b (n a)
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist m x -> n x
forall x. m x -> n x
f StateMachineT m b (n a)
machine2)
Kleisli StateMachineT m a (n b)
machine1 StateMachineT m b (n c)
machine2 -> StateMachineT n a (n b)
-> StateMachineT n b (n c) -> StateMachineT n a (n c)
forall (n :: * -> *) c (m :: * -> *) a b.
(Foldable n, Monoid (n c)) =>
StateMachineT m a (n b)
-> StateMachineT m b (n c) -> StateMachineT m a (n c)
Kleisli ((forall x. m x -> n x)
-> StateMachineT m a (n b) -> StateMachineT n a (n b)
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist m x -> n x
forall x. m x -> n x
f StateMachineT m a (n b)
machine1) ((forall x. m x -> n x)
-> StateMachineT m b (n c) -> StateMachineT n b (n c)
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> StateMachineT m a b -> StateMachineT n a b
hoist m x -> n x
forall x. m x -> n x
f StateMachineT m b (n c)
machine2)
statelessT :: Applicative m => (a -> m b) -> StateMachineT m a b
statelessT :: forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> StateMachineT m a b
statelessT a -> m b
f = BaseMachineT m ('Topology '[]) a b -> StateMachineT m a b
forall (m :: * -> *) n (c :: Topology n) input output.
(Demote n ~ n, SingKind n, SingI c, Eq n, Show n,
RenderableVertices n) =>
BaseMachineT m c input output -> StateMachineT m input output
Basic (BaseMachineT m ('Topology '[]) a b -> StateMachineT m a b)
-> BaseMachineT m ('Topology '[]) a b -> StateMachineT m a b
forall a b. (a -> b) -> a -> b
$ (a -> m b) -> BaseMachineT m TrivialTopology a b
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> BaseMachineT m TrivialTopology a b
statelessBaseT a -> m b
f
stateless :: Applicative m => (a -> b) -> StateMachineT m a b
stateless :: forall (m :: * -> *) a b.
Applicative m =>
(a -> b) -> StateMachineT m a b
stateless a -> b
f = (a -> m b) -> StateMachineT m a b
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> StateMachineT m a b
statelessT (b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f)
unrestrictedMachine
:: ( Demote vertex ~ vertex
, SingKind vertex
, SingI (AllowAllTopology @vertex)
, Eq vertex
, Show vertex
, RenderableVertices vertex
)
=> ( forall initialVertex
. state initialVertex
-> a
-> ActionResult m (AllowAllTopology @vertex) state initialVertex b
)
-> InitialState (state :: vertex -> Type)
-> StateMachineT m a b
unrestrictedMachine :: forall vertex (state :: vertex -> *) a (m :: * -> *) b.
(Demote vertex ~ vertex, SingKind vertex, SingI AllowAllTopology,
Eq vertex, Show vertex, RenderableVertices vertex) =>
(forall (initialVertex :: vertex).
state initialVertex
-> a -> ActionResult m AllowAllTopology state initialVertex b)
-> InitialState state -> StateMachineT m a b
unrestrictedMachine forall (initialVertex :: vertex).
state initialVertex
-> a -> ActionResult m AllowAllTopology state initialVertex b
action InitialState state
state = BaseMachineT
m
('Topology
(Let6989586621679177149Go
((++@#@$) .@#@$$$ Lambda_6989586621679106594Sym0)
'[]
(EnumFromTo MinBound MaxBound)
(EnumFromTo MinBound MaxBound)))
a
b
-> StateMachineT m a b
forall (m :: * -> *) n (c :: Topology n) input output.
(Demote n ~ n, SingKind n, SingI c, Eq n, Show n,
RenderableVertices n) =>
BaseMachineT m c input output -> StateMachineT m input output
Basic (BaseMachineT
m
('Topology
(Let6989586621679177149Go
((++@#@$) .@#@$$$ Lambda_6989586621679106594Sym0)
'[]
(EnumFromTo MinBound MaxBound)
(EnumFromTo MinBound MaxBound)))
a
b
-> StateMachineT m a b)
-> BaseMachineT
m
('Topology
(Let6989586621679177149Go
((++@#@$) .@#@$$$ Lambda_6989586621679106594Sym0)
'[]
(EnumFromTo MinBound MaxBound)
(EnumFromTo MinBound MaxBound)))
a
b
-> StateMachineT m a b
forall a b. (a -> b) -> a -> b
$ (forall (initialVertex :: vertex).
state initialVertex
-> a -> ActionResult m AllowAllTopology state initialVertex b)
-> InitialState state -> BaseMachineT m AllowAllTopology a b
forall vertex (state :: vertex -> *) a (m :: * -> *) b.
(forall (initialVertex :: vertex).
state initialVertex
-> a -> ActionResult m AllowAllTopology state initialVertex b)
-> InitialState state -> BaseMachineT m AllowAllTopology a b
unrestrictedBaseMachineT state initialVertex
-> a -> ActionResult m AllowAllTopology state initialVertex b
forall (initialVertex :: vertex).
state initialVertex
-> a -> ActionResult m AllowAllTopology state initialVertex b
action InitialState state
state
instance Monad m => Category (StateMachineT m) where
id :: StateMachineT m a a
id :: forall a. StateMachineT m a a
id = BaseMachineT m ('Topology '[]) a a -> StateMachineT m a a
forall (m :: * -> *) n (c :: Topology n) input output.
(Demote n ~ n, SingKind n, SingI c, Eq n, Show n,
RenderableVertices n) =>
BaseMachineT m c input output -> StateMachineT m input output
Basic BaseMachineT m ('Topology '[]) a a
BaseMachineT m TrivialTopology a a
forall a (m :: * -> *).
Monad m =>
BaseMachineT m TrivialTopology a a
identity
(.) :: StateMachineT m b c -> StateMachineT m a b -> StateMachineT m a c
. :: forall b c a.
StateMachineT m b c -> StateMachineT m a b -> StateMachineT m a c
(.) = (StateMachineT m a b -> StateMachineT m b c -> StateMachineT m a c)
-> StateMachineT m b c
-> StateMachineT m a b
-> StateMachineT m a c
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateMachineT m a b -> StateMachineT m b c -> StateMachineT m a c
forall (m :: * -> *) a n c.
StateMachineT m a n -> StateMachineT m n c -> StateMachineT m a c
Sequential
instance Applicative m => Profunctor (StateMachineT m) where
lmap :: (a -> b) -> StateMachineT m b c -> StateMachineT m a c
lmap :: forall a b c.
(a -> b) -> StateMachineT m b c -> StateMachineT m a c
lmap a -> b
f (Basic BaseMachineT m topology b c
baseMachine) = BaseMachineT m topology a c -> StateMachineT m a c
forall (m :: * -> *) n (c :: Topology n) input output.
(Demote n ~ n, SingKind n, SingI c, Eq n, Show n,
RenderableVertices n) =>
BaseMachineT m c input output -> StateMachineT m input output
Basic (BaseMachineT m topology a c -> StateMachineT m a c)
-> BaseMachineT m topology a c -> StateMachineT m a c
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> BaseMachineT m topology b c -> BaseMachineT m topology a c
forall a b c.
(a -> b)
-> BaseMachineT m topology b c -> BaseMachineT m topology a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f BaseMachineT m topology b c
baseMachine
lmap a -> b
f (Sequential StateMachineT m b b
machine1 StateMachineT m b c
machine2) = StateMachineT m a b -> StateMachineT m b c -> StateMachineT m a c
forall (m :: * -> *) a n c.
StateMachineT m a n -> StateMachineT m n c -> StateMachineT m a c
Sequential ((a -> b) -> StateMachineT m b b -> StateMachineT m a b
forall a b c.
(a -> b) -> StateMachineT m b c -> StateMachineT m a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f StateMachineT m b b
machine1) StateMachineT m b c
machine2
lmap a -> b
f StateMachineT m b c
machine = StateMachineT m a b -> StateMachineT m b c -> StateMachineT m a c
forall (m :: * -> *) a n c.
StateMachineT m a n -> StateMachineT m n c -> StateMachineT m a c
Sequential ((a -> b) -> StateMachineT m a b
forall (m :: * -> *) a b.
Applicative m =>
(a -> b) -> StateMachineT m a b
stateless a -> b
f) StateMachineT m b c
machine
rmap :: (b -> c) -> StateMachineT m a b -> StateMachineT m a c
rmap :: forall b c a.
(b -> c) -> StateMachineT m a b -> StateMachineT m a c
rmap b -> c
f (Basic BaseMachineT m topology a b
baseMachine) = BaseMachineT m topology a c -> StateMachineT m a c
forall (m :: * -> *) n (c :: Topology n) input output.
(Demote n ~ n, SingKind n, SingI c, Eq n, Show n,
RenderableVertices n) =>
BaseMachineT m c input output -> StateMachineT m input output
Basic (BaseMachineT m topology a c -> StateMachineT m a c)
-> BaseMachineT m topology a c -> StateMachineT m a c
forall a b. (a -> b) -> a -> b
$ (b -> c)
-> BaseMachineT m topology a b -> BaseMachineT m topology a c
forall b c a.
(b -> c)
-> BaseMachineT m topology a b -> BaseMachineT m topology a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap b -> c
f BaseMachineT m topology a b
baseMachine
rmap b -> c
f (Sequential StateMachineT m a b
machine1 StateMachineT m b b
machine2) = StateMachineT m a b -> StateMachineT m b c -> StateMachineT m a c
forall (m :: * -> *) a n c.
StateMachineT m a n -> StateMachineT m n c -> StateMachineT m a c
Sequential StateMachineT m a b
machine1 ((b -> c) -> StateMachineT m b b -> StateMachineT m b c
forall b c a.
(b -> c) -> StateMachineT m a b -> StateMachineT m a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap b -> c
f StateMachineT m b b
machine2)
rmap b -> c
f StateMachineT m a b
machine = StateMachineT m a b -> StateMachineT m b c -> StateMachineT m a c
forall (m :: * -> *) a n c.
StateMachineT m a n -> StateMachineT m n c -> StateMachineT m a c
Sequential StateMachineT m a b
machine ((b -> c) -> StateMachineT m b c
forall (m :: * -> *) a b.
Applicative m =>
(a -> b) -> StateMachineT m a b
stateless b -> c
f)
instance Monad m => Strong (StateMachineT m) where
first' :: StateMachineT m a b -> StateMachineT m (a, c) (b, c)
first' :: forall a b c. StateMachineT m a b -> StateMachineT m (a, c) (b, c)
first' = (StateMachineT m a b
-> StateMachineT m c c -> StateMachineT m (a, c) (b, c))
-> StateMachineT m c c
-> StateMachineT m a b
-> StateMachineT m (a, c) (b, c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateMachineT m a b
-> StateMachineT m c c -> StateMachineT m (a, c) (b, c)
forall (m :: * -> *) n c b d.
StateMachineT m n c
-> StateMachineT m b d -> StateMachineT m (n, b) (c, d)
Parallel StateMachineT m c c
forall a. StateMachineT m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Control.Category.id
second' :: StateMachineT m a b -> StateMachineT m (c, a) (c, b)
second' :: forall a b c. StateMachineT m a b -> StateMachineT m (c, a) (c, b)
second' = StateMachineT m c c
-> StateMachineT m a b -> StateMachineT m (c, a) (c, b)
forall (m :: * -> *) n c b d.
StateMachineT m n c
-> StateMachineT m b d -> StateMachineT m (n, b) (c, d)
Parallel StateMachineT m c c
forall a. StateMachineT m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Control.Category.id
instance Monad m => Choice (StateMachineT m) where
left' :: StateMachineT m a b -> StateMachineT m (Either a c) (Either b c)
left' :: forall a b c.
StateMachineT m a b -> StateMachineT m (Either a c) (Either b c)
left' = (StateMachineT m a b
-> StateMachineT m c c
-> StateMachineT m (Either a c) (Either b c))
-> StateMachineT m c c
-> StateMachineT m a b
-> StateMachineT m (Either a c) (Either b c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateMachineT m a b
-> StateMachineT m c c -> StateMachineT m (Either a c) (Either b c)
forall (m :: * -> *) n c b d.
StateMachineT m n c
-> StateMachineT m b d -> StateMachineT m (Either n b) (Either c d)
Alternative StateMachineT m c c
forall a. StateMachineT m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Control.Category.id
right' :: StateMachineT m a b -> StateMachineT m (Either c a) (Either c b)
right' :: forall a b c.
StateMachineT m a b -> StateMachineT m (Either c a) (Either c b)
right' = StateMachineT m c c
-> StateMachineT m a b -> StateMachineT m (Either c a) (Either c b)
forall (m :: * -> *) n c b d.
StateMachineT m n c
-> StateMachineT m b d -> StateMachineT m (Either n b) (Either c d)
Alternative StateMachineT m c c
forall a. StateMachineT m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Control.Category.id
instance Monad m => Arrow (StateMachineT m) where
arr :: (a -> b) -> StateMachineT m a b
arr :: forall b c. (b -> c) -> StateMachineT m b c
arr = (a -> b) -> StateMachineT m a b
forall (m :: * -> *) a b.
Applicative m =>
(a -> b) -> StateMachineT m a b
stateless
first :: StateMachineT m a b -> StateMachineT m (a, c) (b, c)
first :: forall b c d. StateMachineT m b c -> StateMachineT m (b, d) (c, d)
first = StateMachineT m a b -> StateMachineT m (a, c) (b, c)
forall b c d. StateMachineT m b c -> StateMachineT m (b, d) (c, d)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first'
instance Monad m => ArrowChoice (StateMachineT m) where
left :: StateMachineT m a b -> StateMachineT m (Either a c) (Either b c)
left :: forall b c d.
StateMachineT m b c -> StateMachineT m (Either b d) (Either c d)
left = StateMachineT m a b -> StateMachineT m (Either a c) (Either b c)
forall b c d.
StateMachineT m b c -> StateMachineT m (Either b d) (Either c d)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left'
run :: Monad m => StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run :: forall (m :: * -> *) a b.
Monad m =>
StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run (Basic BaseMachineT m topology a b
baseMachine) a
a = (BaseMachineT m topology a b -> StateMachineT m a b)
-> (b, BaseMachineT m topology a b) -> (b, StateMachineT m a b)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second BaseMachineT m topology a b -> StateMachineT m a b
forall (m :: * -> *) n (c :: Topology n) input output.
(Demote n ~ n, SingKind n, SingI c, Eq n, Show n,
RenderableVertices n) =>
BaseMachineT m c input output -> StateMachineT m input output
Basic ((b, BaseMachineT m topology a b) -> (b, StateMachineT m a b))
-> m (b, BaseMachineT m topology a b) -> m (b, StateMachineT m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BaseMachineT m topology a b
-> a -> m (b, BaseMachineT m topology a b)
forall {vertex} (m :: * -> *) (topology :: Topology vertex) input
output.
Functor m =>
BaseMachineT m topology input output
-> input -> m (output, BaseMachineT m topology input output)
runBaseMachineT BaseMachineT m topology a b
baseMachine a
a
run (Sequential StateMachineT m a b
machine1 StateMachineT m b b
machine2) a
a = do
(b
output1, StateMachineT m a b
machine1') <- StateMachineT m a b -> a -> m (b, StateMachineT m a b)
forall (m :: * -> *) a b.
Monad m =>
StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run StateMachineT m a b
machine1 a
a
(b
output2, StateMachineT m b b
machine2') <- StateMachineT m b b -> b -> m (b, StateMachineT m b b)
forall (m :: * -> *) a b.
Monad m =>
StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run StateMachineT m b b
machine2 b
output1
(b, StateMachineT m a b) -> m (b, StateMachineT m a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
output2, StateMachineT m a b -> StateMachineT m b b -> StateMachineT m a b
forall (m :: * -> *) a n c.
StateMachineT m a n -> StateMachineT m n c -> StateMachineT m a c
Sequential StateMachineT m a b
machine1' StateMachineT m b b
machine2')
run (Parallel StateMachineT m a b
machine1 StateMachineT m c d
machine2) a
a = do
(b
output1, StateMachineT m a b
machine1') <- StateMachineT m a b -> a -> m (b, StateMachineT m a b)
forall (m :: * -> *) a b.
Monad m =>
StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run StateMachineT m a b
machine1 ((a, c) -> a
forall a b. (a, b) -> a
fst a
(a, c)
a)
(d
output2, StateMachineT m c d
machine2') <- StateMachineT m c d -> c -> m (d, StateMachineT m c d)
forall (m :: * -> *) a b.
Monad m =>
StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run StateMachineT m c d
machine2 ((a, c) -> c
forall a b. (a, b) -> b
snd a
(a, c)
a)
(b, StateMachineT m a b) -> m (b, StateMachineT m a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b
output1, d
output2), StateMachineT m a b
-> StateMachineT m c d -> StateMachineT m (a, c) (b, d)
forall (m :: * -> *) n c b d.
StateMachineT m n c
-> StateMachineT m b d -> StateMachineT m (n, b) (c, d)
Parallel StateMachineT m a b
machine1' StateMachineT m c d
machine2')
run (Alternative StateMachineT m a b
machine1 StateMachineT m c d
machine2) a
a =
case a
a of
Left a
a1 -> (b -> b)
-> (StateMachineT m a b -> StateMachineT m a b)
-> (b, StateMachineT m a b)
-> (b, StateMachineT m a b)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> b
b -> Either b d
forall a b. a -> Either a b
Left (StateMachineT m a b
-> StateMachineT m c d -> StateMachineT m (Either a c) (Either b d)
forall (m :: * -> *) n c b d.
StateMachineT m n c
-> StateMachineT m b d -> StateMachineT m (Either n b) (Either c d)
`Alternative` StateMachineT m c d
machine2) ((b, StateMachineT m a b) -> (b, StateMachineT m a b))
-> m (b, StateMachineT m a b) -> m (b, StateMachineT m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateMachineT m a b -> a -> m (b, StateMachineT m a b)
forall (m :: * -> *) a b.
Monad m =>
StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run StateMachineT m a b
machine1 a
a1
Right c
a2 -> (d -> b)
-> (StateMachineT m c d -> StateMachineT m a b)
-> (d, StateMachineT m c d)
-> (b, StateMachineT m a b)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap d -> b
d -> Either b d
forall a b. b -> Either a b
Right (StateMachineT m a b
machine1 `Alternative`) ((d, StateMachineT m c d) -> (b, StateMachineT m a b))
-> m (d, StateMachineT m c d) -> m (b, StateMachineT m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateMachineT m c d -> c -> m (d, StateMachineT m c d)
forall (m :: * -> *) a b.
Monad m =>
StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run StateMachineT m c d
machine2 c
a2
run (Feedback StateMachineT m a (n b)
machine1 StateMachineT m b (n a)
machine2) a
a = do
(n b
bs, StateMachineT m a (n b)
machine1') <- StateMachineT m a (n b) -> a -> m (n b, StateMachineT m a (n b))
forall (m :: * -> *) a b.
Monad m =>
StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run StateMachineT m a (n b)
machine1 a
a
(n a
as, StateMachineT m b (n a)
machine2') <- StateMachineT m b (n a) -> n b -> m (n a, StateMachineT m b (n a))
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
StateMachineT m a b -> f a -> m (b, StateMachineT m a b)
runMultiple StateMachineT m b (n a)
machine2 n b
bs
(n b -> n b)
-> (n b, StateMachineT m a (n b)) -> (n b, StateMachineT m a (n b))
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (n b
bs <>) ((n b, StateMachineT m a (n b)) -> (b, StateMachineT m a b))
-> m (n b, StateMachineT m a (n b)) -> m (b, StateMachineT m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateMachineT m a (n b) -> n a -> m (n b, StateMachineT m a (n b))
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
StateMachineT m a b -> f a -> m (b, StateMachineT m a b)
runMultiple (StateMachineT m a (n b)
-> StateMachineT m b (n a) -> StateMachineT m a (n b)
forall (n :: * -> *) a c (m :: * -> *).
(Foldable n, Monoid (n a), Monoid (n c)) =>
StateMachineT m a (n c)
-> StateMachineT m c (n a) -> StateMachineT m a (n c)
Feedback StateMachineT m a (n b)
machine1' StateMachineT m b (n a)
machine2') n a
as
run (Kleisli StateMachineT m a (n b)
machine1 StateMachineT m b (n c)
machine2) a
a = do
(n b
bs, StateMachineT m a (n b)
machine1') <- StateMachineT m a (n b) -> a -> m (n b, StateMachineT m a (n b))
forall (m :: * -> *) a b.
Monad m =>
StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run StateMachineT m a (n b)
machine1 a
a
(n c
cs, StateMachineT m b (n c)
machine2') <- StateMachineT m b (n c) -> n b -> m (n c, StateMachineT m b (n c))
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
StateMachineT m a b -> f a -> m (b, StateMachineT m a b)
runMultiple StateMachineT m b (n c)
machine2 n b
bs
(b, StateMachineT m a b) -> m (b, StateMachineT m a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
n c
cs, StateMachineT m a (n b)
-> StateMachineT m b (n c) -> StateMachineT m a (n c)
forall (n :: * -> *) c (m :: * -> *) a b.
(Foldable n, Monoid (n c)) =>
StateMachineT m a (n b)
-> StateMachineT m b (n c) -> StateMachineT m a (n c)
Kleisli StateMachineT m a (n b)
machine1' StateMachineT m b (n c)
machine2')
runMultiple
:: (Monad m, Foldable f, Monoid b)
=> StateMachineT m a b
-> f a
-> m (b, StateMachineT m a b)
runMultiple :: forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
StateMachineT m a b -> f a -> m (b, StateMachineT m a b)
runMultiple StateMachineT m a b
machine =
((b, StateMachineT m a b) -> a -> m (b, StateMachineT m a b))
-> (b, StateMachineT m a b) -> f a -> m (b, StateMachineT m a b)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
(\(b
b, StateMachineT m a b
machine') a
a -> (b -> b) -> (b, StateMachineT m a b) -> (b, StateMachineT m a b)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (b
b <>) ((b, StateMachineT m a b) -> (b, StateMachineT m a b))
-> m (b, StateMachineT m a b) -> m (b, StateMachineT m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateMachineT m a b -> a -> m (b, StateMachineT m a b)
forall (m :: * -> *) a b.
Monad m =>
StateMachineT m a b -> a -> m (b, StateMachineT m a b)
run StateMachineT m a b
machine' a
a)
(b
forall a. Monoid a => a
mempty, StateMachineT m a b
machine)