-- |
-- Module      : FRP.Yampa
-- 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)
--
-- Apply SFs only under certain conditions.
module FRP.BearRiver.Conditional
    (
      -- * Guards and automata-oriented combinators
      provided

      -- * Variable pause
    , pause
    )
  where

-- External imports
import Control.Arrow ((&&&), (^>>))

import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))

-- Internal imports
import FRP.BearRiver.Basic        (constant)
import FRP.BearRiver.EventS       (edge, snap)
import FRP.BearRiver.InternalCore (SF (..))
import FRP.BearRiver.Switches     (switch)

-- * Guards and automata-oriented combinators

-- | Runs a signal function only when a given predicate is satisfied, otherwise
-- runs the other signal function.
--
-- This is similar to 'ArrowChoice', except that this resets the SFs after each
-- transition.
--
-- For example, the following integrates the incoming input numbers, using one
-- integral if the numbers are even, and another if the input numbers are odd.
-- Note how, every time we "switch", the old value of the integral is discarded.
--
-- >>> embed (provided (even . round) integral integral) (deltaEncode 1 [1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2 :: Double])
-- [0.0,1.0,2.0,0.0,2.0,4.0,0.0,1.0,2.0,0.0,2.0,4.0]
provided :: Monad m => (a -> Bool) -> SF m a b -> SF m a b -> SF m a b
provided :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> SF m a b -> SF m a b -> SF m a b
provided a -> Bool
p SF m a b
sft SF m a b
sff =
    SF m a (b, Event a) -> (a -> 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 (b -> SF m a b
forall (m :: * -> *) b a. Monad m => b -> SF m a b
constant b
forall a. HasCallStack => a
undefined SF m a b -> MSF (ClockInfo m) a (Event a) -> SF m a (b, Event a)
forall b c c'.
MSF (ClockInfo m) b c
-> MSF (ClockInfo m) b c' -> MSF (ClockInfo m) b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& MSF (ClockInfo m) a (Event a)
forall (m :: * -> *) a. Monad m => SF m a (Event a)
snap) ((a -> SF m a b) -> SF m a b) -> (a -> SF m a b) -> SF m a b
forall a b. (a -> b) -> a -> b
$ \a
a0 ->
      if a -> Bool
p a
a0 then SF m a b
stt else SF m a b
stf
  where
    stt :: SF m a b
stt = SF m a (b, Event ()) -> (() -> 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
sft SF m a b -> MSF (ClockInfo m) a (Event ()) -> SF m a (b, Event ())
forall b c c'.
MSF (ClockInfo m) b c
-> MSF (ClockInfo m) b c' -> MSF (ClockInfo m) b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p (a -> Bool)
-> MSF (ClockInfo m) Bool (Event ())
-> MSF (ClockInfo m) a (Event ())
forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> MSF (ClockInfo m) Bool (Event ())
forall (m :: * -> *). Monad m => SF m Bool (Event ())
edge)) (SF m a b -> () -> SF m a b
forall a b. a -> b -> a
const SF m a b
stf)
    stf :: SF m a b
stf = SF m a (b, Event ()) -> (() -> 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
sff SF m a b -> MSF (ClockInfo m) a (Event ()) -> SF m a (b, Event ())
forall b c c'.
MSF (ClockInfo m) b c
-> MSF (ClockInfo m) b c' -> MSF (ClockInfo m) b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (a -> Bool
p (a -> Bool)
-> MSF (ClockInfo m) Bool (Event ())
-> MSF (ClockInfo m) a (Event ())
forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> MSF (ClockInfo m) Bool (Event ())
forall (m :: * -> *). Monad m => SF m Bool (Event ())
edge)) (SF m a b -> () -> SF m a b
forall a b. a -> b -> a
const SF m a b
stt)

-- * Variable pause

-- | Given a value in an accumulator (b), a predicate signal function (sfC),
-- and a second signal function (sf), pause will produce the accumulator b if
-- sfC input is True, and will transform the signal using sf otherwise. It acts
-- as a pause with an accumulator for the moments when the transformation is
-- paused.
pause :: Monad m => b -> SF m a Bool -> SF m a b -> SF m a b
pause :: forall (m :: * -> *) b a.
Monad m =>
b -> SF m a Bool -> SF m a b -> SF m a b
pause b
b SF m a Bool
sfC SF m a b
sf = (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
a0 -> do
   (Bool
p, SF m a Bool
sfC') <- SF m a Bool -> a -> ReaderT DTime m (Bool, SF m a Bool)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a Bool
sfC a
a0
   case Bool
p of
     Bool
True  -> (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, b -> SF m a Bool -> SF m a b -> SF m a b
forall (m :: * -> *) b a.
Monad m =>
b -> SF m a Bool -> SF m a b -> SF m a b
pause b
b SF m a Bool
sfC' SF m a b
sf)
     Bool
False -> do (b
b', SF m a b
sf') <- 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
a0
                 (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', b -> SF m a Bool -> SF m a b -> SF m a b
forall (m :: * -> *) b a.
Monad m =>
b -> SF m a Bool -> SF m a b -> SF m a b
pause b
b' SF m a Bool
sfC' SF m a b
sf')