module FRP.BearRiver.Conditional
(
provided
, pause
)
where
import Control.Arrow ((&&&), (^>>))
import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))
import FRP.BearRiver.Basic (constant)
import FRP.BearRiver.EventS (edge, snap)
import FRP.BearRiver.InternalCore (SF (..))
import FRP.BearRiver.Switches (switch)
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 =
forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
switch (forall (m :: * -> *) b a. Monad m => b -> SF m a b
constant forall a. HasCallStack => a
undefined forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (m :: * -> *) a. Monad m => SF m a (Event a)
snap) 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 = 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 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> forall (m :: * -> *). Monad m => SF m Bool (Event ())
edge)) (forall a b. a -> b -> a
const SF m a b
stf)
stf :: SF m a b
stf = 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 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (a -> Bool
p forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> forall (m :: * -> *). Monad m => SF m Bool (Event ())
edge)) (forall a b. a -> b -> a
const SF m a b
stt)
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 = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall a b. (a -> b) -> a -> b
$ \a
a0 -> do
(Bool
p, SF m a Bool
sfC') <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (b
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') <- forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF SF m a b
sf a
a0
forall (m :: * -> *) a. Monad m => a -> m a
return (b
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')