module FRP.NetWire.Switch
(
switch, dSwitch,
rSwitch, drSwitch,
parB,
rpSwitchB, drpSwitchB,
par,
rpSwitch, drpSwitch
)
where
import qualified Data.Traversable as T
import Control.Applicative
import Data.Traversable (Traversable)
import FRP.NetWire.Wire
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)
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)
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)
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)
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)
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)
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)
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)
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)
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'