-- |
-- Module:     Control.Wire.Switch
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>

module Control.Wire.Switch
    ( -- * Simple switching
      (-->),
      (>--),
      -- * Context switching
      modes,

      -- * Event-based switching
      -- ** Intrinsic
      switch,
      dSwitch,
      -- ** Intrinsic continuable
      kSwitch,
      dkSwitch,
      -- ** Extrinsic
      rSwitch,
      drSwitch,
      alternate,
      -- ** Extrinsic continuable
      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


-- | Acts like the first wire until it inhibits, then switches to the
-- second wire.  Infixr 1.
--
-- * Depends: like current wire.
--
-- * Inhibits: after switching like the second wire.
--
-- * Switch: now.

(-->) :: (Monad m) => Wire s e m a b -> Wire s e m a b -> Wire s e m a b
w1' :: 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
--> w2' :: 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
$ \ds :: s
ds mx' :: Either e a
mx' -> do
        (mx :: Either e b
mx, w1 :: 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 _ | Right _ <- 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
mx Either e b
-> m (Either e b, Wire s e m a b) -> m (Either e b, Wire s e m a b)
forall a b. a -> b -> 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 -->

-- | Acts like the first wire until the second starts producing, at which point
-- it switches to the second wire.  Infixr 1.
--
-- * Depends: like current wire.
--
-- * Inhibits: after switching like the second wire.
--
-- * Switch: now.

(>--) :: (Monad m) => Wire s e m a b -> Wire s e m a b -> Wire s e m a b
w1' :: 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
>-- w2' :: 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
$ \ds :: s
ds mx' :: Either e a
mx' -> do
        (m2 :: Either e b
m2, w2 :: 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 _ -> 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)
forall a b. a -> b -> 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)
          _       -> do (m1 :: Either e b
m1, w1 :: 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)
forall a b. a -> b -> 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 >--


-- | Intrinsic continuable switch:  Delayed version of 'kSwitch'.
--
-- * Inhibits: like the first argument wire, like the new wire after
--   switch.  Inhibition of the second argument wire is ignored.
--
-- * Switch: once, after now, restart state.

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 :: 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 w1' :: Wire s e m a b
w1' w2' :: 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
$ \ds :: s
ds mx' :: Either e a
mx' -> do
        (mx :: Either e b
mx,  w1 :: 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'
        (mev :: Either e (Event (Wire s e m a b -> Wire s e m a b))
mev, w2 :: 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 sw :: 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)


-- | Extrinsic switch:  Delayed version of 'rSwitch'.
--
-- * Inhibits: like the current wire.
--
-- * Switch: recurrent, after now, restart state.

drSwitch ::
    (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
drSwitch w' :: 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
$ \ds :: s
ds mx' :: 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 w :: Wire s e m a b
w | Right (_, Event 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'))


-- | Acts like the first wire until an event occurs then switches
-- to the second wire. Behaves like this wire until the event occurs
-- at which point a *new* instance of the first wire is switched to.
--
-- * Depends: like current wire.
--
-- * Inhibits: like the argument wires.
--
-- * Switch: once, now, restart state.

alternate ::
  (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 -> Wire s e m a b -> Wire s e m (a, Event x) b
alternate w1 :: Wire s e m a b
w1 w2 :: 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 w1' :: Wire s e m a b
w1' w2' :: Wire s e m a b
w2' w' :: 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
$ \ds :: s
ds mx' :: Either e (a, Event a)
mx' ->
            let (w1 :: Wire s e m a b
w1, w2 :: Wire s e m a b
w2, w :: Wire s e m a b
w) | Right (_, Event _) <- 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'))


-- | Intrinsic switch:  Delayed version of 'switch'.
--
-- * Inhibits: like argument wire until switch, then like the new wire.
--
-- * Switch: once, after now, restart state.

dSwitch ::
    (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)) -> Wire s e m a b
dSwitch w' :: 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
$ \ds :: s
ds mx' :: Either e a
mx' -> do
        (mx :: Either e (b, Event (Wire s e m a b))
mx, w :: 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 (_, Event w1 :: 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)


-- | Extrinsic continuable switch.  Delayed version of 'krSwitch'.
--
-- * Inhibits: like the current wire.
--
-- * Switch: recurrent, after now, restart state.

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 :: 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 w' :: 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
$ \ds :: s
ds mx' :: 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 w :: Wire s e m a b
w | Right (_, Event 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'))


-- | Intrinsic continuable switch:  @kSwitch w1 w2@ starts with @w1@.
-- Its signal is received by @w2@, which may choose to switch to a new
-- wire.  Passes the wire we are switching away from to the new wire,
-- such that it may be reused in it.
--
-- * Inhibits: like the first argument wire, like the new wire after
--   switch.  Inhibition of the second argument wire is ignored.
--
-- * Switch: once, now, restart state.

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 :: 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 w1' :: Wire s e m a b
w1' w2' :: 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
$ \ds :: s
ds mx' :: Either e a
mx' -> do
        (mx :: Either e b
mx,  w1 :: 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'
        (mev :: Either e (Event (Wire s e m a b -> Wire s e m a b))
mev, w2 :: 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 sw :: 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 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)


-- | Extrinsic continuable switch.  This switch works like 'rSwitch',
-- except that it passes the wire we are switching away from to the new
-- wire.
--
-- * Inhibits: like the current wire.
--
-- * Switch: recurrent, now, restart state.

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 :: 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 w'' :: 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
$ \ds :: s
ds mx' :: 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 (_, Event 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'))


-- | Route the left input signal based on the current mode.  The right
-- input signal can be used to change the current mode.  When switching
-- away from a mode and then switching back to it, it will be resumed.
-- Freezes time during inactivity.
--
-- * Complexity: O(n * log n) space, O(log n) lookup time on switch wrt
--   number of started, inactive modes.
--
-- * Depends: like currently active wire (left), now (right).
--
-- * Inhibits: when active wire inhibits.
--
-- * Switch: now on mode change.

modes ::
    (Monad m, Ord k)
    => k  -- ^ Initial mode.
    -> (k -> Wire s e m a b)  -- ^ Select wire for given mode.
    -> Wire s e m (a, Event k) b
modes :: k -> (k -> Wire s e m a b) -> Wire s e m (a, Event k) b
modes m0 :: k
m0 select :: 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 ms' :: Map k (Wire s e m a b)
ms' m' :: k
m' w'' :: 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
$ \ds :: s
ds mxev' :: Either e (a, Event k)
mxev' ->
            case Either e (a, Event k)
mxev' of
              Left _ -> do
                  (mx :: Either e b
mx, w :: 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 (x' :: a
x', ev :: Event k
ev) -> do
                  let (ms :: Map k (Wire s e m a b)
ms, m :: k
m, w' :: 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
                  (mx :: Either e b
mx, w :: 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 ms' :: Map k (Wire s e m a b)
ms' m' :: k
m' w' :: Wire s e m a b
w' NoEvent = (Map k (Wire s e m a b)
ms', k
m', Wire s e m a b
w')
    switch ms' :: Map k (Wire s e m a b)
ms' m' :: k
m' w' :: Wire s e m a b
w' (Event m :: 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
          Nothing -> (Map k (Wire s e m a b)
ms, k
m, k -> Wire s e m a b
select k
m)
          Just w :: 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)


-- | Extrinsic switch:  Start with the given wire.  Each time the input
-- event occurs, switch to the wire it carries.
--
-- * Inhibits: like the current wire.
--
-- * Switch: recurrent, now, restart state.

rSwitch ::
    (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 -> Wire s e m (a, Event (Wire s e m a b)) b
rSwitch w'' :: 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
$ \ds :: s
ds mx' :: Either e (a, Event (Wire s e m a b))
mx' ->
        let w' :: Wire s e m a b
w' | Right (_, Event 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'))


-- | Intrinsic switch:  Start with the given wire.  As soon as its event
-- occurs, switch to the wire in the event's value.
--
-- * Inhibits: like argument wire until switch, then like the new wire.
--
-- * Switch: once, now, restart state.

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 :: Wire s e m a (b, Event (Wire s e m a b)) -> Wire s e m a b
switch w' :: 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
$ \ds :: s
ds mx' :: Either e a
mx' -> do
        (mx :: Either e (b, Event (Wire s e m a b))
mx, w :: 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 (_, Event w1 :: 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, 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)