module Control.Wire.Switch
(
(-->),
(>--),
modes,
switch,
dSwitch,
kSwitch,
dkSwitch,
rSwitch,
drSwitch,
alternate,
krSwitch,
dkrSwitch
)
where
import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Wire.Core
import Control.Wire.Event
import Control.Wire.Unsafe.Event
import qualified Data.Map as M
import Data.Monoid
(-->) :: (Monad m) => Wire s e m a b -> Wire s e m a b -> Wire s e m a b
Wire s e m a b
w1' --> :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> Wire s e m a b -> Wire s e m a b
--> Wire s e m a b
w2' =
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx' -> do
(Either e b
mx, Wire s e m a b
w1) <- Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w1' s
ds Either e a
mx'
case Either e b
mx of
Left e
_ | Right a
_ <- Either e a
mx' -> Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w2' s
ds Either e a
mx'
Either e b
_ -> Either e b
mx Either e b
-> m (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
`seq` (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b
mx, Wire s e m a b
w1 Wire s e m a b -> Wire s e m a b -> Wire s e m a b
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> Wire s e m a b -> Wire s e m a b
--> Wire s e m a b
w2')
infixr 1 -->
(>--) :: (Monad m) => Wire s e m a b -> Wire s e m a b -> Wire s e m a b
Wire s e m a b
w1' >-- :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> Wire s e m a b -> Wire s e m a b
>-- Wire s e m a b
w2' =
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx' -> do
(Either e b
m2, Wire s e m a b
w2) <- Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w2' s
ds Either e a
mx'
case Either e b
m2 of
Right b
_ -> Either e b
m2 Either e b
-> m (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
`seq` (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b
m2, Wire s e m a b
w2)
Either e b
_ -> do (Either e b
m1, Wire s e m a b
w1) <- Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w1' s
ds Either e a
mx'
Either e b
m1 Either e b
-> m (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
`seq` (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b
m1, Wire s e m a b
w1 Wire s e m a b -> Wire s e m a b -> Wire s e m a b
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> Wire s e m a b -> Wire s e m a b
>-- Wire s e m a b
w2)
infixr 1 >--
dkSwitch ::
(Monad m)
=> Wire s e m a b
-> Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
-> Wire s e m a b
dkSwitch :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b
-> Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
-> Wire s e m a b
dkSwitch Wire s e m a b
w1' Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
w2' =
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx' -> do
(Either e b
mx, Wire s e m a b
w1) <- Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w1' s
ds Either e a
mx'
(Either e (Event (Wire s e m a b -> Wire s e m a b))
mev, Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
w2) <- Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
-> s
-> Either e (a, b)
-> m (Either e (Event (Wire s e m a b -> Wire s e m a b)),
Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b)))
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
w2' s
ds ((a -> b -> (a, b)) -> Either e a -> Either e b -> Either e (a, b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Either e a
mx' Either e b
mx)
let w :: Wire s e m a b
w | Right (Event Wire s e m a b -> Wire s e m a b
sw) <- Either e (Event (Wire s e m a b -> Wire s e m a b))
mev = Wire s e m a b -> Wire s e m a b
sw Wire s e m a b
w1
| Bool
otherwise = Wire s e m a b
-> Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
-> Wire s e m a b
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b
-> Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
-> Wire s e m a b
dkSwitch Wire s e m a b
w1 Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
w2
(Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b
mx, Wire s e m a b
w)
drSwitch ::
(Monad m)
=> Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b)) b
drSwitch :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b
drSwitch Wire s e m a b
w' =
(s
-> Either e (a, Event (Wire s e m a b))
-> m (Either e b, Wire s e m (a, Event (Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b)) b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (a, Event (Wire s e m a b))
-> m (Either e b, Wire s e m (a, Event (Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b)) b)
-> (s
-> Either e (a, Event (Wire s e m a b))
-> m (Either e b, Wire s e m (a, Event (Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b)) b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (a, Event (Wire s e m a b))
mx' ->
let nw :: Wire s e m a b -> Wire s e m a b
nw Wire s e m a b
w | Right (a
_, Event Wire s e m a b
w1) <- Either e (a, Event (Wire s e m a b))
mx' = Wire s e m a b
w1
| Bool
otherwise = Wire s e m a b
w
in ((Either e b, Wire s e m a b)
-> (Either e b, Wire s e m (a, Event (Wire s e m a b)) b))
-> m (Either e b, Wire s e m a b)
-> m (Either e b, Wire s e m (a, Event (Wire s e m a b)) b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b)
-> (Either e b, Wire s e m a b)
-> (Either e b, Wire s e m (a, Event (Wire s e m a b)) b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b
drSwitch (Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b)
-> (Wire s e m a b -> Wire s e m a b)
-> Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wire s e m a b -> Wire s e m a b
nw)) (Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w' s
ds (((a, Event (Wire s e m a b)) -> a)
-> Either e (a, Event (Wire s e m a b)) -> Either e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Event (Wire s e m a b)) -> a
forall a b. (a, b) -> a
fst Either e (a, Event (Wire s e m a b))
mx'))
alternate ::
(Monad m)
=> Wire s e m a b
-> Wire s e m a b
-> Wire s e m (a, Event x) b
alternate :: forall (m :: * -> *) s e a b x.
Monad m =>
Wire s e m a b -> Wire s e m a b -> Wire s e m (a, Event x) b
alternate Wire s e m a b
w1 Wire s e m a b
w2 = Wire s e m a b
-> Wire s e m a b -> Wire s e m a b -> Wire s e m (a, Event x) b
forall {m :: * -> *} {s} {e} {a} {b} {a}.
Monad m =>
Wire s e m a b
-> Wire s e m a b -> Wire s e m a b -> Wire s e m (a, Event a) b
go Wire s e m a b
w1 Wire s e m a b
w2 Wire s e m a b
w1
where
go :: Wire s e m a b
-> Wire s e m a b -> Wire s e m a b -> Wire s e m (a, Event a) b
go Wire s e m a b
w1' Wire s e m a b
w2' Wire s e m a b
w' =
(s
-> Either e (a, Event a)
-> m (Either e b, Wire s e m (a, Event a) b))
-> Wire s e m (a, Event a) b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (a, Event a)
-> m (Either e b, Wire s e m (a, Event a) b))
-> Wire s e m (a, Event a) b)
-> (s
-> Either e (a, Event a)
-> m (Either e b, Wire s e m (a, Event a) b))
-> Wire s e m (a, Event a) b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (a, Event a)
mx' ->
let (Wire s e m a b
w1, Wire s e m a b
w2, Wire s e m a b
w) | Right (a
_, Event a
_) <- Either e (a, Event a)
mx' = (Wire s e m a b
w2', Wire s e m a b
w1', Wire s e m a b
w2')
| Bool
otherwise = (Wire s e m a b
w1', Wire s e m a b
w2', Wire s e m a b
w')
in ((Either e b, Wire s e m a b)
-> (Either e b, Wire s e m (a, Event a) b))
-> m (Either e b, Wire s e m a b)
-> m (Either e b, Wire s e m (a, Event a) b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Wire s e m a b -> Wire s e m (a, Event a) b)
-> (Either e b, Wire s e m a b)
-> (Either e b, Wire s e m (a, Event a) b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Wire s e m a b
-> Wire s e m a b -> Wire s e m a b -> Wire s e m (a, Event a) b
go Wire s e m a b
w1 Wire s e m a b
w2)) (Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w s
ds (((a, Event a) -> a) -> Either e (a, Event a) -> Either e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Event a) -> a
forall a b. (a, b) -> a
fst Either e (a, Event a)
mx'))
dSwitch ::
(Monad m)
=> Wire s e m a (b, Event (Wire s e m a b))
-> Wire s e m a b
dSwitch :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a (b, Event (Wire s e m a b)) -> Wire s e m a b
dSwitch Wire s e m a (b, Event (Wire s e m a b))
w' =
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx' -> do
(Either e (b, Event (Wire s e m a b))
mx, Wire s e m a (b, Event (Wire s e m a b))
w) <- Wire s e m a (b, Event (Wire s e m a b))
-> s
-> Either e a
-> m (Either e (b, Event (Wire s e m a b)),
Wire s e m a (b, Event (Wire s e m a b)))
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a (b, Event (Wire s e m a b))
w' s
ds Either e a
mx'
let nw :: Wire s e m a b
nw | Right (b
_, Event Wire s e m a b
w1) <- Either e (b, Event (Wire s e m a b))
mx = Wire s e m a b
w1
| Bool
otherwise = Wire s e m a (b, Event (Wire s e m a b)) -> Wire s e m a b
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a (b, Event (Wire s e m a b)) -> Wire s e m a b
dSwitch Wire s e m a (b, Event (Wire s e m a b))
w
(Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (((b, Event (Wire s e m a b)) -> b)
-> Either e (b, Event (Wire s e m a b)) -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, Event (Wire s e m a b)) -> b
forall a b. (a, b) -> a
fst Either e (b, Event (Wire s e m a b))
mx, Wire s e m a b
nw)
dkrSwitch ::
(Monad m)
=> Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
dkrSwitch :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
dkrSwitch Wire s e m a b
w' =
(s
-> Either e (a, Event (Wire s e m a b -> Wire s e m a b))
-> m (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (a, Event (Wire s e m a b -> Wire s e m a b))
-> m (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b)
-> (s
-> Either e (a, Event (Wire s e m a b -> Wire s e m a b))
-> m (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (a, Event (Wire s e m a b -> Wire s e m a b))
mx' ->
let nw :: Wire s e m a b -> Wire s e m a b
nw Wire s e m a b
w | Right (a
_, Event Wire s e m a b -> Wire s e m a b
f) <- Either e (a, Event (Wire s e m a b -> Wire s e m a b))
mx' = Wire s e m a b -> Wire s e m a b
f Wire s e m a b
w
| Bool
otherwise = Wire s e m a b
w
in ((Either e b, Wire s e m a b)
-> (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b))
-> m (Either e b, Wire s e m a b)
-> m (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b)
-> (Either e b, Wire s e m a b)
-> (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
dkrSwitch (Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b)
-> (Wire s e m a b -> Wire s e m a b)
-> Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wire s e m a b -> Wire s e m a b
nw)) (Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w' s
ds (((a, Event (Wire s e m a b -> Wire s e m a b)) -> a)
-> Either e (a, Event (Wire s e m a b -> Wire s e m a b))
-> Either e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Event (Wire s e m a b -> Wire s e m a b)) -> a
forall a b. (a, b) -> a
fst Either e (a, Event (Wire s e m a b -> Wire s e m a b))
mx'))
kSwitch ::
(Monad m, Monoid s)
=> Wire s e m a b
-> Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
-> Wire s e m a b
kSwitch :: forall (m :: * -> *) s e a b.
(Monad m, Monoid s) =>
Wire s e m a b
-> Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
-> Wire s e m a b
kSwitch Wire s e m a b
w1' Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
w2' =
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx' -> do
(Either e b
mx, Wire s e m a b
w1) <- Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w1' s
ds Either e a
mx'
(Either e (Event (Wire s e m a b -> Wire s e m a b))
mev, Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
w2) <- Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
-> s
-> Either e (a, b)
-> m (Either e (Event (Wire s e m a b -> Wire s e m a b)),
Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b)))
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
w2' s
ds ((a -> b -> (a, b)) -> Either e a -> Either e b -> Either e (a, b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Either e a
mx' Either e b
mx)
case Either e (Event (Wire s e m a b -> Wire s e m a b))
mev of
Right (Event Wire s e m a b -> Wire s e m a b
sw) -> Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire (Wire s e m a b -> Wire s e m a b
sw Wire s e m a b
w1) s
forall a. Monoid a => a
mempty Either e a
mx'
Either e (Event (Wire s e m a b -> Wire s e m a b))
_ -> (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b
mx, Wire s e m a b
-> Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
-> Wire s e m a b
forall (m :: * -> *) s e a b.
(Monad m, Monoid s) =>
Wire s e m a b
-> Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
-> Wire s e m a b
kSwitch Wire s e m a b
w1 Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b))
w2)
krSwitch ::
(Monad m)
=> Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
krSwitch :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
krSwitch Wire s e m a b
w'' =
(s
-> Either e (a, Event (Wire s e m a b -> Wire s e m a b))
-> m (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (a, Event (Wire s e m a b -> Wire s e m a b))
-> m (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b)
-> (s
-> Either e (a, Event (Wire s e m a b -> Wire s e m a b))
-> m (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (a, Event (Wire s e m a b -> Wire s e m a b))
mx' ->
let w' :: Wire s e m a b
w' | Right (a
_, Event Wire s e m a b -> Wire s e m a b
f) <- Either e (a, Event (Wire s e m a b -> Wire s e m a b))
mx' = Wire s e m a b -> Wire s e m a b
f Wire s e m a b
w''
| Bool
otherwise = Wire s e m a b
w''
in ((Either e b, Wire s e m a b)
-> (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b))
-> m (Either e b, Wire s e m a b)
-> m (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b)
-> (Either e b, Wire s e m a b)
-> (Either e b,
Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b
krSwitch) (Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w' s
ds (((a, Event (Wire s e m a b -> Wire s e m a b)) -> a)
-> Either e (a, Event (Wire s e m a b -> Wire s e m a b))
-> Either e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Event (Wire s e m a b -> Wire s e m a b)) -> a
forall a b. (a, b) -> a
fst Either e (a, Event (Wire s e m a b -> Wire s e m a b))
mx'))
modes ::
(Monad m, Ord k)
=> k
-> (k -> Wire s e m a b)
-> Wire s e m (a, Event k) b
modes :: forall (m :: * -> *) k s e a b.
(Monad m, Ord k) =>
k -> (k -> Wire s e m a b) -> Wire s e m (a, Event k) b
modes k
m0 k -> Wire s e m a b
select = Map k (Wire s e m a b)
-> k -> Wire s e m a b -> Wire s e m (a, Event k) b
loop Map k (Wire s e m a b)
forall k a. Map k a
M.empty k
m0 (k -> Wire s e m a b
select k
m0)
where
loop :: Map k (Wire s e m a b)
-> k -> Wire s e m a b -> Wire s e m (a, Event k) b
loop Map k (Wire s e m a b)
ms' k
m' Wire s e m a b
w'' =
(s
-> Either e (a, Event k)
-> m (Either e b, Wire s e m (a, Event k) b))
-> Wire s e m (a, Event k) b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (a, Event k)
-> m (Either e b, Wire s e m (a, Event k) b))
-> Wire s e m (a, Event k) b)
-> (s
-> Either e (a, Event k)
-> m (Either e b, Wire s e m (a, Event k) b))
-> Wire s e m (a, Event k) b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (a, Event k)
mxev' ->
case Either e (a, Event k)
mxev' of
Left e
_ -> do
(Either e b
mx, Wire s e m a b
w) <- Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w'' s
ds (((a, Event k) -> a) -> Either e (a, Event k) -> Either e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Event k) -> a
forall a b. (a, b) -> a
fst Either e (a, Event k)
mxev')
(Either e b, Wire s e m (a, Event k) b)
-> m (Either e b, Wire s e m (a, Event k) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b
mx, Map k (Wire s e m a b)
-> k -> Wire s e m a b -> Wire s e m (a, Event k) b
loop Map k (Wire s e m a b)
ms' k
m' Wire s e m a b
w)
Right (a
x', Event k
ev) -> do
let (Map k (Wire s e m a b)
ms, k
m, Wire s e m a b
w') = Map k (Wire s e m a b)
-> k
-> Wire s e m a b
-> Event k
-> (Map k (Wire s e m a b), k, Wire s e m a b)
switch Map k (Wire s e m a b)
ms' k
m' Wire s e m a b
w'' Event k
ev
(Either e b
mx, Wire s e m a b
w) <- Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w' s
ds (a -> Either e a
forall a b. b -> Either a b
Right a
x')
(Either e b, Wire s e m (a, Event k) b)
-> m (Either e b, Wire s e m (a, Event k) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b
mx, Map k (Wire s e m a b)
-> k -> Wire s e m a b -> Wire s e m (a, Event k) b
loop Map k (Wire s e m a b)
ms k
m Wire s e m a b
w)
switch :: Map k (Wire s e m a b)
-> k
-> Wire s e m a b
-> Event k
-> (Map k (Wire s e m a b), k, Wire s e m a b)
switch Map k (Wire s e m a b)
ms' k
m' Wire s e m a b
w' Event k
NoEvent = (Map k (Wire s e m a b)
ms', k
m', Wire s e m a b
w')
switch Map k (Wire s e m a b)
ms' k
m' Wire s e m a b
w' (Event k
m) =
let ms :: Map k (Wire s e m a b)
ms = k
-> Wire s e m a b
-> Map k (Wire s e m a b)
-> Map k (Wire s e m a b)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
m' Wire s e m a b
w' Map k (Wire s e m a b)
ms' in
case k -> Map k (Wire s e m a b) -> Maybe (Wire s e m a b)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
m Map k (Wire s e m a b)
ms of
Maybe (Wire s e m a b)
Nothing -> (Map k (Wire s e m a b)
ms, k
m, k -> Wire s e m a b
select k
m)
Just Wire s e m a b
w -> (k -> Map k (Wire s e m a b) -> Map k (Wire s e m a b)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
m Map k (Wire s e m a b)
ms, k
m, Wire s e m a b
w)
rSwitch ::
(Monad m)
=> Wire s e m a b
-> Wire s e m (a, Event (Wire s e m a b)) b
rSwitch :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b
rSwitch Wire s e m a b
w'' =
(s
-> Either e (a, Event (Wire s e m a b))
-> m (Either e b, Wire s e m (a, Event (Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b)) b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s
-> Either e (a, Event (Wire s e m a b))
-> m (Either e b, Wire s e m (a, Event (Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b)) b)
-> (s
-> Either e (a, Event (Wire s e m a b))
-> m (Either e b, Wire s e m (a, Event (Wire s e m a b)) b))
-> Wire s e m (a, Event (Wire s e m a b)) b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e (a, Event (Wire s e m a b))
mx' ->
let w' :: Wire s e m a b
w' | Right (a
_, Event Wire s e m a b
w1) <- Either e (a, Event (Wire s e m a b))
mx' = Wire s e m a b
w1
| Bool
otherwise = Wire s e m a b
w''
in ((Either e b, Wire s e m a b)
-> (Either e b, Wire s e m (a, Event (Wire s e m a b)) b))
-> m (Either e b, Wire s e m a b)
-> m (Either e b, Wire s e m (a, Event (Wire s e m a b)) b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b)
-> (Either e b, Wire s e m a b)
-> (Either e b, Wire s e m (a, Event (Wire s e m a b)) b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b
rSwitch) (Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w' s
ds (((a, Event (Wire s e m a b)) -> a)
-> Either e (a, Event (Wire s e m a b)) -> Either e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Event (Wire s e m a b)) -> a
forall a b. (a, b) -> a
fst Either e (a, Event (Wire s e m a b))
mx'))
switch ::
(Monad m, Monoid s)
=> Wire s e m a (b, Event (Wire s e m a b))
-> Wire s e m a b
switch :: forall (m :: * -> *) s e a b.
(Monad m, Monoid s) =>
Wire s e m a (b, Event (Wire s e m a b)) -> Wire s e m a b
switch Wire s e m a (b, Event (Wire s e m a b))
w' =
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall s e a (m :: * -> *) b.
(s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
WGen ((s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b)
-> (s -> Either e a -> m (Either e b, Wire s e m a b))
-> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds Either e a
mx' -> do
(Either e (b, Event (Wire s e m a b))
mx, Wire s e m a (b, Event (Wire s e m a b))
w) <- Wire s e m a (b, Event (Wire s e m a b))
-> s
-> Either e a
-> m (Either e (b, Event (Wire s e m a b)),
Wire s e m a (b, Event (Wire s e m a b)))
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a (b, Event (Wire s e m a b))
w' s
ds Either e a
mx'
case Either e (b, Event (Wire s e m a b))
mx of
Right (b
_, Event Wire s e m a b
w1) -> Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s e m a b
w1 s
forall a. Monoid a => a
mempty Either e a
mx'
Either e (b, Event (Wire s e m a b))
_ -> (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (((b, Event (Wire s e m a b)) -> b)
-> Either e (b, Event (Wire s e m a b)) -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, Event (Wire s e m a b)) -> b
forall a b. (a, b) -> a
fst Either e (b, Event (Wire s e m a b))
mx, Wire s e m a (b, Event (Wire s e m a b)) -> Wire s e m a b
forall (m :: * -> *) s e a b.
(Monad m, Monoid s) =>
Wire s e m a (b, Event (Wire s e m a b)) -> Wire s e m a b
switch Wire s e m a (b, Event (Wire s e m a b))
w)