module FRP.BearRiver.Delays
(
pre
, iPre
, fby
, delay
)
where
import Control.Arrow ((>>>))
import Control.Monad.Trans.MSF (ask)
import Data.MonadicStreamFunction.InternalCore (MSF (..))
import FRP.BearRiver.Basic (identity, (-->))
import FRP.BearRiver.InternalCore (SF (..), Time)
import FRP.BearRiver.Scan (sscanPrim)
infixr 0 `fby`
pre :: Monad m => SF m a a
pre :: forall (m :: * -> *) a. Monad m => SF m a a
pre = forall (m :: * -> *) c a b.
Monad m =>
(c -> a -> Maybe (c, b)) -> c -> b -> SF m a b
sscanPrim forall {b} {a}. b -> a -> Maybe (a, b)
f forall {a}. a
uninit forall {a}. a
uninit
where
f :: b -> a -> Maybe (a, b)
f b
c a
a = forall a. a -> Maybe a
Just (a
a, b
c)
uninit :: a
uninit = forall a. HasCallStack => [Char] -> a
error [Char]
"bearriver: pre: Uninitialized pre operator."
iPre :: Monad m => a -> SF m a a
iPre :: forall (m :: * -> *) a. Monad m => a -> SF m a a
iPre = (forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
--> forall (m :: * -> *) a. Monad m => SF m a a
pre)
fby :: Monad m => b -> SF m a b -> SF m a b
b
b0 fby :: forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
`fby` SF m a b
sf = b
b0 forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
--> SF m a b
sf forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: * -> *) a. Monad m => SF m a a
pre
delay :: Monad m => Time -> a -> SF m a a
delay :: forall (m :: * -> *) a. Monad m => Time -> a -> SF m a a
delay Time
q a
aInit | Time
q forall a. Ord a => a -> a -> Bool
< Time
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"bearriver: delay: Negative delay."
| Time
q forall a. Eq a => a -> a -> Bool
== Time
0 = forall (m :: * -> *) a. Monad m => SF m a a
identity
| Bool
otherwise = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall {m :: * -> *} {m :: * -> *}.
(Monad m, Monad m) =>
a -> m (a, MSF (ReaderT Time m) a a)
tf0
where
tf0 :: a -> m (a, MSF (ReaderT Time m) a a)
tf0 a
a0 = forall (m :: * -> *) a. Monad m => a -> m a
return (a
aInit, forall {m :: * -> *} {t} {b}.
(Monad m, Ord t, Num t) =>
[(t, b)] -> [(t, b)] -> t -> b -> MSF (ReaderT t m) b b
delayAux [] [(Time
q, a
a0)] Time
0 a
aInit)
delayAux :: [(t, b)] -> [(t, b)] -> t -> b -> MSF (ReaderT t m) b b
delayAux [(t, b)]
_ [] t
_ b
_ = forall a. HasCallStack => a
undefined
delayAux [(t, b)]
rbuf buf :: [(t, b)]
buf@((t
bdt, b
ba) : [(t, b)]
buf') t
tDiff b
aPrev = forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF forall {m :: * -> *}.
Monad m =>
b -> ReaderT t m (b, MSF (ReaderT t m) b b)
tf
where
tf :: b -> ReaderT t m (b, MSF (ReaderT t m) b b)
tf b
a = do
t
dt <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let tDiff' :: t
tDiff' = t
tDiff forall a. Num a => a -> a -> a
+ t
dt
rbuf' :: [(t, b)]
rbuf' = (t
dt, b
a) forall a. a -> [a] -> [a]
: [(t, b)]
rbuf
if (t
tDiff' forall a. Ord a => a -> a -> Bool
< t
bdt)
then forall (m :: * -> *) a. Monad m => a -> m a
return (b
aPrev, [(t, b)] -> [(t, b)] -> t -> b -> MSF (ReaderT t m) b b
delayAux [(t, b)]
rbuf' [(t, b)]
buf t
tDiff' b
aPrev)
else forall {m :: * -> *}.
Monad m =>
[(t, b)] -> [(t, b)] -> t -> b -> m (b, MSF (ReaderT t m) b b)
nextSmpl [(t, b)]
rbuf' [(t, b)]
buf' (t
tDiff' forall a. Num a => a -> a -> a
- t
bdt) b
ba
where
nextSmpl :: [(t, b)] -> [(t, b)] -> t -> b -> m (b, MSF (ReaderT t m) b b)
nextSmpl [(t, b)]
rbuf [] t
tDiff b
a =
[(t, b)] -> [(t, b)] -> t -> b -> m (b, MSF (ReaderT t m) b b)
nextSmpl [] (forall a. [a] -> [a]
reverse [(t, b)]
rbuf) t
tDiff b
a
nextSmpl [(t, b)]
rbuf buf :: [(t, b)]
buf@((t
bdt, b
ba) : [(t, b)]
buf') t
tDiff b
a
| t
tDiff forall a. Ord a => a -> a -> Bool
< t
bdt = forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, [(t, b)] -> [(t, b)] -> t -> b -> MSF (ReaderT t m) b b
delayAux [(t, b)]
rbuf [(t, b)]
buf t
tDiff b
a)
| Bool
otherwise = [(t, b)] -> [(t, b)] -> t -> b -> m (b, MSF (ReaderT t m) b b)
nextSmpl [(t, b)]
rbuf [(t, b)]
buf' (t
tDiff forall a. Num a => a -> a -> a
- t
bdt) b
ba