{-# LANGUAGE CPP        #-}
{-# LANGUAGE Rank2Types #-}
-- The following warning is disabled so that we do not see warnings due to
-- using ListT on an MSF to implement parallelism with broadcasting.
#if __GLASGOW_HASKELL__ < 800
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
#else
{-# OPTIONS_GHC -Wno-deprecations #-}
#endif

-- |
-- Copyright  : (c) Ivan Perez, 2019-2022
--              (c) Ivan Perez and Manuel Baerenz, 2016-2018
-- License    : BSD3
-- Maintainer : ivan.perez@keera.co.uk
--
-- 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 :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m 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.BearRiver.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
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative (..), (<$>))
#endif
import Control.Arrow              (arr, first)
import Control.Monad.Trans.Class  (lift)
import Control.Monad.Trans.Reader (ask, runReaderT)
import Data.Traversable           as T

-- Internal imports (dunai)
import Control.Monad.Trans.MSF                 (local, performOnFirstSample)
import Control.Monad.Trans.MSF.List            (sequenceS, widthFirst)
import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))

-- Internal imports
import FRP.BearRiver.Basic        ((>=-))
import FRP.BearRiver.Event        (Event (..), noEventSnd)
import FRP.BearRiver.InternalCore (DTime, SF)

-- * 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 :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch :: forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch SF m a (b, Event c)
sf c -> SF m a b
sfC = (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ClockInfo m (b, SF m a b)) -> SF m a b)
-> (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall a b. (a -> b) -> a -> b
$ \a
a -> do
  ((b, Event c)
o, SF m a (b, Event c)
ct) <- SF m a (b, Event c)
-> a -> ReaderT DTime m ((b, Event c), SF m a (b, Event c))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a (b, Event c)
sf a
a
  case (b, Event c)
o of
    (b
_, Event c
c) -> (DTime -> DTime)
-> ClockInfo m (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (DTime -> DTime -> DTime
forall a b. a -> b -> a
const DTime
0) (SF m a b -> a -> ClockInfo m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (c -> SF m a b
sfC c
c) a
a)
    (b
b, Event c
NoEvent) -> (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch SF m a (b, Event c)
ct c -> SF m a b
sfC)

-- | 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 :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch :: forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch SF m a (b, Event c)
sf c -> SF m a b
sfC = (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ClockInfo m (b, SF m a b)) -> SF m a b)
-> (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall a b. (a -> b) -> a -> b
$ \a
a -> do
  ((b, Event c)
o, SF m a (b, Event c)
ct) <- SF m a (b, Event c)
-> a -> ReaderT DTime m ((b, Event c), SF m a (b, Event c))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a (b, Event c)
sf a
a
  case (b, Event c)
o of
    (b
b, Event c
c) -> do (b
_, SF m a b
ct') <- (DTime -> DTime)
-> ClockInfo m (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (DTime -> DTime -> DTime
forall a b. a -> b -> a
const DTime
0) (SF m a b -> a -> ClockInfo m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (c -> SF m a b
sfC c
c) a
a)
                       (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, SF m a b
ct')
    (b
b, Event c
NoEvent) -> (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch SF m a (b, Event c)
ct c -> SF m a b
sfC)

-- | 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 :: Monad m => SF m a b -> SF m (a, Event (SF m a b)) b
rSwitch :: forall (m :: * -> *) a b.
Monad m =>
SF m a b -> SF m (a, Event (SF m a b)) b
rSwitch SF m a b
sf = SF m (a, Event (SF m a b)) (b, Event (SF m a b))
-> (SF m a b -> SF m (a, Event (SF m a b)) b)
-> SF m (a, Event (SF m a b)) b
forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch (SF m a b -> SF m (a, Event (SF m a b)) (b, Event (SF m a b))
forall b c d.
MSF (ClockInfo m) b c -> MSF (ClockInfo m) (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first SF m a b
sf) (((a, Event (SF m a b)) -> (a, Event (SF m a b))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (SF m a b)) -> (a, Event (SF m a b)))
-> SF m (a, Event (SF m a b)) b -> SF m (a, Event (SF m a b)) b
forall (m :: * -> *) a b.
Monad m =>
(a -> a) -> SF m a b -> SF m a b
>=-) (SF m (a, Event (SF m a b)) b -> SF m (a, Event (SF m a b)) b)
-> (SF m a b -> SF m (a, Event (SF m a b)) b)
-> SF m a b
-> SF m (a, Event (SF m a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SF m a b -> SF m (a, Event (SF m a b)) b
forall (m :: * -> *) a b.
Monad m =>
SF m a b -> SF m (a, Event (SF m 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 :: Monad m => SF m a b -> SF m (a, Event (SF m a b)) b
drSwitch :: forall (m :: * -> *) a b.
Monad m =>
SF m a b -> SF m (a, Event (SF m a b)) b
drSwitch SF m a b
sf = SF m (a, Event (SF m a b)) (b, Event (SF m a b))
-> (SF m a b -> SF m (a, Event (SF m a b)) b)
-> SF m (a, Event (SF m a b)) b
forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch (SF m a b -> SF m (a, Event (SF m a b)) (b, Event (SF m a b))
forall b c d.
MSF (ClockInfo m) b c -> MSF (ClockInfo m) (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first SF m a b
sf) (((a, Event (SF m a b)) -> (a, Event (SF m a b))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (SF m a b)) -> (a, Event (SF m a b)))
-> SF m (a, Event (SF m a b)) b -> SF m (a, Event (SF m a b)) b
forall (m :: * -> *) a b.
Monad m =>
(a -> a) -> SF m a b -> SF m a b
>=-) (SF m (a, Event (SF m a b)) b -> SF m (a, Event (SF m a b)) b)
-> (SF m a b -> SF m (a, Event (SF m a b)) b)
-> SF m a b
-> SF m (a, Event (SF m a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SF m a b -> SF m (a, Event (SF m a b)) b
forall (m :: * -> *) a b.
Monad m =>
SF m a b -> SF m (a, Event (SF m 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 :: Monad m
        => SF m a b
        -> SF m (a, b) (Event c)
        -> (SF m a b -> c -> SF m a b)
        -> SF m a b
kSwitch :: forall (m :: * -> *) a b c.
Monad m =>
SF m a b
-> SF m (a, b) (Event c) -> (SF m a b -> c -> SF m a b) -> SF m a b
kSwitch SF m a b
sf10 SF m (a, b) (Event c)
tfe0 SF m a b -> c -> SF m a b
k = (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF a -> ClockInfo m (b, SF m a b)
tf0
  where
    tf0 :: a -> ClockInfo m (b, SF m a b)
tf0 a
a0 = do
      (b
b0, SF m a b
sf1) <- SF m a b -> a -> ClockInfo m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf10 a
a0
      (Event c
me, SF m (a, b) (Event c)
sfe) <- SF m (a, b) (Event c)
-> (a, b) -> ClockInfo m (Event c, SF m (a, b) (Event c))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m (a, b) (Event c)
tfe0 (a
a0, b
b0)
      case Event c
me of
        Event c
NoEvent  -> (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall a. a -> ClockInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b0, SF m a b
-> SF m (a, b) (Event c) -> (SF m a b -> c -> SF m a b) -> SF m a b
forall (m :: * -> *) a b c.
Monad m =>
SF m a b
-> SF m (a, b) (Event c) -> (SF m a b -> c -> SF m a b) -> SF m a b
kSwitch SF m a b
sf1 SF m (a, b) (Event c)
sfe SF m a b -> c -> SF m a b
k)
        Event c
c0 -> SF m a b -> a -> ClockInfo m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (SF m a b -> c -> SF m a b
k SF m a b
sf10 c
c0) a
a0

-- | '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.
#if MIN_VERSION_base(4,8,0)
dkSwitch :: Monad m
         => SF m a b
         -> SF m (a, b) (Event c)
         -> (SF m a b -> c -> SF m a b)
         -> SF m a b
#else
dkSwitch :: (Functor m, Monad m)
         => SF m a b
         -> SF m (a, b) (Event c)
         -> (SF m a b -> c -> SF m a b)
         -> SF m a b
#endif
dkSwitch :: forall (m :: * -> *) a b c.
Monad m =>
SF m a b
-> SF m (a, b) (Event c) -> (SF m a b -> c -> SF m a b) -> SF m a b
dkSwitch SF m a b
sf1 SF m (a, b) (Event c)
sfe SF m a b -> c -> SF m a b
k = (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF a -> ClockInfo m (b, SF m a b)
tf -- False
      where
        tf :: a -> ClockInfo m (b, SF m a b)
tf a
a = do
          (b
b, SF m a b
sf1')  <- SF m a b -> a -> ClockInfo m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf1 a
a
          (Event c
me, SF m (a, b) (Event c)
sfe') <- SF m (a, b) (Event c)
-> (a, b) -> ClockInfo m (Event c, SF m (a, b) (Event c))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m (a, b) (Event c)
sfe (a
a, b
b)
          let sfe'' :: SF m a b
sfe'' = case Event c
me of
                        Event c
NoEvent -> SF m a b
-> SF m (a, b) (Event c) -> (SF m a b -> c -> SF m a b) -> SF m a b
forall (m :: * -> *) a b c.
Monad m =>
SF m a b
-> SF m (a, b) (Event c) -> (SF m a b -> c -> SF m a b) -> SF m a b
dkSwitch SF m a b
sf1' SF m (a, b) (Event c)
sfe' SF m a b -> c -> SF m a b
k
                        Event c
c -> ClockInfo m (SF m a b) -> SF m a b
forall (m :: * -> *) a b. Monad m => m (MSF m a b) -> MSF m a b
performOnFirstSample ((b, SF m a b) -> SF m a b
forall a b. (a, b) -> b
snd ((b, SF m a b) -> SF m a b)
-> ClockInfo m (b, SF m a b) -> ClockInfo m (SF m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SF m a b -> a -> ClockInfo m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (SF m a b -> c -> SF m a b
k SF m a b
sf1 c
c) a
a)
          (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall a. a -> ClockInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, SF m a b
sfe'')

-- * Parallel composition and switching

-- ** 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))

#if MIN_VERSION_base(4,8,0)
parB :: Monad m => [SF m a b] -> SF m a [b]
#else
parB :: (Functor m, Monad m) => [SF m a b] -> SF m a [b]
#endif
-- ^ 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 :: forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m a [b]
parB = MSF (ListT (ClockInfo m)) a b -> MSF (ClockInfo m) a [b]
forall (m :: * -> *) a b.
(Functor m, Monad m) =>
MSF (ListT m) a b -> MSF m a [b]
widthFirst (MSF (ListT (ClockInfo m)) a b -> MSF (ClockInfo m) a [b])
-> ([SF m a b] -> MSF (ListT (ClockInfo m)) a b)
-> [SF m a b]
-> MSF (ClockInfo m) a [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SF m a b] -> MSF (ListT (ClockInfo m)) a b
forall (m :: * -> *) a b.
Monad m =>
[MSF m a b] -> MSF (ListT m) a b
sequenceS

-- | 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 m, Monad m, Traversable col, Functor col)
         => col (SF m a b)
         -> SF m (a, col b) (Event c)
         -> (col (SF m a b) -> c -> SF m a (col b))
         -> SF m a (col b)
pSwitchB :: forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Traversable col, Functor col) =>
col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
pSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
forall (m :: * -> *) (col :: * -> *) a b c d.
(Functor m, Monad m, Traversable col, Functor col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, col c) (Event d)
-> (col (SF m b c) -> d -> SF m a (col c))
-> SF m 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 m, Monad m, Traversable col)
          => col (SF m a b)
          -> SF m (a, col b) (Event c)
          -> (col (SF m a b) -> c -> SF m a (col b))
          -> SF m a (col b)
dpSwitchB :: forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Traversable col) =>
col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
dpSwitchB col (SF m a b)
sfs SF m (a, col b) (Event c)
sfF col (SF m a b) -> c -> SF m a (col b)
sfCs = (a -> ClockInfo m (col b, SF m a (col b))) -> SF m a (col b)
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ClockInfo m (col b, SF m a (col b))) -> SF m a (col b))
-> (a -> ClockInfo m (col b, SF m a (col b))) -> SF m a (col b)
forall a b. (a -> b) -> a -> b
$ \a
a -> do
  col (b, SF m a b)
res <- (SF m a b -> ReaderT DTime m (b, SF m a b))
-> col (SF m a b) -> ReaderT DTime m (col (b, SF m a b))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> col a -> m (col b)
T.mapM (SF m a b -> a -> ReaderT DTime m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
`unMSF` a
a) col (SF m a b)
sfs
  let bs :: col b
bs   = ((b, SF m a b) -> b) -> col (b, SF m a b) -> col b
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> b
forall a b. (a, b) -> a
fst col (b, SF m a b)
res
      sfs' :: col (SF m a b)
sfs' = ((b, SF m a b) -> SF m a b) -> col (b, SF m a b) -> col (SF m a b)
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> SF m a b
forall a b. (a, b) -> b
snd col (b, SF m a b)
res
  (Event c
e, SF m (a, col b) (Event c)
sfF') <- SF m (a, col b) (Event c)
-> (a, col b)
-> ReaderT DTime m (Event c, SF m (a, col b) (Event c))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m (a, col b) (Event c)
sfF (a
a, col b
bs)
  SF m a (col b)
ct <- case Event c
e of
          Event c
c -> (col b, SF m a (col b)) -> SF m a (col b)
forall a b. (a, b) -> b
snd ((col b, SF m a (col b)) -> SF m a (col b))
-> ClockInfo m (col b, SF m a (col b))
-> ReaderT DTime m (SF m a (col b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SF m a (col b) -> a -> ClockInfo m (col b, SF m a (col b))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (col (SF m a b) -> c -> SF m a (col b)
sfCs col (SF m a b)
sfs c
c) a
a
          Event c
NoEvent -> SF m a (col b) -> ReaderT DTime m (SF m a (col b))
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Traversable col) =>
col (SF m a b)
-> SF m (a, col b) (Event c)
-> (col (SF m a b) -> c -> SF m a (col b))
-> SF m a (col b)
dpSwitchB col (SF m a b)
sfs' SF m (a, col b) (Event c)
sfF' col (SF m a b) -> c -> SF m a (col b)
sfCs)
  (col b, SF m a (col b)) -> ClockInfo m (col b, SF m a (col b))
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (col b
bs, SF m a (col b)
ct)

-- | 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 m, Monad m, Functor col, Traversable col)
          => col (SF m a b)
          -> SF m (a, Event (col (SF m a b) -> col (SF m a b))) (col b)
rpSwitchB :: forall (m :: * -> *) (col :: * -> *) a b.
(Functor m, Monad m, Functor col, Traversable col) =>
col (SF m a b)
-> SF m (a, Event (col (SF m a b) -> col (SF m a b))) (col b)
rpSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF m a b)
-> SF m (a, Event (col (SF m a b) -> col (SF m a b))) (col b)
forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, Event (col (SF m b c) -> col (SF m 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 m, Monad m, Functor col, Traversable col)
           => col (SF m a b)
           -> SF m (a, Event (col (SF m a b) -> col (SF m a b))) (col b)
drpSwitchB :: forall (m :: * -> *) (col :: * -> *) a b.
(Functor m, Monad m, Functor col, Traversable col) =>
col (SF m a b)
-> SF m (a, Event (col (SF m a b) -> col (SF m a b))) (col b)
drpSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF m a b)
-> SF m (a, Event (col (SF m a b) -> col (SF m a b))) (col b)
forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, Event (col (SF m b c) -> col (SF m 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 m, Monad m, Functor col, Traversable 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 m b c)
       -- ^ Signal function collection.
    -> SF m a (col c)
par :: forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c) -> SF m a (col c)
par forall sf. a -> col sf -> col (b, sf)
rf col (SF m b c)
sfs0 = (a -> ClockInfo m (col c, MSF (ClockInfo m) a (col c)))
-> MSF (ClockInfo m) a (col c)
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF a -> ClockInfo m (col c, MSF (ClockInfo m) a (col c))
tf0
  where
    tf0 :: a -> ClockInfo m (col c, MSF (ClockInfo m) a (col c))
tf0 a
a0 = do
      let bsfs0 :: col (b, SF m b c)
bsfs0 = a -> col (SF m b c) -> col (b, SF m b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a0 col (SF m b c)
sfs0
      col (c, SF m b c)
sfcs0 <- ((b, SF m b c) -> ClockInfo m (c, SF m b c))
-> col (b, SF m b c) -> ClockInfo m (col (c, SF m b c))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> col a -> m (col b)
T.mapM (\(b
b0, SF m b c
sf0) -> (SF m b c -> b -> ClockInfo m (c, SF m b c)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m b c
sf0) b
b0) col (b, SF m b c)
bsfs0
      let sfs :: col (SF m b c)
sfs = ((c, SF m b c) -> SF m b c) -> col (c, SF m b c) -> col (SF m b c)
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (c, SF m b c) -> SF m b c
forall a b. (a, b) -> b
snd col (c, SF m b c)
sfcs0
          cs0 :: col c
cs0 = ((c, SF m b c) -> c) -> col (c, SF m 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 (c, SF m b c) -> c
forall a b. (a, b) -> a
fst col (c, SF m b c)
sfcs0
      (col c, MSF (ClockInfo m) a (col c))
-> ClockInfo m (col c, MSF (ClockInfo m) a (col c))
forall a. a -> ClockInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (col c
cs0, (forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c) -> MSF (ClockInfo m) a (col c)
forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c) -> SF m a (col c)
par a -> col sf -> col (b, sf)
forall sf. a -> col sf -> col (b, sf)
rf col (SF m b c)
sfs)

-- | 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 m, Monad m, Traversable col, 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 m b c)
           -- ^ Signal function collection.
        -> SF m (a, col c) (Event d)
           -- ^ Signal function generating the switching event.
        -> (col (SF m b c) -> d -> SF m a (col c))
           -- ^ Continuation to be invoked once event occurs.
        -> SF m a (col c)
pSwitch :: forall (m :: * -> *) (col :: * -> *) a b c d.
(Functor m, Monad m, Traversable col, Functor col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, col c) (Event d)
-> (col (SF m b c) -> d -> SF m a (col c))
-> SF m a (col c)
pSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF m b c)
sfs0 SF m (a, col c) (Event d)
sfe0 col (SF m b c) -> d -> SF m a (col c)
k = (a -> ClockInfo m (col c, SF m a (col c))) -> SF m a (col c)
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF a -> ClockInfo m (col c, SF m a (col c))
tf0
  where
    tf0 :: a -> ClockInfo m (col c, SF m a (col c))
tf0 a
a0 = do
      let bsfs0 :: col (b, SF m b c)
bsfs0 = a -> col (SF m b c) -> col (b, SF m b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a0 col (SF m b c)
sfs0
      col (c, SF m b c)
sfcs0 <- ((b, SF m b c) -> ClockInfo m (c, SF m b c))
-> col (b, SF m b c) -> ClockInfo m (col (c, SF m b c))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> col a -> m (col b)
T.mapM (\(b
b0, SF m b c
sf0) -> (SF m b c -> b -> ClockInfo m (c, SF m b c)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m b c
sf0) b
b0) col (b, SF m b c)
bsfs0
      let sfs :: col (SF m b c)
sfs   = ((c, SF m b c) -> SF m b c) -> col (c, SF m b c) -> col (SF m b c)
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (c, SF m b c) -> SF m b c
forall a b. (a, b) -> b
snd col (c, SF m b c)
sfcs0
          cs0 :: col c
cs0   = ((c, SF m b c) -> c) -> col (c, SF m 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 (c, SF m b c) -> c
forall a b. (a, b) -> a
fst col (c, SF m b c)
sfcs0
      (Event d
e, SF m (a, col c) (Event d)
sfe) <- SF m (a, col c) (Event d)
-> (a, col c) -> ClockInfo m (Event d, SF m (a, col c) (Event d))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m (a, col c) (Event d)
sfe0 (a
a0, col c
cs0)
      case Event d
e of
        Event d
NoEvent  -> (col c, SF m a (col c)) -> ClockInfo m (col c, SF m a (col c))
forall a. a -> ClockInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (col c
cs0, col (SF m b c) -> SF m (a, col c) (Event d) -> SF m a (col c)
pSwitchAux col (SF m b c)
sfs SF m (a, col c) (Event d)
sfe)
        Event d
d0 -> SF m a (col c) -> a -> ClockInfo m (col c, SF m a (col c))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (col (SF m b c) -> d -> SF m a (col c)
k col (SF m b c)
sfs0 d
d0) a
a0

    pSwitchAux :: col (SF m b c) -> SF m (a, col c) (Event d) -> SF m a (col c)
pSwitchAux col (SF m b c)
sfs SF m (a, col c) (Event d)
sfe = (a -> ClockInfo m (col c, SF m a (col c))) -> SF m a (col c)
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF a -> ClockInfo m (col c, SF m a (col c))
tf
      where
        tf :: a -> ClockInfo m (col c, SF m a (col c))
tf a
a = do
          let bsfs :: col (b, SF m b c)
bsfs = a -> col (SF m b c) -> col (b, SF m b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a col (SF m b c)
sfs
          col (c, SF m b c)
sfcs' <- ((b, SF m b c) -> ClockInfo m (c, SF m b c))
-> col (b, SF m b c) -> ClockInfo m (col (c, SF m b c))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> col a -> m (col b)
T.mapM (\(b
b, SF m b c
sf) -> (SF m b c -> b -> ClockInfo m (c, SF m b c)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m b c
sf b
b)) col (b, SF m b c)
bsfs
          let sfs' :: col (SF m b c)
sfs' = ((c, SF m b c) -> SF m b c) -> col (c, SF m b c) -> col (SF m b c)
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (c, SF m b c) -> SF m b c
forall a b. (a, b) -> b
snd col (c, SF m b c)
sfcs'
              cs :: col c
cs   = ((c, SF m b c) -> c) -> col (c, SF m 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 (c, SF m b c) -> c
forall a b. (a, b) -> a
fst col (c, SF m b c)
sfcs'
          (Event d
e, SF m (a, col c) (Event d)
sfe') <- SF m (a, col c) (Event d)
-> (a, col c) -> ClockInfo m (Event d, SF m (a, col c) (Event d))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m (a, col c) (Event d)
sfe (a
a, col c
cs)
          case Event d
e of
            Event d
NoEvent -> (col c, SF m a (col c)) -> ClockInfo m (col c, SF m a (col c))
forall a. a -> ClockInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (col c
cs, col (SF m b c) -> SF m (a, col c) (Event d) -> SF m a (col c)
pSwitchAux col (SF m b c)
sfs' SF m (a, col c) (Event d)
sfe')
            Event d
d -> do DTime
dt <- ReaderT DTime m DTime
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
                          SF m a (col c) -> a -> ClockInfo m (col c, SF m a (col c))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF (col (SF m b c) -> d -> SF m a (col c)
k (col (SF m b c) -> DTime -> col (SF m b c)
forall (m :: * -> *) (col :: * -> *) a b.
(Monad m, Functor col) =>
col (SF m a b) -> DTime -> col (SF m a b)
freezeCol col (SF m 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 :: (Monad m, Traversable 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 m b c)
            -- ^ Initial collection of signal functions.
         -> SF m (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 m b c) -> d -> SF m 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 m a (col c)
dpSwitch :: forall (m :: * -> *) (col :: * -> *) a b c d.
(Monad m, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, col c) (Event d)
-> (col (SF m b c) -> d -> SF m a (col c))
-> SF m a (col c)
dpSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF m b c)
sfs SF m (a, col c) (Event d)
sfF col (SF m b c) -> d -> SF m a (col c)
sfCs = (a -> ClockInfo m (col c, SF m a (col c))) -> SF m a (col c)
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ClockInfo m (col c, SF m a (col c))) -> SF m a (col c))
-> (a -> ClockInfo m (col c, SF m a (col c))) -> SF m a (col c)
forall a b. (a -> b) -> a -> b
$ \a
a -> do
  let bsfs :: col (b, SF m b c)
bsfs = a -> col (SF m b c) -> col (b, SF m b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a col (SF m b c)
sfs
  col (c, SF m b c)
res <- ((b, SF m b c) -> ReaderT DTime m (c, SF m b c))
-> col (b, SF m b c) -> ReaderT DTime m (col (c, SF m b c))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> col a -> m (col b)
T.mapM (\(b
b, SF m b c
sf) -> SF m b c -> b -> ReaderT DTime m (c, SF m b c)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m b c
sf b
b) col (b, SF m b c)
bsfs
  let cs :: col c
cs   = ((c, SF m b c) -> c) -> col (c, SF m 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 (c, SF m b c) -> c
forall a b. (a, b) -> a
fst col (c, SF m b c)
res
      sfs' :: col (SF m b c)
sfs' = ((c, SF m b c) -> SF m b c) -> col (c, SF m b c) -> col (SF m b c)
forall a b. (a -> b) -> col a -> col b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (c, SF m b c) -> SF m b c
forall a b. (a, b) -> b
snd col (c, SF m b c)
res
  (Event d
e, SF m (a, col c) (Event d)
sfF') <- SF m (a, col c) (Event d)
-> (a, col c)
-> ReaderT DTime m (Event d, SF m (a, col c) (Event d))
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m (a, col c) (Event d)
sfF (a
a, col c
cs)
  let ct :: SF m a (col c)
ct = case Event d
e of
          Event d
d -> col (SF m b c) -> d -> SF m a (col c)
sfCs col (SF m b c)
sfs' d
d
          Event d
NoEvent -> (forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, col c) (Event d)
-> (col (SF m b c) -> d -> SF m a (col c))
-> SF m a (col c)
forall (m :: * -> *) (col :: * -> *) a b c d.
(Monad m, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, col c) (Event d)
-> (col (SF m b c) -> d -> SF m a (col c))
-> SF m a (col c)
dpSwitch a -> col sf -> col (b, sf)
forall sf. a -> col sf -> col (b, sf)
rf col (SF m b c)
sfs' SF m (a, col c) (Event d)
sfF' col (SF m b c) -> d -> SF m a (col c)
sfCs
  (col c, SF m a (col c)) -> ClockInfo m (col c, SF m a (col c))
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return (col c
cs, SF m a (col c)
ct)

-- | 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 m, Monad m, Functor col, Traversable 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 m b c)
            -- ^ Initial signal function collection.
         -> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
rpSwitch :: forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
rpSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF m b c)
sfs =
  (forall sf.
 (a, Event (col (SF m b c) -> col (SF m b c)))
 -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF
     m
     ((a, Event (col (SF m b c) -> col (SF m b c))), col c)
     (Event (col (SF m b c) -> col (SF m b c)))
-> (col (SF m b c)
    -> (col (SF m b c) -> col (SF m b c))
    -> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c))
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
forall (m :: * -> *) (col :: * -> *) a b c d.
(Functor m, Monad m, Traversable col, Functor col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, col c) (Event d)
-> (col (SF m b c) -> d -> SF m a (col c))
-> SF m 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 m b c) -> col (SF m b c))) -> a)
-> (a, Event (col (SF m b c) -> col (SF m b c)))
-> col sf
-> col (b, sf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Event (col (SF m b c) -> col (SF m b c))) -> a
forall a b. (a, b) -> a
fst) col (SF m b c)
sfs ((((a, Event (col (SF m b c) -> col (SF m b c))), col c)
 -> Event (col (SF m b c) -> col (SF m b c)))
-> SF
     m
     ((a, Event (col (SF m b c) -> col (SF m b c))), col c)
     (Event (col (SF m b c) -> col (SF m b c)))
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((a, Event (col (SF m b c) -> col (SF m b c)))
-> Event (col (SF m b c) -> col (SF m b c))
forall a b. (a, b) -> b
snd ((a, Event (col (SF m b c) -> col (SF m b c)))
 -> Event (col (SF m b c) -> col (SF m b c)))
-> (((a, Event (col (SF m b c) -> col (SF m b c))), col c)
    -> (a, Event (col (SF m b c) -> col (SF m b c))))
-> ((a, Event (col (SF m b c) -> col (SF m b c))), col c)
-> Event (col (SF m b c) -> col (SF m b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Event (col (SF m b c) -> col (SF m b c))), col c)
-> (a, Event (col (SF m b c) -> col (SF m b c)))
forall a b. (a, b) -> a
fst)) ((col (SF m b c)
  -> (col (SF m b c) -> col (SF m b c))
  -> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c))
 -> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c))
-> (col (SF m b c)
    -> (col (SF m b c) -> col (SF m b c))
    -> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c))
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
forall a b. (a -> b) -> a -> b
$ \col (SF m b c)
sfs' col (SF m b c) -> col (SF m b c)
f ->
  (a, Event (col (SF m b c) -> col (SF m b c)))
-> (a, Event (col (SF m b c) -> col (SF m b c)))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (col (SF m b c) -> col (SF m b c)))
 -> (a, Event (col (SF m b c) -> col (SF m b c))))
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
forall (m :: * -> *) a b.
Monad m =>
(a -> a) -> SF m a b -> SF m a b
>=- (forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
rpSwitch a -> col sf -> col (b, sf)
forall sf. a -> col sf -> col (b, sf)
rf (col (SF m b c) -> col (SF m b c)
f col (SF m 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 m, Monad m, Functor col, Traversable 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 m b c)
             -- ^ Initial signal function collection.
          -> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
drpSwitch :: forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
drpSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF m b c)
sfs =
  (forall sf.
 (a, Event (col (SF m b c) -> col (SF m b c)))
 -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF
     m
     ((a, Event (col (SF m b c) -> col (SF m b c))), col c)
     (Event (col (SF m b c) -> col (SF m b c)))
-> (col (SF m b c)
    -> (col (SF m b c) -> col (SF m b c))
    -> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c))
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
forall (m :: * -> *) (col :: * -> *) a b c d.
(Monad m, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, col c) (Event d)
-> (col (SF m b c) -> d -> SF m a (col c))
-> SF m 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 m b c) -> col (SF m b c))) -> a)
-> (a, Event (col (SF m b c) -> col (SF m b c)))
-> col sf
-> col (b, sf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Event (col (SF m b c) -> col (SF m b c))) -> a
forall a b. (a, b) -> a
fst) col (SF m b c)
sfs ((((a, Event (col (SF m b c) -> col (SF m b c))), col c)
 -> Event (col (SF m b c) -> col (SF m b c)))
-> SF
     m
     ((a, Event (col (SF m b c) -> col (SF m b c))), col c)
     (Event (col (SF m b c) -> col (SF m b c)))
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((a, Event (col (SF m b c) -> col (SF m b c)))
-> Event (col (SF m b c) -> col (SF m b c))
forall a b. (a, b) -> b
snd ((a, Event (col (SF m b c) -> col (SF m b c)))
 -> Event (col (SF m b c) -> col (SF m b c)))
-> (((a, Event (col (SF m b c) -> col (SF m b c))), col c)
    -> (a, Event (col (SF m b c) -> col (SF m b c))))
-> ((a, Event (col (SF m b c) -> col (SF m b c))), col c)
-> Event (col (SF m b c) -> col (SF m b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Event (col (SF m b c) -> col (SF m b c))), col c)
-> (a, Event (col (SF m b c) -> col (SF m b c)))
forall a b. (a, b) -> a
fst)) ((col (SF m b c)
  -> (col (SF m b c) -> col (SF m b c))
  -> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c))
 -> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c))
-> (col (SF m b c)
    -> (col (SF m b c) -> col (SF m b c))
    -> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c))
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
forall a b. (a -> b) -> a -> b
$ \col (SF m b c)
sfs' col (SF m b c) -> col (SF m b c)
f ->
    (a, Event (col (SF m b c) -> col (SF m b c)))
-> (a, Event (col (SF m b c) -> col (SF m b c)))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (col (SF m b c) -> col (SF m b c)))
 -> (a, Event (col (SF m b c) -> col (SF m b c))))
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
forall (m :: * -> *) a b.
Monad m =>
(a -> a) -> SF m a b -> SF m a b
>=- (forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, Event (col (SF m b c) -> col (SF m b c))) (col c)
drpSwitch a -> col sf -> col (b, sf)
forall sf. a -> col sf -> col (b, sf)
rf (col (SF m b c) -> col (SF m b c)
f col (SF m 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 :: (Functor m, Monad m) => [SF m a b] -> SF m [a] [b]
parZ :: forall (m :: * -> *) a b.
(Functor m, Monad m) =>
[SF m a b] -> SF m [a] [b]
parZ = (forall sf. [a] -> [sf] -> [(a, sf)]) -> [SF m a b] -> SF m [a] [b]
forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c) -> SF m 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 :: (Functor m, Monad m)
         => [SF m a b]
         -> SF m ([a], [b]) (Event c)
         -> ([SF m a b] -> c -> SF m [a] [b])
         -> SF m [a] [b]
pSwitchZ :: forall (m :: * -> *) a b c.
(Functor m, Monad m) =>
[SF m a b]
-> SF m ([a], [b]) (Event c)
-> ([SF m a b] -> c -> SF m [a] [b])
-> SF m [a] [b]
pSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF m a b]
-> SF m ([a], [b]) (Event c)
-> ([SF m a b] -> c -> SF m [a] [b])
-> SF m [a] [b]
forall (m :: * -> *) (col :: * -> *) a b c d.
(Functor m, Monad m, Traversable col, Functor col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, col c) (Event d)
-> (col (SF m b c) -> d -> SF m a (col c))
-> SF m 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 :: (Functor m, Monad m)
          => [SF m a b]
          -> SF m ([a], [b]) (Event c)
          -> ([SF m a b] -> c -> SF m [a] [b])
          -> SF m [a] [b]
dpSwitchZ :: forall (m :: * -> *) a b c.
(Functor m, Monad m) =>
[SF m a b]
-> SF m ([a], [b]) (Event c)
-> ([SF m a b] -> c -> SF m [a] [b])
-> SF m [a] [b]
dpSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF m a b]
-> SF m ([a], [b]) (Event c)
-> ([SF m a b] -> c -> SF m [a] [b])
-> SF m [a] [b]
forall (m :: * -> *) (col :: * -> *) a b c d.
(Monad m, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, col c) (Event d)
-> (col (SF m b c) -> d -> SF m a (col c))
-> SF m 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 :: (Functor m, Monad m)
          => [SF m a b] -> SF m ([a], Event ([SF m a b] -> [SF m a b])) [b]
rpSwitchZ :: forall (m :: * -> *) a b.
(Functor m, Monad m) =>
[SF m a b] -> SF m ([a], Event ([SF m a b] -> [SF m a b])) [b]
rpSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF m a b] -> SF m ([a], Event ([SF m a b] -> [SF m a b])) [b]
forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, Event (col (SF m b c) -> col (SF m 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 :: (Functor m, Monad m)
           => [SF m a b] -> SF m ([a], Event ([SF m a b] -> [SF m a b])) [b]
drpSwitchZ :: forall (m :: * -> *) a b.
(Functor m, Monad m) =>
[SF m a b] -> SF m ([a], Event ([SF m a b] -> [SF m a b])) [b]
drpSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF m a b] -> SF m ([a], Event ([SF m a b] -> [SF m a b])) [b]
forall (m :: * -> *) (col :: * -> *) a b c.
(Functor m, Monad m, Functor col, Traversable col) =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF m b c)
-> SF m (a, Event (col (SF m b c) -> col (SF m 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 -> [(a, b)]
forall a. HasCallStack => String -> a
error (String -> [(a, b)]) -> String -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ String
"FRP.BearRiver.Switches: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ 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 :: Monad m => SF m a b -> DTime -> SF m a b
freeze :: forall (m :: * -> *) a b. Monad m => SF m a b -> DTime -> SF m a b
freeze SF m a b
sf DTime
dt = (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ClockInfo m (b, SF m a b)) -> SF m a b)
-> (a -> ClockInfo m (b, SF m a b)) -> SF m a b
forall a b. (a -> b) -> a -> b
$ \a
a ->
  m (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall (m :: * -> *) a. Monad m => m a -> ReaderT DTime m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (b, SF m a b) -> ClockInfo m (b, SF m a b))
-> m (b, SF m a b) -> ClockInfo m (b, SF m a b)
forall a b. (a -> b) -> a -> b
$ ClockInfo m (b, SF m a b) -> DTime -> m (b, SF m a b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SF m a b -> a -> ClockInfo m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf a
a) DTime
dt

freezeCol :: (Monad m, Functor col)
          => col (SF m a b) -> DTime -> col (SF m a b)
freezeCol :: forall (m :: * -> *) (col :: * -> *) a b.
(Monad m, Functor col) =>
col (SF m a b) -> DTime -> col (SF m a b)
freezeCol col (SF m a b)
sfs DTime
dt = (SF m a b -> SF m a b) -> col (SF m a b) -> col (SF m 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 m a b -> DTime -> SF m a b
forall (m :: * -> *) a b. Monad m => SF m a b -> DTime -> SF m a b
`freeze` DTime
dt) col (SF m 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 :: Monad m => SF m a b -> SF m [a] [b]
parC :: forall (m :: * -> *) a b. Monad m => SF m a b -> SF m [a] [b]
parC = SF m a b -> SF m [a] [b]
forall (m :: * -> *) a b. Monad m => SF m a b -> SF m [a] [b]
parC0
  where
    parC0 :: Monad m => SF m a b -> SF m [a] [b]
    parC0 :: forall (m :: * -> *) a b. Monad m => SF m a b -> SF m [a] [b]
parC0 SF m a b
sf0 = ([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
-> MSF (ReaderT DTime m) [a] [b]
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF (([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
 -> MSF (ReaderT DTime m) [a] [b])
-> ([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
-> MSF (ReaderT DTime m) [a] [b]
forall a b. (a -> b) -> a -> b
$ \[a]
as -> do
      [(b, SF m a b)]
os <- ((a, SF m a b) -> ReaderT DTime m (b, SF m a b))
-> [(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
T.mapM (\(a
a, SF m a b
sf) -> SF m a b -> a -> ReaderT DTime m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf a
a) ([(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)])
-> [(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)]
forall a b. (a -> b) -> a -> b
$
              [a] -> [SF m a b] -> [(a, SF m a b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as (Int -> SF m a b -> [SF m a b]
forall a. Int -> a -> [a]
replicate ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as) SF m a b
sf0)

      let bs :: [b]
bs  = ((b, SF m a b) -> b) -> [(b, SF m a b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> b
forall a b. (a, b) -> a
fst [(b, SF m a b)]
os
          cts :: [SF m a b]
cts = ((b, SF m a b) -> SF m a b) -> [(b, SF m a b)] -> [SF m a b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> SF m a b
forall a b. (a, b) -> b
snd [(b, SF m a b)]
os
      ([b], MSF (ReaderT DTime m) [a] [b])
-> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b])
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([b]
bs, [SF m a b] -> MSF (ReaderT DTime m) [a] [b]
forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m [a] [b]
parC' [SF m a b]
cts)

    parC' :: Monad m => [SF m a b] -> SF m [a] [b]
    parC' :: forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m [a] [b]
parC' [SF m a b]
sfs = ([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
-> MSF (ReaderT DTime m) [a] [b]
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF (([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
 -> MSF (ReaderT DTime m) [a] [b])
-> ([a] -> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b]))
-> MSF (ReaderT DTime m) [a] [b]
forall a b. (a -> b) -> a -> b
$ \[a]
as -> do
      [(b, SF m a b)]
os <- ((a, SF m a b) -> ReaderT DTime m (b, SF m a b))
-> [(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
T.mapM (\(a
a, SF m a b
sf) -> SF m a b -> a -> ReaderT DTime m (b, SF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf a
a) ([(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)])
-> [(a, SF m a b)] -> ReaderT DTime m [(b, SF m a b)]
forall a b. (a -> b) -> a -> b
$ [a] -> [SF m a b] -> [(a, SF m a b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [SF m a b]
sfs
      let bs :: [b]
bs  = ((b, SF m a b) -> b) -> [(b, SF m a b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> b
forall a b. (a, b) -> a
fst [(b, SF m a b)]
os
          cts :: [SF m a b]
cts = ((b, SF m a b) -> SF m a b) -> [(b, SF m a b)] -> [SF m a b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, SF m a b) -> SF m a b
forall a b. (a, b) -> b
snd [(b, SF m a b)]
os
      ([b], MSF (ReaderT DTime m) [a] [b])
-> ClockInfo m ([b], MSF (ReaderT DTime m) [a] [b])
forall a. a -> ReaderT DTime m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([b]
bs, [SF m a b] -> MSF (ReaderT DTime m) [a] [b]
forall (m :: * -> *) a b. Monad m => [SF m a b] -> SF m [a] [b]
parC' [SF m a b]
cts)