-- |
-- Module:     FRP.NetWire.Switch
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- 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 Data.Traversable (Traversable)
import FRP.NetWire.Wire


-- | Decoupled variant of 'rpSwitch'.

drpSwitch ::
    Traversable f =>
    (forall w. a -> f w -> f (b, w)) ->
    f (Wire b c) ->
    Wire (a, Event (f (Wire b c) -> f (Wire 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 ::
    forall a b f. Traversable f =>
    f (Wire a b) ->
    Wire (a, Event (f (Wire a b) -> f (Wire 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 :: Wire a b -> Wire (a, Event (Wire 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 :: Wire a (b, Event c) -> (c -> Wire a b) -> Wire a b
dSwitch w1' f =
    WGen $ \ws x' -> do
        (m, w1) <- toGen w1' ws x'
        case m of
          Nothing        -> return (Nothing, dSwitch w1 f)
          Just (x, swEv) ->
              case swEv of
                Nothing -> return (Just x, dSwitch w1 f)
                Just sw -> return (Just 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 ::
    Traversable f =>
    (forall w. a -> f w -> f (b, w)) -> f (Wire b c) -> Wire 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 :: Traversable f => f (Wire a b) -> Wire 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 ::
    Traversable f =>
    (forall w. a -> f w -> f (b, w)) ->
    f (Wire b c) ->
    Wire (a, Event (f (Wire b c) -> f (Wire 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 ::
    Traversable f =>
    f (Wire a b) -> Wire (a, Event (f (Wire a b) -> f (Wire 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 :: Wire a b -> Wire (a, Event (Wire 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 :: Wire a (b, Event c) -> (c -> Wire a b) -> Wire a b
switch w1' f =
    WGen $ \ws x' -> do
        (m, w1) <- toGen w1' ws x'
        case m of
          Nothing        -> return (Nothing, switch w1 f)
          Just (x, swEv) ->
              case swEv of
                Nothing -> return (Just x, switch w1 f)
                Just sw -> toGen (f sw) (ws { wsDTime = 0 }) x'