{-# LANGUAGE CPP #-}
-- 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.
module FRP.BearRiver.Switches
    (
      -- * Basic switching
      switch,  dSwitch

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

      -- * Parallel composition\/switching (lists)


      -- ** With replication
    , parC
    )
  where

-- External imports
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative (..), (<$>))
#endif
import Data.Traversable as T

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

-- Internal imports
import FRP.BearRiver.Event        (Event (..))
import FRP.BearRiver.InternalCore (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)

-- * Parallel composition and switching

-- ** Parallel composition and switching over collections with broadcasting

#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

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

-- ** Parallel composition over collections

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