module FRP.Yampa.Conditional
( provided
, pause
)
where
import Control.Arrow
import FRP.Yampa.Basic
import FRP.Yampa.EventS
import FRP.Yampa.InternalCore (SF (..), SF' (..), Transition, sfTF')
import FRP.Yampa.Switches
provided :: (a -> Bool) -> SF a b -> SF a b -> SF a b
provided :: forall a b. (a -> Bool) -> SF a b -> SF a b -> SF a b
provided a -> Bool
p SF a b
sft SF a b
sff =
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (forall b a. b -> SF 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 a. SF a (Event a)
snap) forall a b. (a -> b) -> a -> b
$ \a
a0 ->
if a -> Bool
p a
a0 then SF a b
stt else SF a b
stf
where
stt :: SF a b
stt = forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (SF 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
^>> SF Bool (Event ())
edge)) (forall a b. a -> b -> a
const SF a b
stf)
stf :: SF a b
stf = forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (SF 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
^>> SF Bool (Event ())
edge)) (forall a b. a -> b -> a
const SF a b
stt)
pause :: b -> SF a Bool -> SF a b -> SF a b
pause :: forall b a. b -> SF a Bool -> SF a b -> SF a b
pause b
b_init (SF { sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a Bool
tfP}) (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf10}) = 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 Bool
tfP a
a0 of
(SF' a Bool
c, Bool
True) -> (forall b a. b -> (a -> Transition a b) -> SF' a Bool -> SF' a b
pauseInit b
b_init a -> Transition a b
tf10 SF' a Bool
c, b
b_init)
(SF' a Bool
c, Bool
False) -> let (SF' a b
k, b
b0) = a -> Transition a b
tf10 a
a0
in (forall b a. b -> SF' a b -> SF' a Bool -> SF' a b
pause' b
b0 SF' a b
k SF' a Bool
c, b
b0)
pauseInit :: b -> (a -> Transition a b) -> SF' a Bool -> SF' a b
pauseInit :: forall b a. b -> (a -> Transition a b) -> SF' a Bool -> SF' a b
pauseInit b
b_init' a -> Transition a b
tf10' SF' a Bool
c = forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf0'
where tf0' :: DTime -> a -> Transition a b
tf0' DTime
dt a
a =
case (forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a Bool
c) DTime
dt a
a of
(SF' a Bool
c', Bool
True) -> (forall b a. b -> (a -> Transition a b) -> SF' a Bool -> SF' a b
pauseInit b
b_init' a -> Transition a b
tf10' SF' a Bool
c', b
b_init')
(SF' a Bool
c', Bool
False) -> let (SF' a b
k, b
b0) = a -> Transition a b
tf10' a
a
in (forall b a. b -> SF' a b -> SF' a Bool -> SF' a b
pause' b
b0 SF' a b
k SF' a Bool
c', b
b0)
pause' :: b -> SF' a b -> SF' a Bool -> SF' a b
pause' :: forall b a. b -> SF' a b -> SF' a Bool -> SF' a b
pause' b
b_init' SF' a b
tf10' SF' a Bool
tfP' = forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> (SF' a b, b)
tf0'
where tf0' :: DTime -> a -> (SF' a b, b)
tf0' DTime
dt a
a =
case (forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a Bool
tfP') DTime
dt a
a of
(SF' a Bool
tfP'', Bool
True) -> (forall b a. b -> SF' a b -> SF' a Bool -> SF' a b
pause' b
b_init' SF' a b
tf10' SF' a Bool
tfP'', b
b_init')
(SF' a Bool
tfP'', Bool
False) -> let (SF' a b
tf10'', b
b0') = (forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
tf10') DTime
dt a
a
in (forall b a. b -> SF' a b -> SF' a Bool -> SF' a b
pause' b
b0' SF' a b
tf10'' SF' a Bool
tfP'', b
b0')