-- |
-- Module: FRP.NetWire.Switch
-- Copyright: (c) 2011 Ertugrul Soeylemez
-- License: BSD3
-- Maintainer: Ertugrul Soeylemez
--
-- Switching combinators. Note that 'Wire' also provides a
-- state-preserving 'Control.Arrow.ArrowApply' instance, which may be
-- more convenient than these combinators in many cases.
module FRP.NetWire.Switch
( -- * Basic switches
switch, dSwitch,
rSwitch, drSwitch,
-- * Broadcasters
parB,
rpSwitchB, drpSwitchB,
-- * Routers
par,
rpSwitch, drpSwitch
)
where
import qualified Data.Traversable as T
import Control.Applicative
import Data.Traversable (Traversable)
import FRP.NetWire.Wire
-- | Decoupled variant of 'rpSwitch'.
drpSwitch ::
(Applicative m, Monad m, Traversable f) =>
(forall w. a -> f w -> f (b, w)) ->
f (Wire m b c) ->
Wire m (a, Event (f (Wire m b c) -> f (Wire m b c))) (f c)
drpSwitch route wires''' =
WGen $ \ws (x'', ev) -> do
let wires'' = route x'' wires'''
r <- T.sequenceA $ fmap (\(x', w') -> toGen w' ws x') wires''
let xs = T.sequenceA . fmap fst $ r
wires' = fmap snd r
wires = maybe id id ev wires'
return (xs, rpSwitch route wires)
-- | Decoupled variant of 'rpSwitchB'.
drpSwitchB ::
(Applicative m, Monad m, Traversable f) =>
f (Wire m a b) ->
Wire m (a, Event (f (Wire m a b) -> f (Wire m a b))) (f b)
drpSwitchB wires'' =
WGen $ \ws (x', ev) -> do
r <- T.sequenceA $ fmap (\w' -> toGen w' ws x') wires''
let xs = T.sequenceA . fmap fst $ r
wires' = fmap snd r
wires = maybe id id ev wires'
return (xs, rpSwitchB wires)
-- | Decoupled variant of 'rSwitch'.
drSwitch :: Monad m => Wire m a b -> Wire m (a, Event (Wire m a b)) b
drSwitch w1' =
WGen $ \ws (x', swEv) -> do
(mx, w1) <- toGen w1' ws x'
let w = maybe w1 id swEv
w `seq` return (mx, drSwitch w)
-- | Decoupled variant of 'switch'.
dSwitch :: Monad m => Wire m a (b, Event c) -> (c -> Wire m a b) -> Wire m a b
dSwitch w1' f =
WGen $ \ws x' -> do
(m, w1) <- toGen w1' ws x'
case m of
Left ex -> return (Left ex, dSwitch w1 f)
Right (x, swEv) ->
case swEv of
Nothing -> return (Right x, dSwitch w1 f)
Just sw -> return (Right x, f sw)
-- | Route signal to a collection of signal functions using the supplied
-- routing function. If any of the wires inhibits, the whole network
-- inhibits.
par ::
(Applicative m, Monad m, Traversable f) =>
(forall w. a -> f w -> f (b, w)) -> f (Wire m b c) -> Wire m a (f c)
par route wires'' =
WGen $ \ws x'' -> do
let wires' = route x'' wires''
r <- T.sequenceA $ fmap (\(x', w') -> toGen w' ws x') wires'
let xs = T.sequenceA . fmap fst $ r
wires = fmap snd r
return (xs, par route wires)
-- | Broadcast signal to a collection of signal functions. If any of
-- the wires inhibits, then the whole parallel network inhibits.
parB :: (Applicative m, Monad m, Traversable f) => f (Wire m a b) -> Wire m a (f b)
parB wires' =
WGen $ \ws x' -> do
r <- T.sequenceA $ fmap (\w' -> toGen w' ws x') wires'
let xs = T.sequenceA . fmap fst $ r
wires = fmap snd r
return (xs, parB wires)
-- | Recurrent parallel routing switch. This combinator acts like
-- 'par', but takes an additional event signal, which can transform the
-- set of wires. This is the most powerful switch.
--
-- Just like 'par' if any of the wires inhibits, the whole network
-- inhibits.
rpSwitch ::
(Applicative m, Monad m, Traversable f) =>
(forall w. a -> f w -> f (b, w)) ->
f (Wire m b c) ->
Wire m (a, Event (f (Wire m b c) -> f (Wire m b c))) (f c)
rpSwitch route wires''' =
WGen $ \ws (x'', ev) -> do
let wires'' = maybe id id ev wires'''
wires' = route x'' wires''
r <- T.sequenceA $ fmap (\(x', w') -> toGen w' ws x') wires'
let xs = T.sequenceA . fmap fst $ r
wires = fmap snd r
return (xs, rpSwitch route wires)
-- | Recurrent parallel broadcast switch. This combinator acts like
-- 'parB', but takes an additional event signal, which can transform the
-- set of wires.
--
-- Just like 'parB' if any of the wires inhibits, the whole network
-- inhibits.
rpSwitchB ::
(Applicative m, Monad m, Traversable f) =>
f (Wire m a b) -> Wire m (a, Event (f (Wire m a b) -> f (Wire m a b))) (f b)
rpSwitchB wires'' =
WGen $ \ws (x', ev) -> do
let wires' = maybe id id ev wires''
r <- T.sequenceA $ fmap (\w' -> toGen w' ws x') wires'
let xs = T.sequenceA . fmap fst $ r
wires = fmap snd r
return (xs, rpSwitchB wires)
-- | Combinator for recurrent switches. The wire produced by this
-- switch takes switching events and switches to the wires contained in
-- the events. The first argument is the initial wire.
rSwitch :: Monad m => Wire m a b -> Wire m (a, Event (Wire m a b)) b
rSwitch w1 =
WGen $ \ws (x', swEv) -> do
let w' = maybe w1 id swEv
(mx, w) <- toGen w' ws x'
return (mx, rSwitch w)
-- | This is the most basic switching combinator. It is an event-based
-- one-time switch.
--
-- The first argument is the initial wire, which may produce a switching
-- event at some point. When this event is produced, then the signal
-- path switches to the wire produced by the second argument function.
switch :: Monad m => Wire m a (b, Event c) -> (c -> Wire m a b) -> Wire m a b
switch w1' f =
WGen $ \ws x' -> do
(m, w1) <- toGen w1' ws x'
case m of
Left ex -> return (Left ex, switch w1 f)
Right (x, swEv) ->
case swEv of
Nothing -> return (Right x, switch w1 f)
Just sw -> toGen (f sw) (ws { wsDTime = 0 }) x'