{-# LANGUAGE Rank2Types #-}
-- |
-- Module      : FRP.Yampa.Switches
-- Copyright   : (c) Ivan Perez, 2014-2022
--               (c) George Giorgidze, 2007-2012
--               (c) Henrik Nilsson, 2005-2006
--               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
-- 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 formed 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 criteria:
--
-- - /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

-- External imports
import Control.Arrow (arr, first)

-- Internal imports
import FRP.Yampa.Basic        (constant, (>=-))
import FRP.Yampa.Diagnostics  (usrErr)
import FRP.Yampa.Event        (Event (..), noEventSnd)
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 :: forall a b c. 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 {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 :: forall a b c. 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 :: forall a b c. (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 :: forall a b c. 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 {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
  where
    tf0 :: a -> Transition a b
tf0 a
a0 = ( 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
             )
      where
        (SF' a (b, Event c)
sf1, (b
b0, Event c
ec0)) = a -> Transition a (b, Event c)
tf10 a
a0

    -- 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 :: forall a b c. 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 = ( 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
                  )
          where
            (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

    -- 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 :: forall a b c. (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 = ( 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
                 )
          where
            (b
b, Event c
ec) = a -> (b, Event c)
f1 a
a

-- | 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 :: forall a b. 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 b c d. SF b c -> SF (b, d) (c, d)
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 :: forall a b. 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 b c d. SF b c -> SF (b, d) (c, d)
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 :: forall a b c.
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 {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
  where
    tf0 :: a -> Transition a b
tf0 a
a0 = 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
      where
        (SF' a b
sf1, b
b0) = a -> Transition a b
tf10 a
a0

    -- This is as best as we can align this function. Any other attempts at
    -- aligning the arguments of the equal signs result in a more awkward style.
    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 = 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
          where
            (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

    -- !!! 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 = 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 b c. (b -> c) -> SF b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f1) c
c) a
a
          where
            b :: b
b = a -> b
f1 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 = 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
          where
            (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

    -- !!! 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 = 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 b c. (b -> c) -> SF b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f1) c
c) a
a
          where
            b :: b
b = a -> b
f1 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 :: forall a b c.
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 {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
  where
    tf0 :: a -> Transition a b
tf0 a
a0 = ( 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
             )
      where
        (SF' a b
sf1, b
b0) = a -> Transition a b
tf10 a
a0

    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 = ( 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
                  )
          where
            (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

-- * 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 :: forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast a
a = (sf -> (a, sf)) -> col sf -> col (a, sf)
forall a b. (a -> b) -> col a -> col b
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
-- <https://www.antonycourtney.com/pubs/hw03.pdf>
parB :: Functor col => col (SF a b) -> SF a (col b)
parB :: forall (col :: * -> *) a b.
Functor col =>
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 a -> col sf -> col (a, sf)
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
-- <https://www.antonycourtney.com/pubs/hw03.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 :: forall (col :: * -> *) a b c.
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 = (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 a -> col sf -> col (a, sf)
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
-- <https://www.antonycourtney.com/pubs/hw03.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 :: forall (col :: * -> *) a b c.
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 = (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 a -> col sf -> col (a, sf)
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
-- <https://www.antonycourtney.com/pubs/hw03.pdf>
rpSwitchB :: Functor col
          => col (SF a b)
          -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
rpSwitchB :: forall (col :: * -> *) a b.
Functor col =>
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 a -> col sf -> col (a, sf)
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
-- <https://www.antonycourtney.com/pubs/hw03.pdf>
drpSwitchB :: Functor col
           => col (SF a b)
           -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
drpSwitchB :: forall (col :: * -> *) a b.
Functor col =>
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 a -> col sf -> col (a, sf)
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 (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 (b, sf)
rf col (SF b c)
sfs0 = SF {sfTF :: a -> Transition a (col c)
sfTF = a -> Transition a (col c)
tf0}
  where
    tf0 :: a -> Transition a (col c)
tf0 a
a0 = ((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 a -> col sf -> col (b, sf)
forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs, col c
cs0)
      where
        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 a b. (a -> b) -> col a -> col b
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 a b. (a -> b) -> col a -> col b
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 a b. (a -> b) -> col a -> col b
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

-- 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 (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 = (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 = ((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 a -> col sf -> col (b, sf)
forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs', col c
cs)
      where
        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 a b. (a -> b) -> col a -> col b
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 a b. (a -> b) -> col a -> col b
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 a b. (a -> b) -> col a -> col b
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'

-- | 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 (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 (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 {sfTF :: a -> Transition a (col c)
sfTF = a -> Transition a (col c)
tf0}
  where
    tf0 :: a -> Transition a (col c)
tf0 a
a0 = 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
      where
        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 a b. (a -> b) -> col a -> col b
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 a b. (a -> b) -> col a -> col b
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 a b. (a -> b) -> col a -> col b
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

    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 a -> col sf -> col (b, sf)
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 = 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
          where
            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 a b. (a -> b) -> col a -> col b
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 a b. (a -> b) -> col a -> col b
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 a b. (a -> b) -> col a -> col b
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'

-- | 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 (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 (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 {sfTF :: a -> Transition a (col c)
sfTF = a -> Transition a (col c)
tf0}
  where
    tf0 :: a -> Transition a (col c)
tf0 a
a0 = ( 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 (((SF' b c, c) -> SF' b c) -> col (SF' b c, c) -> col (SF' b c)
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SF' b c, c) -> SF' b c
forall a b. (a, b) -> a
fst col (SF' b c, 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
             )
      where
        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 (SF' b c, c)
sfcs0 = ((b, SF b c) -> (SF' b c, c))
-> col (b, SF b c) -> col (SF' b c, c)
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b0, SF b c
sf0) -> (SF b c -> b -> (SF' b c, 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   = ((SF' b c, c) -> c) -> col (SF' b c, c) -> col c
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SF' b c, c) -> c
forall a b. (a, b) -> b
snd col (SF' b c, c)
sfcs0

    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 a -> col sf -> col (b, sf)
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 = ( 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 (((SF' b c, c) -> SF' b c) -> col (SF' b c, c) -> col (SF' b c)
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SF' b c, c) -> SF' b c
forall a b. (a, b) -> a
fst col (SF' b c, 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
                  )
          where
            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 (SF' b c, c)
sfcs' = ((b, SF' b c) -> (SF' b c, c))
-> col (b, SF' b c) -> col (SF' b c, c)
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, SF' b c
sf) -> (SF' b c -> DTime -> b -> (SF' b c, 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    = ((SF' b c, c) -> c) -> col (SF' b c, c) -> col c
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SF' b c, c) -> c
forall a b. (a, b) -> b
snd col (SF' b c, c)
sfcs'

-- | 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 (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)
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 b c. (b -> c) -> 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 a -> col sf -> col (b, sf)
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 (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)
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 b c. (b -> c) -> 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 a -> col sf -> col (b, sf)
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 :: forall a b. [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
-- <https://www.antonycourtney.com/pubs/hw03.pdf>
pSwitchZ :: [SF a b]
         -> SF ([a], [b]) (Event c)
         -> ([SF a b] -> c -> SF [a] [b])
         -> SF [a] [b]
pSwitchZ :: forall a b c.
[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
-- <https://www.antonycourtney.com/pubs/hw03.pdf>
dpSwitchZ :: [SF a b]
          -> SF ([a], [b]) (Event c)
          -> ([SF a b] -> c -> SF [a] [b])
          -> SF [a] [b]
dpSwitchZ :: forall a b c.
[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
-- <https://www.antonycourtney.com/pubs/hw03.pdf>
rpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
rpSwitchZ :: forall a b. [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
-- <https://www.antonycourtney.com/pubs/hw03.pdf>
drpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
drpSwitchZ :: forall a b. [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")

-- | Zip two lists.
--
-- PRE: The first list is not shorter than the second.
safeZip :: String -> [a] -> [b] -> [(a, b)]
safeZip :: forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
fn = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
safeZip'
  where
    safeZip' :: [a] -> [b] -> [(a, b)]
    safeZip' :: forall a b. [a] -> [b] -> [(a, b)]
safeZip' [a]
_      []     = []
    safeZip' (a
a:[a]
as) (b
b:[b]
bs) = (a
a, 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]
as [b]
bs
    safeZip' [a]
_      [b]
_      =
      String -> String -> String -> [(a, b)]
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 :: forall a b. SF' a b -> DTime -> SF a b
freeze SF' a b
sf DTime
dt = 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 :: forall (col :: * -> *) a b.
Functor col =>
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 a b. (a -> b) -> col a -> col 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 :: forall a b. 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 :: forall a b. [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 = ([SF' a b] -> [SF' a b]
forall a. [a] -> [a]
listSeq [SF' a b]
sfcs [SF' a b] -> SF' [a] [b] -> SF' [a] [b]
forall a b. a -> b -> 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)
      where
        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

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

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