{-# LANGUAGE Rank2Types #-}
-- |
-- Module      :  FRP.Yampa.Switches
-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  :  ivan.perez@keera.co.uk
-- Stability   :  provisional
-- Portability :  non-portable (GHC extensions)
--
-- Switches allow you to change the signal function being applied.
--
-- The basic idea of switching is fromed by combining a subordinate signal
-- function and a signal function continuation parameterised over some initial
-- data.
--
-- For example, the most basic switch has the following signature:
--
-- @switch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b@
--
-- which indicates that it has two parameters: a signal function
-- that produces an output and indicates, with an event, when it is time to
-- switch, and a signal function that starts with the residual data left by the
-- first SF in the event and continues onwards.
--
-- Switching occurs, at most, once. If you want something to switch repeatedly,
-- in general, you need to loop, or to switch onto the same signal function
-- again. However, some switches, explained below, are immediate (meaning that
-- the second SF is started at the time of switching). If you use the same SF
-- that originally provoked the switch, you are very likely to fall into an
-- infinite loop. In those cases, the use of 'dSwitch' or '-->' may help.
--
-- Switches vary depending on a number of criterions:
--
-- - /Decoupled/ vs normal switching /(d)/: when an SF is being applied and a
-- different SF needs to be applied next, one question is which one is used
-- for the time in which the switching takes place. In decoupled switching, the
-- old SF is used for the time of switching, and the one SF is only used after
-- that. In normal or instantaneous or coupled switching, the old SF is
-- discarded immediately and a new SF is used for the output already from that
-- point in time.
--
-- - How the switching event is provided /( \/r\/k)/: normally, an 'Event' is
-- used to indicate that a switching must take place. This event can be part of
-- the argument SF (e.g., 'switch'), it can be part of the input (e.g.,
-- 'rSwitch'), or it can be determined by a second argument SF (e.g,
-- 'kSwitch').
--
-- - How many SFs are being handled /( \/p\/par)/: some combinators deal with
-- only one SF, others handle collections, either in the form of a
--'Functor' or a list ('[]').
--
-- - How the input is router /(B\/Z\/ )/: when multiple SFs are being combined,
-- a decision needs to be made about how the input is passed to the internal
-- SFs.  In some cases, broadcasting is used to pass the same input to all
-- internal SFs. In others, the input is itself a collection, and each element
-- is passed to one internal SF (i.e., /zipping/). In others, an auxiliary
-- function is used to decide how to route specific inputs to specific SFs in
-- the collection.
--
-- These gives a number of different combinations, some of which make no sense,
-- and also helps determine the expected behaviour of a combinator by looking
-- at its name. For example, 'drpSwitchB' is the decoupled (/d/), recurrent
-- (/r/), parallel (/p/) switch with broadcasting (/B/).
module FRP.Yampa.Switches
    (
      -- * Basic switching
      switch,  dSwitch
    , rSwitch, drSwitch
    , kSwitch, dkSwitch

      -- * Parallel composition\/switching (collections)
      -- ** With broadcasting
    , parB
    , pSwitchB,dpSwitchB
    , rpSwitchB,drpSwitchB

      -- ** With helper routing function
    , par
    , pSwitch, dpSwitch
    , rpSwitch,drpSwitch

      -- * Parallel composition\/switching (lists)
      --
      -- ** With "zip" routing
    , parZ
    , pSwitchZ
    , dpSwitchZ
    , rpSwitchZ
    , drpSwitchZ

      -- ** With replication
    , parC
    )
  where

import Control.Arrow

import FRP.Yampa.Basic
import FRP.Yampa.Diagnostics
import FRP.Yampa.Event
import FRP.Yampa.InternalCore (DTime, FunDesc (..), SF (..), SF' (..), fdFun,
                               sfArrG, sfConst, sfTF')

-- * Basic switches

-- | Basic switch.
--
-- By default, the first signal function is applied. Whenever the second value
-- in the pair actually is an event, the value carried by the event is used to
-- obtain a new signal function to be applied *at that time and at future
-- times*. Until that happens, the first value in the pair is produced in the
-- output signal.
--
-- Important note: at the time of switching, the second signal function is
-- applied immediately. If that second SF can also switch at time zero, then a
-- double (nested) switch might take place. If the second SF refers to the
-- first one, the switch might take place infinitely many times and never be
-- resolved.
--
-- Remember: The continuation is evaluated strictly at the time
-- of switching!
switch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a (b, Event c)
tf10}) c -> SF a b
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
  where
    tf0 :: a -> Transition a b
tf0 a
a0 =
      case a -> Transition a (b, Event c)
tf10 a
a0 of
        (SF' a (b, Event c)
sf1, (b
b0, Event c
NoEvent))  -> (SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
forall a b c. SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
switchAux SF' a (b, Event c)
sf1 c -> SF a b
k, b
b0)
        (SF' a (b, Event c)
_,   (b
_,  Event c
c0)) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c0) a
a0

    -- It would be nice to optimize further here. E.g. if it would be
    -- possible to observe the event source only.
    switchAux :: SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
    switchAux :: SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
switchAux (SFArr DTime -> a -> Transition a (b, Event c)
_ (FDC (b
b, Event c
NoEvent))) c -> SF a b
_ = b -> SF' a b
forall b a. b -> SF' a b
sfConst b
b
    switchAux (SFArr DTime -> a -> Transition a (b, Event c)
_ FunDesc a (b, Event c)
fd1)                c -> SF a b
k = (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
forall a b c. (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
switchAuxA1 (FunDesc a (b, Event c) -> a -> (b, Event c)
forall a b. FunDesc a b -> a -> b
fdFun FunDesc a (b, Event c)
fd1) c -> SF a b
k
    switchAux SF' a (b, Event c)
sf1                          c -> SF a b
k = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
      where
        tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
          case (SF' a (b, Event c) -> DTime -> a -> Transition a (b, Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a (b, Event c)
sf1) DTime
dt a
a of
            (SF' a (b, Event c)
sf1', (b
b, Event c
NoEvent)) -> (SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
forall a b c. SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
switchAux SF' a (b, Event c)
sf1' c -> SF a b
k, b
b)
            (SF' a (b, Event c)
_,    (b
_, Event c
c)) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c) a
a

    -- Note: While switch behaves as a stateless arrow at this point, that
    -- could change after a switch. Hence, SF' overall.
    switchAuxA1 :: (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
    switchAuxA1 :: (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
switchAuxA1 a -> (b, Event c)
f1 c -> SF a b
k = SF' a b
sf
      where
        sf :: SF' a b
sf     = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf -- False
        tf :: DTime -> a -> Transition a b
tf DTime
_ a
a =
          case a -> (b, Event c)
f1 a
a of
            (b
b, Event c
NoEvent) -> (SF' a b
sf, b
b)
            (b
_, Event c
c) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c) a
a

-- | Switch with delayed observation.
--
-- By default, the first signal function is applied.
--
-- Whenever the second value in the pair actually is an event,
-- the value carried by the event is used to obtain a new signal
-- function to be applied *at future times*.
--
-- Until that happens, the first value in the pair is produced
-- in the output signal.
--
-- Important note: at the time of switching, the second
-- signal function is used immediately, but the current
-- input is fed by it (even though the actual output signal
-- value at time 0 is discarded).
--
-- If that second SF can also switch at time zero, then a
-- double (nested) -- switch might take place. If the second SF refers to the
-- first one, the switch might take place infinitely many times and never be
-- resolved.
--
-- Remember: The continuation is evaluated strictly at the time
-- of switching!
dSwitch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a (b, Event c)
tf10}) c -> SF a b
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
  where
    tf0 :: a -> Transition a b
tf0 a
a0 =
      let (SF' a (b, Event c)
sf1, (b
b0, Event c
ec0)) = a -> Transition a (b, Event c)
tf10 a
a0
      in ( case Event c
ec0 of
             Event c
NoEvent  -> SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
forall a b c. SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
dSwitchAux SF' a (b, Event c)
sf1 c -> SF a b
k
             Event c
c0 -> Transition a b -> SF' a b
forall a b. (a, b) -> a
fst (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c0) a
a0)
         , b
b0
         )

    -- It would be nice to optimize further here. E.g. if it would be
    -- possible to observe the event source only.
    dSwitchAux :: SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
    dSwitchAux :: SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
dSwitchAux (SFArr DTime -> a -> Transition a (b, Event c)
_ (FDC (b
b, Event c
NoEvent))) c -> SF a b
_ = b -> SF' a b
forall b a. b -> SF' a b
sfConst b
b
    dSwitchAux (SFArr DTime -> a -> Transition a (b, Event c)
_ FunDesc a (b, Event c)
fd1)                c -> SF a b
k = (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
forall a b c. (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
dSwitchAuxA1 (FunDesc a (b, Event c) -> a -> (b, Event c)
forall a b. FunDesc a b -> a -> b
fdFun FunDesc a (b, Event c)
fd1) c -> SF a b
k
    dSwitchAux SF' a (b, Event c)
sf1                          c -> SF a b
k = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
      where
        tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
          let (SF' a (b, Event c)
sf1', (b
b, Event c
ec)) = (SF' a (b, Event c) -> DTime -> a -> Transition a (b, Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a (b, Event c)
sf1) DTime
dt a
a
          in ( case Event c
ec of
                 Event c
NoEvent -> SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
forall a b c. SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
dSwitchAux SF' a (b, Event c)
sf1' c -> SF a b
k
                 Event c
c -> Transition a b -> SF' a b
forall a b. (a, b) -> a
fst (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c) a
a)
             , b
b
             )

    -- Note: While dSwitch behaves as a stateless arrow at this point, that
    -- could change after a switch. Hence, SF' overall.
    dSwitchAuxA1 :: (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
    dSwitchAuxA1 :: (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
dSwitchAuxA1 a -> (b, Event c)
f1 c -> SF a b
k = SF' a b
sf
      where
        sf :: SF' a b
sf = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf -- False
        tf :: DTime -> a -> Transition a b
tf DTime
_ a
a =
          let (b
b, Event c
ec) = a -> (b, Event c)
f1 a
a
          in ( case Event c
ec of
                 Event c
NoEvent -> SF' a b
sf
                 Event c
c -> Transition a b -> SF' a b
forall a b. (a, b) -> a
fst (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c) a
a)
             , b
b
             )

-- | Recurring switch.
--
-- Uses the given SF until an event comes in the input, in which case the SF in
-- the event is turned on, until the next event comes in the input, and so on.
--
-- See <https://wiki.haskell.org/Yampa#Switches> for more
-- information on how this switch works.
rSwitch :: SF a b -> SF (a, Event (SF a b)) b
rSwitch :: SF a b -> SF (a, Event (SF a b)) b
rSwitch SF a b
sf = SF (a, Event (SF a b)) (b, Event (SF a b))
-> (SF a b -> SF (a, Event (SF a b)) b) -> SF (a, Event (SF a b)) b
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (SF a b -> SF (a, Event (SF a b)) (b, Event (SF a b))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first SF a b
sf) (((a, Event (SF a b)) -> (a, Event (SF a b))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (SF a b)) -> (a, Event (SF a b)))
-> SF (a, Event (SF a b)) b -> SF (a, Event (SF a b)) b
forall a b. (a -> a) -> SF a b -> SF a b
>=-) (SF (a, Event (SF a b)) b -> SF (a, Event (SF a b)) b)
-> (SF a b -> SF (a, Event (SF a b)) b)
-> SF a b
-> SF (a, Event (SF a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SF a b -> SF (a, Event (SF a b)) b
forall a b. SF a b -> SF (a, Event (SF a b)) b
rSwitch)

-- | Recurring switch with delayed observation.
--
-- Uses the given SF until an event comes in the input, in which case the SF in
-- the event is turned on, until the next event comes in the input, and so on.
--
-- Uses decoupled switch ('dSwitch').
--
-- See <https://wiki.haskell.org/Yampa#Switches> for more
-- information on how this switch works.
drSwitch :: SF a b -> SF (a, Event (SF a b)) b
drSwitch :: SF a b -> SF (a, Event (SF a b)) b
drSwitch SF a b
sf = SF (a, Event (SF a b)) (b, Event (SF a b))
-> (SF a b -> SF (a, Event (SF a b)) b) -> SF (a, Event (SF a b)) b
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch (SF a b -> SF (a, Event (SF a b)) (b, Event (SF a b))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first SF a b
sf) (((a, Event (SF a b)) -> (a, Event (SF a b))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (SF a b)) -> (a, Event (SF a b)))
-> SF (a, Event (SF a b)) b -> SF (a, Event (SF a b)) b
forall a b. (a -> a) -> SF a b -> SF a b
>=-) (SF (a, Event (SF a b)) b -> SF (a, Event (SF a b)) b)
-> (SF a b -> SF (a, Event (SF a b)) b)
-> SF a b
-> SF (a, Event (SF a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SF a b -> SF (a, Event (SF a b)) b
forall a b. SF a b -> SF (a, Event (SF a b)) b
drSwitch)

-- | Call-with-current-continuation switch.
--
-- Applies the first SF until the input signal and the output signal, when
-- passed to the second SF, produce an event, in which case the original SF and
-- the event are used to build an new SF to switch into.
--
-- See <https://wiki.haskell.org/Yampa#Switches> for more
-- information on how this switch works.
kSwitch :: SF a b -> SF (a,b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b
kSwitch :: SF a b -> SF (a, b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b
kSwitch sf10 :: SF a b
sf10@(SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf10}) (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = (a, b) -> Transition (a, b) (Event c)
tfe0}) SF a b -> c -> SF a b
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
  where
    tf0 :: a -> Transition a b
tf0 a
a0 =
      let (SF' a b
sf1, b
b0) = a -> Transition a b
tf10 a
a0
      in case (a, b) -> Transition (a, b) (Event c)
tfe0 (a
a0, b
b0) of
           (SF' (a, b) (Event c)
sfe, Event c
NoEvent)  -> (SF' a b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAux SF' a b
sf1 SF' (a, b) (Event c)
sfe, b
b0)
           (SF' (a, b) (Event c)
_,   Event c
c0) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k SF a b
sf10 c
c0) a
a0

    kSwitchAux :: SF' a b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAux (SFArr DTime -> a -> Transition a b
_ (FDC b
b)) SF' (a, b) (Event c)
sfe = b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxC1 b
b SF' (a, b) (Event c)
sfe
    kSwitchAux (SFArr DTime -> a -> Transition a b
_ FunDesc a b
fd1)     SF' (a, b) (Event c)
sfe = (a -> b) -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxA1 (FunDesc a b -> a -> b
forall a b. FunDesc a b -> a -> b
fdFun FunDesc a b
fd1) SF' (a, b) (Event c)
sfe
    kSwitchAux SF' a b
sf1 (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ (FDC Event c
NoEvent)) = SF' a b
sf1
    kSwitchAux SF' a b
sf1 (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ FunDesc (a, b) (Event c)
fde) = SF' a b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxAE SF' a b
sf1 (FunDesc (a, b) (Event c) -> (a, b) -> Event c
forall a b. FunDesc a b -> a -> b
fdFun FunDesc (a, b) (Event c)
fde)
    kSwitchAux SF' a b
sf1            SF' (a, b) (Event c)
sfe                 = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf -- False
      where
        tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
          let (SF' a b
sf1', b
b) = (SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf1) DTime
dt a
a
          in case (SF' (a, b) (Event c)
-> DTime -> (a, b) -> Transition (a, b) (Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, b) (Event c)
sfe) DTime
dt (a
a, b
b) of
               (SF' (a, b) (Event c)
sfe', Event c
NoEvent) -> (SF' a b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAux SF' a b
sf1' SF' (a, b) (Event c)
sfe', b
b)
               (SF' (a, b) (Event c)
_,    Event c
c) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k (SF' a b -> DTime -> SF a b
forall a b. SF' a b -> DTime -> SF a b
freeze SF' a b
sf1 DTime
dt) c
c) a
a

    -- !!! Untested optimization!
    kSwitchAuxC1 :: b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxC1 b
b (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ (FDC Event c
NoEvent)) = b -> SF' a b
forall b a. b -> SF' a b
sfConst b
b
    kSwitchAuxC1 b
b (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ FunDesc (a, b) (Event c)
fde)        = b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxC1AE b
b (FunDesc (a, b) (Event c) -> (a, b) -> Event c
forall a b. FunDesc a b -> a -> b
fdFun FunDesc (a, b) (Event c)
fde)
    kSwitchAuxC1 b
b SF' (a, b) (Event c)
sfe                 = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf -- False
      where
        tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
          case (SF' (a, b) (Event c)
-> DTime -> (a, b) -> Transition (a, b) (Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, b) (Event c)
sfe) DTime
dt (a
a, b
b) of
            (SF' (a, b) (Event c)
sfe', Event c
NoEvent) -> (b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxC1 b
b SF' (a, b) (Event c)
sfe', b
b)
            (SF' (a, b) (Event c)
_,    Event c
c) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k (b -> SF a b
forall b a. b -> SF a b
constant b
b) c
c) a
a

    -- !!! Untested optimization!
    kSwitchAuxA1 :: (a -> b) -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxA1 a -> b
f1 (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ (FDC Event c
NoEvent)) = (a -> b) -> SF' a b
forall a b. (a -> b) -> SF' a b
sfArrG a -> b
f1
    kSwitchAuxA1 a -> b
f1 (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ FunDesc (a, b) (Event c)
fde)        = (a -> b) -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxA1AE a -> b
f1 (FunDesc (a, b) (Event c) -> (a, b) -> Event c
forall a b. FunDesc a b -> a -> b
fdFun FunDesc (a, b) (Event c)
fde)
    kSwitchAuxA1 a -> b
f1 SF' (a, b) (Event c)
sfe                 = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf -- False
      where
        tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
          let b :: b
b = a -> b
f1 a
a
          in case (SF' (a, b) (Event c)
-> DTime -> (a, b) -> Transition (a, b) (Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, b) (Event c)
sfe) DTime
dt (a
a, b
b) of
               (SF' (a, b) (Event c)
sfe', Event c
NoEvent) -> ((a -> b) -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxA1 a -> b
f1 SF' (a, b) (Event c)
sfe', b
b)
               (SF' (a, b) (Event c)
_,    Event c
c) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k ((a -> b) -> SF a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f1) c
c) a
a

    -- !!! Untested optimization!
    kSwitchAuxAE :: SF' a b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxAE (SFArr DTime -> a -> Transition a b
_ (FDC b
b))  (a, b) -> Event c
fe = b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxC1AE b
b (a, b) -> Event c
fe
    kSwitchAuxAE (SFArr DTime -> a -> Transition a b
_ FunDesc a b
fd1)   (a, b) -> Event c
fe = (a -> b) -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxA1AE (FunDesc a b -> a -> b
forall a b. FunDesc a b -> a -> b
fdFun FunDesc a b
fd1) (a, b) -> Event c
fe
    kSwitchAuxAE SF' a b
sf1            (a, b) -> Event c
fe = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf -- False
      where
        tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
          let (SF' a b
sf1', b
b) = (SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf1) DTime
dt a
a
          in case (a, b) -> Event c
fe (a
a, b
b) of
               Event c
NoEvent -> (SF' a b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxAE SF' a b
sf1' (a, b) -> Event c
fe, b
b)
               Event c
c -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k (SF' a b -> DTime -> SF a b
forall a b. SF' a b -> DTime -> SF a b
freeze SF' a b
sf1 DTime
dt) c
c) a
a

    -- !!! Untested optimization!
    kSwitchAuxC1AE :: b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxC1AE b
b (a, b) -> Event c
fe = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
forall p. p -> a -> Transition a b
tf -- False
      where
        tf :: p -> a -> Transition a b
tf p
_ a
a =
          case (a, b) -> Event c
fe (a
a, b
b) of
            Event c
NoEvent -> (b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxC1AE b
b (a, b) -> Event c
fe, b
b)
            Event c
c -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k (b -> SF a b
forall b a. b -> SF a b
constant b
b) c
c) a
a

    -- !!! Untested optimization!
    kSwitchAuxA1AE :: (a -> b) -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxA1AE a -> b
f1 (a, b) -> Event c
fe = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
forall p. p -> a -> Transition a b
tf -- False
      where
        tf :: p -> a -> Transition a b
tf p
_ a
a =
          let b :: b
b = a -> b
f1 a
a
          in case (a, b) -> Event c
fe (a
a, b
b) of
               Event c
NoEvent -> ((a -> b) -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxA1AE a -> b
f1 (a, b) -> Event c
fe, b
b)
               Event c
c -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k ((a -> b) -> SF a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f1) c
c) a
a

-- | 'kSwitch' with delayed observation.
--
-- Applies the first SF until the input signal and the output signal, when
-- passed to the second SF, produce an event, in which case the original SF and
-- the event are used to build an new SF to switch into.
--
-- The switch is decoupled ('dSwitch').
--
-- See <https://wiki.haskell.org/Yampa#Switches> for more
-- information on how this switch works.
dkSwitch :: SF a b -> SF (a,b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b
dkSwitch :: SF a b -> SF (a, b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b
dkSwitch sf10 :: SF a b
sf10@(SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf10}) (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = (a, b) -> Transition (a, b) (Event c)
tfe0}) SF a b -> c -> SF a b
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
  where
    tf0 :: a -> Transition a b
tf0 a
a0 =
      let (SF' a b
sf1, b
b0) = a -> Transition a b
tf10 a
a0
      in ( case (a, b) -> Transition (a, b) (Event c)
tfe0 (a
a0, b
b0) of
             (SF' (a, b) (Event c)
sfe, Event c
NoEvent)  -> SF' a b -> SF' (a, b) (Event c) -> SF' a b
dkSwitchAux SF' a b
sf1 SF' (a, b) (Event c)
sfe
             (SF' (a, b) (Event c)
_,   Event c
c0) -> Transition a b -> SF' a b
forall a b. (a, b) -> a
fst (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k SF a b
sf10 c
c0) a
a0)
         , b
b0
         )

    dkSwitchAux :: SF' a b -> SF' (a, b) (Event c) -> SF' a b
dkSwitchAux SF' a b
sf1 (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ (FDC Event c
NoEvent)) = SF' a b
sf1
    dkSwitchAux SF' a b
sf1 SF' (a, b) (Event c)
sfe                     = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf -- False
      where
        tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
          let (SF' a b
sf1', b
b) = (SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf1) DTime
dt a
a
          in ( case (SF' (a, b) (Event c)
-> DTime -> (a, b) -> Transition (a, b) (Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, b) (Event c)
sfe) DTime
dt (a
a, b
b) of
                 (SF' (a, b) (Event c)
sfe', Event c
NoEvent) -> SF' a b -> SF' (a, b) (Event c) -> SF' a b
dkSwitchAux SF' a b
sf1' SF' (a, b) (Event c)
sfe'
                 (SF' (a, b) (Event c)
_, Event c
c) -> Transition a b -> SF' a b
forall a b. (a, b) -> a
fst (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k (SF' a b -> DTime -> SF a b
forall a b. SF' a b -> DTime -> SF a b
freeze SF' a b
sf1 DTime
dt) c
c) a
a)
             , b
b
             )

-- * Parallel composition and switching over collections with broadcasting

-- | Tuple a value up with every element of a collection of signal
-- functions.
broadcast :: Functor col => a -> col sf -> col (a, sf)
broadcast :: a -> col sf -> col (a, sf)
broadcast a
a = (sf -> (a, sf)) -> col sf -> col (a, sf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\sf
sf -> (a
a, sf
sf))

-- | Spatial parallel composition of a signal function collection.
-- Given a collection of signal functions, it returns a signal
-- function that broadcasts its input signal to every element
-- of the collection, to return a signal carrying a collection
-- of outputs. See 'par'.
--
-- For more information on how parallel composition works, check
-- <http://haskell.cs.yale.edu/wp-content/uploads/2011/01/yampa-arcade.pdf>
parB :: Functor col => col (SF a b) -> SF a (col b)
parB :: col (SF a b) -> SF a (col b)
parB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF a b) -> SF a (col b)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c) -> SF a (col c)
par forall sf. a -> col sf -> col (a, sf)
forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast

-- | Parallel switch (dynamic collection of signal functions spatially composed
-- in parallel) with broadcasting. See 'pSwitch'.
--
-- For more information on how parallel composition works, check
-- <http://haskell.cs.yale.edu/wp-content/uploads/2011/01/yampa-arcade.pdf>
pSwitchB :: Functor col =>
    col (SF a b) -> SF (a,col b) (Event c) -> (col (SF a b)->c-> SF a (col b))
    -> SF a (col b)
pSwitchB :: col (SF a b)
-> SF (a, col b) (Event c)
-> (col (SF a b) -> c -> SF a (col b))
-> SF a (col b)
pSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF a b)
-> SF (a, col b) (Event c)
-> (col (SF a b) -> c -> SF a (col b))
-> SF a (col b)
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
pSwitch forall sf. a -> col sf -> col (a, sf)
forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast

-- | Decoupled parallel switch with broadcasting (dynamic collection of
--   signal functions spatially composed in parallel). See 'dpSwitch'.
--
-- For more information on how parallel composition works, check
-- <http://haskell.cs.yale.edu/wp-content/uploads/2011/01/yampa-arcade.pdf>
dpSwitchB :: Functor col =>
    col (SF a b) -> SF (a,col b) (Event c) -> (col (SF a b)->c->SF a (col b))
    -> SF a (col b)
dpSwitchB :: col (SF a b)
-> SF (a, col b) (Event c)
-> (col (SF a b) -> c -> SF a (col b))
-> SF a (col b)
dpSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF a b)
-> SF (a, col b) (Event c)
-> (col (SF a b) -> c -> SF a (col b))
-> SF a (col b)
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
dpSwitch forall sf. a -> col sf -> col (a, sf)
forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast

-- | Recurring parallel switch with broadcasting.
--
-- Uses the given collection of SFs, until an event comes in the input, in
-- which case the function in the 'Event' is used to transform the collections
-- of SF to be used with 'rpSwitch' again, until the next event comes in the
-- input, and so on.
--
-- Broadcasting is used to decide which subpart of the input goes to each SF in
-- the collection.
--
-- See 'rpSwitch'.
--
-- For more information on how parallel composition works, check
-- <http://haskell.cs.yale.edu/wp-content/uploads/2011/01/yampa-arcade.pdf>
rpSwitchB :: Functor col =>
    col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
rpSwitchB :: col (SF a b)
-> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
rpSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF a b)
-> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
rpSwitch forall sf. a -> col sf -> col (a, sf)
forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast

-- | Decoupled recurring parallel switch with broadcasting.
--
-- Uses the given collection of SFs, until an event comes in the input, in
-- which case the function in the 'Event' is used to transform the collections
-- of SF to be used with 'rpSwitch' again, until the next event comes in the
-- input, and so on.
--
-- Broadcasting is used to decide which subpart of the input goes to each SF in
-- the collection.
--
-- This is the decoupled version of 'rpSwitchB'.
--
-- For more information on how parallel composition works, check
-- <http://haskell.cs.yale.edu/wp-content/uploads/2011/01/yampa-arcade.pdf>
drpSwitchB :: Functor col =>
    col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
drpSwitchB :: col (SF a b)
-> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
drpSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF a b)
-> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
drpSwitch forall sf. a -> col sf -> col (a, sf)
forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast

-- * Parallel composition and switching over collections with general routing

-- | Spatial parallel composition of a signal function collection parameterized
-- on the routing function.
--
par :: Functor col
    => (forall sf . (a -> col sf -> col (b, sf)))
         -- ^ Determines the input to each signal function
         --     in the collection. IMPORTANT! The routing function MUST
         --     preserve the structure of the signal function collection.
    -> col (SF b c)
         -- ^ Signal function collection.
    -> SF a (col c)
par :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c) -> SF a (col c)
par forall sf. a -> col sf -> col (b, sf)
rf col (SF b c)
sfs0 = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a (col c)
sfTF = a -> Transition a (col c)
tf0}
  where
    tf0 :: a -> Transition a (col c)
tf0 a
a0 =
      let bsfs0 :: col (b, SF b c)
bsfs0 = a -> col (SF b c) -> col (b, SF b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a0 col (SF b c)
sfs0
          sfcs0 :: col (Transition b c)
sfcs0 = ((b, SF b c) -> Transition b c)
-> col (b, SF b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b0, SF b c
sf0) -> (SF b c -> b -> Transition b c
forall a b. SF a b -> a -> Transition a b
sfTF SF b c
sf0) b
b0) col (b, SF b c)
bsfs0
          sfs :: col (SF' b c)
sfs   = (Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs0
          cs0 :: col c
cs0   = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs0
      in ((forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
parAux forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs, col c
cs0)

-- Internal definition. Also used in parallel switchers.
parAux :: Functor col =>
    (forall sf . (a -> col sf -> col (b, sf)))
    -> col (SF' b c)
    -> SF' a (col c)
parAux :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
parAux forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs = (DTime -> a -> Transition a (col c)) -> SF' a (col c)
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a (col c)
tf -- True
  where
    tf :: DTime -> a -> Transition a (col c)
tf DTime
dt a
a =
      let bsfs :: col (b, SF' b c)
bsfs  = a -> col (SF' b c) -> col (b, SF' b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a col (SF' b c)
sfs
          sfcs' :: col (Transition b c)
sfcs' = ((b, SF' b c) -> Transition b c)
-> col (b, SF' b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, SF' b c
sf) -> (SF' b c -> DTime -> b -> Transition b c
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' b c
sf) DTime
dt b
b) col (b, SF' b c)
bsfs
          sfs' :: col (SF' b c)
sfs'  = (Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs'
          cs :: col c
cs    = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs'
      in ((forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
parAux forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs', col c
cs)

-- | Parallel switch parameterized on the routing function. This is the most
-- general switch from which all other (non-delayed) switches in principle
-- can be derived. The signal function collection is spatially composed in
-- parallel and run until the event signal function has an occurrence. Once
-- the switching event occurs, all signal function are "frozen" and their
-- continuations are passed to the continuation function, along with the
-- event value.
pSwitch :: Functor col
        => (forall sf . (a -> col sf -> col (b, sf)))
              -- ^ Routing function: determines the input to each signal
              -- function in the collection. IMPORTANT! The routing function
              -- has an obligation to preserve the structure of the signal
              -- function collection.
        -> col (SF b c)
              -- ^ Signal function collection.
        -> SF (a, col c) (Event d)
              -- ^ Signal function generating the switching event.
        -> (col (SF b c) -> d -> SF a (col c))
              -- ^ Continuation to be invoked once event occurs.
        -> SF a (col c)
pSwitch :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
pSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF b c)
sfs0 SF (a, col c) (Event d)
sfe0 col (SF b c) -> d -> SF a (col c)
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a (col c)
sfTF = a -> Transition a (col c)
tf0}
  where
    tf0 :: a -> Transition a (col c)
tf0 a
a0 =
      let bsfs0 :: col (b, SF b c)
bsfs0 = a -> col (SF b c) -> col (b, SF b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a0 col (SF b c)
sfs0
          sfcs0 :: col (Transition b c)
sfcs0 = ((b, SF b c) -> Transition b c)
-> col (b, SF b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b0, SF b c
sf0) -> (SF b c -> b -> Transition b c
forall a b. SF a b -> a -> Transition a b
sfTF SF b c
sf0) b
b0) col (b, SF b c)
bsfs0
          sfs :: col (SF' b c)
sfs   = (Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs0
          cs0 :: col c
cs0   = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs0
      in case (SF (a, col c) (Event d)
-> (a, col c) -> Transition (a, col c) (Event d)
forall a b. SF a b -> a -> Transition a b
sfTF SF (a, col c) (Event d)
sfe0) (a
a0, col c
cs0) of
           (SF' (a, col c) (Event d)
sfe, Event d
NoEvent)  -> (col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
pSwitchAux col (SF' b c)
sfs SF' (a, col c) (Event d)
sfe, col c
cs0)
           (SF' (a, col c) (Event d)
_,   Event d
d0) -> SF a (col c) -> a -> Transition a (col c)
forall a b. SF a b -> a -> Transition a b
sfTF (col (SF b c) -> d -> SF a (col c)
k col (SF b c)
sfs0 d
d0) a
a0

    pSwitchAux :: col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
pSwitchAux col (SF' b c)
sfs (SFArr DTime -> (a, col c) -> Transition (a, col c) (Event d)
_ (FDC Event d
NoEvent)) = (forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
parAux forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs
    pSwitchAux col (SF' b c)
sfs SF' (a, col c) (Event d)
sfe = (DTime -> a -> Transition a (col c)) -> SF' a (col c)
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a (col c)
tf -- False
      where
        tf :: DTime -> a -> Transition a (col c)
tf DTime
dt a
a =
          let bsfs :: col (b, SF' b c)
bsfs  = a -> col (SF' b c) -> col (b, SF' b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a col (SF' b c)
sfs
              sfcs' :: col (Transition b c)
sfcs' = ((b, SF' b c) -> Transition b c)
-> col (b, SF' b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, SF' b c
sf) -> (SF' b c -> DTime -> b -> Transition b c
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' b c
sf) DTime
dt b
b) col (b, SF' b c)
bsfs
              sfs' :: col (SF' b c)
sfs'  = (Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs'
              cs :: col c
cs    = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs'
          in case (SF' (a, col c) (Event d)
-> DTime -> (a, col c) -> Transition (a, col c) (Event d)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, col c) (Event d)
sfe) DTime
dt (a
a, col c
cs) of
               (SF' (a, col c) (Event d)
sfe', Event d
NoEvent) -> (col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
pSwitchAux col (SF' b c)
sfs' SF' (a, col c) (Event d)
sfe', col c
cs)
               (SF' (a, col c) (Event d)
_,    Event d
d) -> SF a (col c) -> a -> Transition a (col c)
forall a b. SF a b -> a -> Transition a b
sfTF (col (SF b c) -> d -> SF a (col c)
k (col (SF' b c) -> DTime -> col (SF b c)
forall (col :: * -> *) a b.
Functor col =>
col (SF' a b) -> DTime -> col (SF a b)
freezeCol col (SF' b c)
sfs DTime
dt) d
d) a
a

-- | Parallel switch with delayed observation parameterized on the routing
-- function.
--
-- The collection argument to the function invoked on the
-- switching event is of particular interest: it captures the
-- continuations of the signal functions running in the collection
-- maintained by 'dpSwitch' at the time of the switching event,
-- thus making it possible to preserve their state across a switch.
-- Since the continuations are plain, ordinary signal functions,
-- they can be resumed, discarded, stored, or combined with
-- other signal functions.
dpSwitch :: Functor col
         => (forall sf . (a -> col sf -> col (b, sf)))
              -- ^ Routing function. Its purpose is to pair up each running
              -- signal function in the collection maintained by 'dpSwitch'
              -- with the input it is going to see at each point in time. All
              -- the routing function can do is specify how the input is
              -- distributed.
         -> col (SF b c)
              -- ^ Initial collection of signal functions.
         -> SF (a, col c) (Event d)
              -- ^ Signal function that observes the external input signal and
              -- the output signals from the collection in order to produce a
              -- switching event.
         -> (col (SF b c) -> d -> SF a (col c))
              -- ^ The fourth argument is a function that is invoked when the
              -- switching event occurs, yielding a new signal function to
              -- switch into based on the collection of signal functions
              -- previously running and the value carried by the switching
              -- event. This allows the collection to be updated and then
              -- switched back in, typically by employing 'dpSwitch' again.
         -> SF a (col c)
dpSwitch :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
dpSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF b c)
sfs0 SF (a, col c) (Event d)
sfe0 col (SF b c) -> d -> SF a (col c)
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a (col c)
sfTF = a -> Transition a (col c)
tf0}
  where
    tf0 :: a -> Transition a (col c)
tf0 a
a0 =
      let bsfs0 :: col (b, SF b c)
bsfs0 = a -> col (SF b c) -> col (b, SF b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a0 col (SF b c)
sfs0
          sfcs0 :: col (Transition b c)
sfcs0 = ((b, SF b c) -> Transition b c)
-> col (b, SF b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b0, SF b c
sf0) -> (SF b c -> b -> Transition b c
forall a b. SF a b -> a -> Transition a b
sfTF SF b c
sf0) b
b0) col (b, SF b c)
bsfs0
          cs0 :: col c
cs0   = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs0
      in ( case (SF (a, col c) (Event d)
-> (a, col c) -> Transition (a, col c) (Event d)
forall a b. SF a b -> a -> Transition a b
sfTF SF (a, col c) (Event d)
sfe0) (a
a0, col c
cs0) of
             (SF' (a, col c) (Event d)
sfe, Event d
NoEvent)  -> col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
dpSwitchAux ((Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs0) SF' (a, col c) (Event d)
sfe
             (SF' (a, col c) (Event d)
_,   Event d
d0) -> Transition a (col c) -> SF' a (col c)
forall a b. (a, b) -> a
fst (SF a (col c) -> a -> Transition a (col c)
forall a b. SF a b -> a -> Transition a b
sfTF (col (SF b c) -> d -> SF a (col c)
k col (SF b c)
sfs0 d
d0) a
a0)
         , col c
cs0
         )

    dpSwitchAux :: col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
dpSwitchAux col (SF' b c)
sfs (SFArr DTime -> (a, col c) -> Transition (a, col c) (Event d)
_ (FDC Event d
NoEvent)) = (forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
parAux forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs
    dpSwitchAux col (SF' b c)
sfs SF' (a, col c) (Event d)
sfe = (DTime -> a -> Transition a (col c)) -> SF' a (col c)
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a (col c)
tf -- False
      where
        tf :: DTime -> a -> Transition a (col c)
tf DTime
dt a
a =
          let bsfs :: col (b, SF' b c)
bsfs  = a -> col (SF' b c) -> col (b, SF' b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a col (SF' b c)
sfs
              sfcs' :: col (Transition b c)
sfcs' = ((b, SF' b c) -> Transition b c)
-> col (b, SF' b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, SF' b c
sf) -> (SF' b c -> DTime -> b -> Transition b c
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' b c
sf) DTime
dt b
b) col (b, SF' b c)
bsfs
              cs :: col c
cs    = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs'
          in ( case (SF' (a, col c) (Event d)
-> DTime -> (a, col c) -> Transition (a, col c) (Event d)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, col c) (Event d)
sfe) DTime
dt (a
a, col c
cs) of
                 (SF' (a, col c) (Event d)
sfe', Event d
NoEvent) -> col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
dpSwitchAux ((Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs') SF' (a, col c) (Event d)
sfe'
                 (SF' (a, col c) (Event d)
_,    Event d
d) -> Transition a (col c) -> SF' a (col c)
forall a b. (a, b) -> a
fst (SF a (col c) -> a -> Transition a (col c)
forall a b. SF a b -> a -> Transition a b
sfTF (col (SF b c) -> d -> SF a (col c)
k (col (SF' b c) -> DTime -> col (SF b c)
forall (col :: * -> *) a b.
Functor col =>
col (SF' a b) -> DTime -> col (SF a b)
freezeCol col (SF' b c)
sfs DTime
dt) d
d) a
a)
             , col c
cs
             )

-- | Recurring parallel switch parameterized on the routing function.
--
-- Uses the given collection of SFs, until an event comes in the input, in
-- which case the function in the 'Event' is used to transform the collections
-- of SF to be used with 'rpSwitch' again, until the next event comes in the
-- input, and so on.
--
-- The routing function is used to decide which subpart of the input
-- goes to each SF in the collection.
--
-- This is the parallel version of 'rSwitch'.
rpSwitch :: Functor col
         => (forall sf . (a -> col sf -> col (b, sf)))
               -- ^ Routing function: determines the input to each signal
               -- function in the collection. IMPORTANT! The routing function
               -- has an obligation to preserve the structure of the signal
               -- function collection.
         -> col (SF b c)
               -- ^ Initial signal function collection.
         -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
rpSwitch :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
rpSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF b c)
sfs =
  (forall sf.
 (a, Event (col (SF b c) -> col (SF b c))) -> col sf -> col (b, sf))
-> col (SF b c)
-> SF
     ((a, Event (col (SF b c) -> col (SF b c))), col c)
     (Event (col (SF b c) -> col (SF b c)))
-> (col (SF b c)
    -> (col (SF b c) -> col (SF b c))
    -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
pSwitch (a -> col sf -> col (b, sf)
forall sf. a -> col sf -> col (b, sf)
rf (a -> col sf -> col (b, sf))
-> ((a, Event (col (SF b c) -> col (SF b c))) -> a)
-> (a, Event (col (SF b c) -> col (SF b c)))
-> col sf
-> col (b, sf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Event (col (SF b c) -> col (SF b c))) -> a
forall a b. (a, b) -> a
fst) col (SF b c)
sfs ((((a, Event (col (SF b c) -> col (SF b c))), col c)
 -> Event (col (SF b c) -> col (SF b c)))
-> SF
     ((a, Event (col (SF b c) -> col (SF b c))), col c)
     (Event (col (SF b c) -> col (SF b c)))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((a, Event (col (SF b c) -> col (SF b c)))
-> Event (col (SF b c) -> col (SF b c))
forall a b. (a, b) -> b
snd ((a, Event (col (SF b c) -> col (SF b c)))
 -> Event (col (SF b c) -> col (SF b c)))
-> (((a, Event (col (SF b c) -> col (SF b c))), col c)
    -> (a, Event (col (SF b c) -> col (SF b c))))
-> ((a, Event (col (SF b c) -> col (SF b c))), col c)
-> Event (col (SF b c) -> col (SF b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Event (col (SF b c) -> col (SF b c))), col c)
-> (a, Event (col (SF b c) -> col (SF b c)))
forall a b. (a, b) -> a
fst)) ((col (SF b c)
  -> (col (SF b c) -> col (SF b c))
  -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
 -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> (col (SF b c)
    -> (col (SF b c) -> col (SF b c))
    -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall a b. (a -> b) -> a -> b
$ \col (SF b c)
sfs' col (SF b c) -> col (SF b c)
f ->
  (a, Event (col (SF b c) -> col (SF b c)))
-> (a, Event (col (SF b c) -> col (SF b c)))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (col (SF b c) -> col (SF b c)))
 -> (a, Event (col (SF b c) -> col (SF b c))))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall a b. (a -> a) -> SF a b -> SF a b
>=- (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
rpSwitch forall sf. a -> col sf -> col (b, sf)
rf (col (SF b c) -> col (SF b c)
f col (SF b c)
sfs')

-- | Recurring parallel switch with delayed observation parameterized on the
-- routing function.
--
-- Uses the given collection of SFs, until an event comes in the input, in
-- which case the function in the 'Event' is used to transform the collections
-- of SF to be used with 'rpSwitch' again, until the next event comes in the
-- input, and so on.
--
-- The routing function is used to decide which subpart of the input
-- goes to each SF in the collection.
--
-- This is the parallel version of 'drSwitch'.
drpSwitch :: Functor col
          => (forall sf . (a -> col sf -> col (b, sf)))
                -- ^ Routing function: determines the input to each signal
                -- function in the collection. IMPORTANT! The routing function
                -- has an obligation to preserve the structure of the signal
                -- function collection.
          -> col (SF b c)
                -- ^ Initial signal function collection.
          -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
drpSwitch :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
drpSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF b c)
sfs =
  (forall sf.
 (a, Event (col (SF b c) -> col (SF b c))) -> col sf -> col (b, sf))
-> col (SF b c)
-> SF
     ((a, Event (col (SF b c) -> col (SF b c))), col c)
     (Event (col (SF b c) -> col (SF b c)))
-> (col (SF b c)
    -> (col (SF b c) -> col (SF b c))
    -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
dpSwitch (a -> col sf -> col (b, sf)
forall sf. a -> col sf -> col (b, sf)
rf (a -> col sf -> col (b, sf))
-> ((a, Event (col (SF b c) -> col (SF b c))) -> a)
-> (a, Event (col (SF b c) -> col (SF b c)))
-> col sf
-> col (b, sf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Event (col (SF b c) -> col (SF b c))) -> a
forall a b. (a, b) -> a
fst) col (SF b c)
sfs ((((a, Event (col (SF b c) -> col (SF b c))), col c)
 -> Event (col (SF b c) -> col (SF b c)))
-> SF
     ((a, Event (col (SF b c) -> col (SF b c))), col c)
     (Event (col (SF b c) -> col (SF b c)))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((a, Event (col (SF b c) -> col (SF b c)))
-> Event (col (SF b c) -> col (SF b c))
forall a b. (a, b) -> b
snd ((a, Event (col (SF b c) -> col (SF b c)))
 -> Event (col (SF b c) -> col (SF b c)))
-> (((a, Event (col (SF b c) -> col (SF b c))), col c)
    -> (a, Event (col (SF b c) -> col (SF b c))))
-> ((a, Event (col (SF b c) -> col (SF b c))), col c)
-> Event (col (SF b c) -> col (SF b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Event (col (SF b c) -> col (SF b c))), col c)
-> (a, Event (col (SF b c) -> col (SF b c)))
forall a b. (a, b) -> a
fst)) ((col (SF b c)
  -> (col (SF b c) -> col (SF b c))
  -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
 -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> (col (SF b c)
    -> (col (SF b c) -> col (SF b c))
    -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall a b. (a -> b) -> a -> b
$ \col (SF b c)
sfs' col (SF b c) -> col (SF b c)
f ->
  (a, Event (col (SF b c) -> col (SF b c)))
-> (a, Event (col (SF b c) -> col (SF b c)))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (col (SF b c) -> col (SF b c)))
 -> (a, Event (col (SF b c) -> col (SF b c))))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall a b. (a -> a) -> SF a b -> SF a b
>=- (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
drpSwitch forall sf. a -> col sf -> col (b, sf)
rf (col (SF b c) -> col (SF b c)
f col (SF b c)
sfs')

-- * Parallel composition/switchers with "zip" routing

-- | Parallel composition of a list of SFs.
--
--   Given a list of SFs, returns an SF that takes a list of inputs, applies
--   each SF to each input in order, and returns the SFs' outputs.
--
--   >>> embed (parZ [arr (+1), arr (+2)]) (deltaEncode 0.1 [[0, 0], [1, 1]])
--   [[1,2],[2,3]]
--
--   If there are more SFs than inputs, an exception is thrown.
--
--   >>> embed (parZ [arr (+1), arr (+1), arr (+2)]) (deltaEncode 0.1 [[0, 0], [1, 1]])
--   [[1,1,*** Exception: FRP.Yampa.Switches.parZ: Input list too short.
--
--   If there are more inputs than SFs, the unused inputs are ignored.
--
--   >>> embed (parZ [arr (+1)]) (deltaEncode 0.1 [[0, 0], [1, 1]])
--   [[1],[2]]

parZ :: [SF a b] -> SF [a] [b]
parZ :: [SF a b] -> SF [a] [b]
parZ = (forall sf. [a] -> [sf] -> [(a, sf)]) -> [SF a b] -> SF [a] [b]
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c) -> SF a (col c)
par (String -> [a] -> [sf] -> [(a, sf)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"parZ")

-- | Parallel switch (dynamic collection of signal functions spatially composed
-- in parallel). See 'pSwitch'.
--
-- For more information on how parallel composition works, check
-- <http://haskell.cs.yale.edu/wp-content/uploads/2011/01/yampa-arcade.pdf>
pSwitchZ :: [SF a b] -> SF ([a],[b]) (Event c) -> ([SF a b] -> c -> SF [a] [b])
            -> SF [a] [b]
pSwitchZ :: [SF a b]
-> SF ([a], [b]) (Event c)
-> ([SF a b] -> c -> SF [a] [b])
-> SF [a] [b]
pSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF a b]
-> SF ([a], [b]) (Event c)
-> ([SF a b] -> c -> SF [a] [b])
-> SF [a] [b]
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
pSwitch (String -> [a] -> [sf] -> [(a, sf)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"pSwitchZ")

-- | Decoupled parallel switch with broadcasting (dynamic collection of
--   signal functions spatially composed in parallel). See 'dpSwitch'.
--
-- For more information on how parallel composition works, check
-- <http://haskell.cs.yale.edu/wp-content/uploads/2011/01/yampa-arcade.pdf>
dpSwitchZ :: [SF a b] -> SF ([a],[b]) (Event c) -> ([SF a b] -> c ->SF [a] [b])
             -> SF [a] [b]
dpSwitchZ :: [SF a b]
-> SF ([a], [b]) (Event c)
-> ([SF a b] -> c -> SF [a] [b])
-> SF [a] [b]
dpSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF a b]
-> SF ([a], [b]) (Event c)
-> ([SF a b] -> c -> SF [a] [b])
-> SF [a] [b]
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
dpSwitch (String -> [a] -> [sf] -> [(a, sf)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"dpSwitchZ")

-- | Recurring parallel switch with "zip" routing.
--
-- Uses the given list of SFs, until an event comes in the input, in which case
-- the function in the 'Event' is used to transform the list of SF to be used
-- with 'rpSwitchZ' again, until the next event comes in the input, and so on.
--
-- Zip routing is used to decide which subpart of the input goes to each SF in
-- the list.
--
-- See 'rpSwitch'.
--
-- For more information on how parallel composition works, check
-- <http://haskell.cs.yale.edu/wp-content/uploads/2011/01/yampa-arcade.pdf>
rpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
rpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
rpSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
rpSwitch (String -> [a] -> [sf] -> [(a, sf)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"rpSwitchZ")

-- | Decoupled recurring parallel switch with "zip" routing.
--
-- Uses the given list of SFs, until an event comes in the input, in which case
-- the function in the 'Event' is used to transform the list of SF to be used
-- with 'rpSwitchZ' again, until the next event comes in the input, and so on.
--
-- Zip routing is used to decide which subpart of the input goes to each SF in
-- the list.
--
-- See 'rpSwitchZ' and 'drpSwitch'.
--
-- For more information on how parallel composition works, check
-- <http://haskell.cs.yale.edu/wp-content/uploads/2011/01/yampa-arcade.pdf>
drpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
drpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
drpSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
drpSwitch (String -> [a] -> [sf] -> [(a, sf)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"drpSwitchZ")

safeZip :: String -> [a] -> [b] -> [(a,b)]
safeZip :: String -> [a] -> [b] -> [(a, b)]
safeZip String
fn [a]
l1 [b]
l2 = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
safeZip' [a]
l1 [b]
l2
  where
    safeZip' :: [a] -> [b] -> [(a, b)]
    safeZip' :: [a] -> [b] -> [(a, b)]
safeZip' [a]
_  []     = []
    safeZip' [a]
as (b
b:[b]
bs) = ([a] -> a
forall a. [a] -> a
head' [a]
as, b
b) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
safeZip' ([a] -> [a]
forall a. [a] -> [a]
tail' [a]
as) [b]
bs

    head' :: [a] -> a
    head' :: [a] -> a
head' []    = a
forall a. a
err
    head' (a
a:[a]
_) = a
a

    tail' :: [a] -> [a]
    tail' :: [a] -> [a]
tail' []     = [a]
forall a. a
err
    tail' (a
_:[a]
as) = [a]
as

    err :: a
    err :: a
err = String -> String -> String -> a
forall a. String -> String -> String -> a
usrErr String
"FRP.Yampa.Switches" String
fn String
"Input list too short."

-- Freezes a "running" signal function, i.e., turns it into a continuation in
-- the form of a plain signal function.
freeze :: SF' a b -> DTime -> SF a b
freeze :: SF' a b -> DTime -> SF a b
freeze SF' a b
sf DTime
dt = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a b
sfTF = (SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf) DTime
dt}

freezeCol :: Functor col => col (SF' a b) -> DTime -> col (SF a b)
freezeCol :: col (SF' a b) -> DTime -> col (SF a b)
freezeCol col (SF' a b)
sfs DTime
dt = (SF' a b -> SF a b) -> col (SF' a b) -> col (SF a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SF' a b -> DTime -> SF a b
forall a b. SF' a b -> DTime -> SF a b
`freeze` DTime
dt) col (SF' a b)
sfs

-- | Apply an SF to every element of a list.
--
--   Example:
--
--   >>> embed (parC integral) (deltaEncode 0.1 [[1, 2], [2, 4], [3, 6], [4.0, 8.0 :: Float]])
--   [[0.0,0.0],[0.1,0.2],[0.3,0.6],[0.6,1.2]]
--
--   The number of SFs or expected inputs is determined by the first input
--   list, and not expected to vary over time.
--
--   If more inputs come in a subsequent list, they are ignored.
--
--   >>> embed (parC (arr (+1))) (deltaEncode 0.1 [[0], [1, 1], [3, 4], [6, 7, 8], [1, 1], [0, 0], [1, 9, 8]])
--   [[1],[2],[4],[7],[2],[1],[2]]
--
--   If less inputs come in a subsequent list, an exception is thrown.
--
--   >>> embed (parC (arr (+1))) (deltaEncode 0.1 [[0, 0], [1, 1], [3, 4], [6, 7, 8], [1, 1], [0, 0], [1, 9, 8]])
--   [[1,1],[2,2],[4,5],[7,8],[2,2],[1,1],[2,10]]

parC :: SF a b -> SF [a] [b]
parC :: SF a b -> SF [a] [b]
parC SF a b
sf = ([a] -> Transition [a] [b]) -> SF [a] [b]
forall a b. (a -> Transition a b) -> SF a b
SF (([a] -> Transition [a] [b]) -> SF [a] [b])
-> ([a] -> Transition [a] [b]) -> SF [a] [b]
forall a b. (a -> b) -> a -> b
$ \[a]
as -> let os :: [Transition a b]
os  = (a -> Transition a b) -> [a] -> [Transition a b]
forall a b. (a -> b) -> [a] -> [b]
map (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF SF a b
sf) [a]
as
                          bs :: [b]
bs  = (Transition a b -> b) -> [Transition a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Transition a b -> b
forall a b. (a, b) -> b
snd [Transition a b]
os
                          sfs :: [SF' a b]
sfs = (Transition a b -> SF' a b) -> [Transition a b] -> [SF' a b]
forall a b. (a -> b) -> [a] -> [b]
map Transition a b -> SF' a b
forall a b. (a, b) -> a
fst [Transition a b]
os
                      in ([SF' a b] -> SF' [a] [b]
forall a b. [SF' a b] -> SF' [a] [b]
parCAux [SF' a b]
sfs, [b]
bs)

-- Internal definition. Also used in parallel switchers.
parCAux :: [SF' a b] -> SF' [a] [b]
parCAux :: [SF' a b] -> SF' [a] [b]
parCAux [SF' a b]
sfs = (DTime -> [a] -> Transition [a] [b]) -> SF' [a] [b]
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> [a] -> Transition [a] [b]
tf
  where
    tf :: DTime -> [a] -> Transition [a] [b]
tf DTime
dt [a]
as =
      let os :: [Transition a b]
os    = ((a, SF' a b) -> Transition a b)
-> [(a, SF' a b)] -> [Transition a b]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
a,SF' a b
sf) -> SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf DTime
dt a
a) ([(a, SF' a b)] -> [Transition a b])
-> [(a, SF' a b)] -> [Transition a b]
forall a b. (a -> b) -> a -> b
$ String -> [a] -> [SF' a b] -> [(a, SF' a b)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"parC" [a]
as [SF' a b]
sfs
          bs :: [b]
bs    = (Transition a b -> b) -> [Transition a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Transition a b -> b
forall a b. (a, b) -> b
snd [Transition a b]
os
          sfcs :: [SF' a b]
sfcs  = (Transition a b -> SF' a b) -> [Transition a b] -> [SF' a b]
forall a b. (a -> b) -> [a] -> [b]
map Transition a b -> SF' a b
forall a b. (a, b) -> a
fst [Transition a b]
os
      in ([SF' a b] -> [SF' a b]
forall a. [a] -> [a]
listSeq [SF' a b]
sfcs [SF' a b] -> SF' [a] [b] -> SF' [a] [b]
`seq` [SF' a b] -> SF' [a] [b]
forall a b. [SF' a b] -> SF' [a] [b]
parCAux [SF' a b]
sfcs, [b] -> [b]
forall a. [a] -> [a]
listSeq [b]
bs)

listSeq :: [a] -> [a]
listSeq :: [a] -> [a]
listSeq [a]
x = [a]
x [a] -> [a] -> [a]
`seq` ([a] -> [a]
forall a. [a] -> [a]
listSeq' [a]
x)

listSeq' :: [a] -> [a]
listSeq' :: [a] -> [a]
listSeq' []        = []
listSeq' rs :: [a]
rs@(a
a:[a]
as) = a
a a -> [a] -> [a]
`seq` [a] -> [a]
forall a. [a] -> [a]
listSeq' [a]
as [a] -> [a] -> [a]
`seq` [a]
rs