module FRP.BearRiver.EventS
(
never
, now
, after
, repeatedly
, afterEach
, afterEachCat
, delayEvent
, delayEventCat
, edge
, iEdge
, edgeTag
, edgeJust
, edgeBy
, notYet
, once
, takeEvents
, dropEvents
, snap
, snapAfter
, sample
, sampleWindow
, recur
, andThen
)
where
import Control.Arrow (arr, (&&&), (>>>), (>>^))
import Control.Monad.Trans.MSF (ask)
import Data.MonadicStreamFunction (feedback)
import Data.MonadicStreamFunction.InternalCore (MSF (MSF))
import FRP.BearRiver.Arrow (dup)
import FRP.BearRiver.Basic (constant, identity, (-->), (>--))
import FRP.BearRiver.Event (Event (..), maybeToEvent, tag)
import FRP.BearRiver.Hybrid (accumBy)
import FRP.BearRiver.InternalCore (SF, Time)
import FRP.BearRiver.Switches (dSwitch, switch)
never :: Monad m => SF m a (Event b)
never :: forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never = Event b -> SF m a (Event b)
forall (m :: * -> *) b a. Monad m => b -> SF m a b
constant Event b
forall a. Event a
NoEvent
now :: Monad m => b -> SF m a (Event b)
now :: forall (m :: * -> *) b a. Monad m => b -> SF m a (Event b)
now b
b0 = b -> Event b
forall a. a -> Event a
Event b
b0 Event b -> SF m a (Event b) -> SF m a (Event b)
forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
--> SF m a (Event b)
forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never
after :: Monad m
=> Time
-> b
-> SF m a (Event b)
after :: forall (m :: * -> *) b a. Monad m => Time -> b -> SF m a (Event b)
after Time
q b
x = Time
-> MSF (ClockInfo m) (a, Time) (Event b, Time)
-> MSF (ClockInfo m) a (Event b)
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback Time
q MSF (ClockInfo m) (a, Time) (Event b, Time)
forall {a}. MSF (ClockInfo m) (a, Time) (Event b, Time)
go
where
go :: MSF (ClockInfo m) (a, Time) (Event b, Time)
go = ((a, Time)
-> ReaderT
Time
m
((Event b, Time), MSF (ClockInfo m) (a, Time) (Event b, Time)))
-> MSF (ClockInfo m) (a, Time) (Event b, Time)
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF (((a, Time)
-> ReaderT
Time
m
((Event b, Time), MSF (ClockInfo m) (a, Time) (Event b, Time)))
-> MSF (ClockInfo m) (a, Time) (Event b, Time))
-> ((a, Time)
-> ReaderT
Time
m
((Event b, Time), MSF (ClockInfo m) (a, Time) (Event b, Time)))
-> MSF (ClockInfo m) (a, Time) (Event b, Time)
forall a b. (a -> b) -> a -> b
$ \(a
_, Time
t) -> do
Time
dt <- ReaderT Time m Time
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let t' :: Time
t' = Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
dt
e :: Event b
e = if Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
0 Bool -> Bool -> Bool
&& Time
t' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 then b -> Event b
forall a. a -> Event a
Event b
x else Event b
forall a. Event a
NoEvent
ct :: MSF (ClockInfo m) (a, Time) (Event b, Time)
ct = if Time
t' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 then (Event b, Time) -> MSF (ClockInfo m) (a, Time) (Event b, Time)
forall (m :: * -> *) b a. Monad m => b -> SF m a b
constant (Event b
forall a. Event a
NoEvent, Time
t') else MSF (ClockInfo m) (a, Time) (Event b, Time)
go
((Event b, Time), MSF (ClockInfo m) (a, Time) (Event b, Time))
-> ReaderT
Time
m
((Event b, Time), MSF (ClockInfo m) (a, Time) (Event b, Time))
forall a. a -> ReaderT Time m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Event b
e, Time
t'), MSF (ClockInfo m) (a, Time) (Event b, Time)
ct)
repeatedly :: Monad m => Time -> b -> SF m a (Event b)
repeatedly :: forall (m :: * -> *) b a. Monad m => Time -> b -> SF m a (Event b)
repeatedly Time
q b
x
| Time
q Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
0 = [(Time, b)] -> SF m a (Event b)
forall (m :: * -> *) b a.
Monad m =>
[(Time, b)] -> SF m a (Event b)
afterEach [(Time, b)]
qxs
| Bool
otherwise = [Char] -> SF m a (Event b)
forall a. HasCallStack => [Char] -> a
error [Char]
"bearriver: repeatedly: Non-positive period."
where
qxs :: [(Time, b)]
qxs = (Time
q, b
x)(Time, b) -> [(Time, b)] -> [(Time, b)]
forall a. a -> [a] -> [a]
:[(Time, b)]
qxs
afterEach :: Monad m => [(Time, b)] -> SF m a (Event b)
afterEach :: forall (m :: * -> *) b a.
Monad m =>
[(Time, b)] -> SF m a (Event b)
afterEach [(Time, b)]
qxs = [(Time, b)] -> SF m a (Event [b])
forall (m :: * -> *) b a.
Monad m =>
[(Time, b)] -> SF m a (Event [b])
afterEachCat [(Time, b)]
qxs SF m a (Event [b])
-> MSF (ClockInfo m) (Event [b]) (Event b)
-> MSF (ClockInfo m) a (Event b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Event [b] -> Event b) -> MSF (ClockInfo m) (Event [b]) (Event b)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (([b] -> b) -> Event [b] -> Event b
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> b
forall a. HasCallStack => [a] -> a
head)
afterEachCat :: Monad m => [(Time, b)] -> SF m a (Event [b])
afterEachCat :: forall (m :: * -> *) b a.
Monad m =>
[(Time, b)] -> SF m a (Event [b])
afterEachCat = Time -> [(Time, b)] -> SF m a (Event [b])
forall (m :: * -> *) b a.
Monad m =>
Time -> [(Time, b)] -> SF m a (Event [b])
afterEachCat' Time
0
where
afterEachCat' :: Monad m => Time -> [(Time, b)] -> SF m a (Event [b])
afterEachCat' :: forall (m :: * -> *) b a.
Monad m =>
Time -> [(Time, b)] -> SF m a (Event [b])
afterEachCat' Time
_ [] = SF m a (Event [b])
forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never
afterEachCat' Time
t [(Time, b)]
qxs = (a -> ClockInfo m (Event [b], SF m a (Event [b])))
-> SF m a (Event [b])
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ClockInfo m (Event [b], SF m a (Event [b])))
-> SF m a (Event [b]))
-> (a -> ClockInfo m (Event [b], SF m a (Event [b])))
-> SF m a (Event [b])
forall a b. (a -> b) -> a -> b
$ \a
_ -> do
Time
dt <- ReaderT Time m Time
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let ([b]
ev, Time
t', [(Time, b)]
qxs') = [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])
forall b. [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])
fireEvents [] (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dt) [(Time, b)]
qxs
ev' :: Event [b]
ev' = if [b] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
ev
then Event [b]
forall a. Event a
NoEvent
else [b] -> Event [b]
forall a. a -> Event a
Event ([b] -> [b]
forall a. [a] -> [a]
reverse [b]
ev)
(Event [b], SF m a (Event [b]))
-> ClockInfo m (Event [b], SF m a (Event [b]))
forall a. a -> ReaderT Time m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event [b]
ev', Time -> [(Time, b)] -> SF m a (Event [b])
forall (m :: * -> *) b a.
Monad m =>
Time -> [(Time, b)] -> SF m a (Event [b])
afterEachCat' Time
t' [(Time, b)]
qxs')
fireEvents :: [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])
fireEvents :: forall b. [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])
fireEvents [b]
ev Time
t [] = ([b]
ev, Time
t, [])
fireEvents [b]
ev Time
t ((Time, b)
qx:[(Time, b)]
qxs)
| (Time, b) -> Time
forall a b. (a, b) -> a
fst (Time, b)
qx Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 = [Char] -> ([b], Time, [(Time, b)])
forall a. HasCallStack => [Char] -> a
error [Char]
"bearriver: afterEachCat: Non-positive period."
| Time
overdue Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
0 = [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])
forall b. [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])
fireEvents ((Time, b) -> b
forall a b. (a, b) -> b
snd (Time, b)
qxb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
ev) Time
overdue [(Time, b)]
qxs
| Bool
otherwise = ([b]
ev, Time
t, (Time, b)
qx(Time, b) -> [(Time, b)] -> [(Time, b)]
forall a. a -> [a] -> [a]
:[(Time, b)]
qxs)
where
overdue :: Time
overdue = Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- (Time, b) -> Time
forall a b. (a, b) -> a
fst (Time, b)
qx
delayEvent :: Monad m => Time -> SF m (Event a) (Event a)
delayEvent :: forall (m :: * -> *) a. Monad m => Time -> SF m (Event a) (Event a)
delayEvent Time
q | Time
q Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 = [Char] -> SF m (Event a) (Event a)
forall a. HasCallStack => [Char] -> a
error [Char]
"bearriver: delayEvent: Negative delay."
| Time
q Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
0 = SF m (Event a) (Event a)
forall (m :: * -> *) a. Monad m => SF m a a
identity
| Bool
otherwise = Time -> SF m (Event a) (Event [a])
forall (m :: * -> *) a.
Monad m =>
Time -> SF m (Event a) (Event [a])
delayEventCat Time
q SF m (Event a) (Event [a])
-> MSF (ClockInfo m) (Event [a]) (Event a)
-> SF m (Event a) (Event a)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Event [a] -> Event a) -> MSF (ClockInfo m) (Event [a]) (Event a)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (([a] -> a) -> Event [a] -> Event a
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. HasCallStack => [a] -> a
head)
delayEventCat :: Monad m => Time -> SF m (Event a) (Event [a])
delayEventCat :: forall (m :: * -> *) a.
Monad m =>
Time -> SF m (Event a) (Event [a])
delayEventCat Time
q | Time
q Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 = [Char] -> SF m (Event a) (Event [a])
forall a. HasCallStack => [Char] -> a
error [Char]
"bearriver: delayEventCat: Negative delay."
| Time
q Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
0 = (Event a -> Event [a]) -> SF m (Event a) (Event [a])
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((a -> [a]) -> Event a -> Event [a]
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]))
| Bool
otherwise = (Event a -> ClockInfo m (Event [a], SF m (Event a) (Event [a])))
-> SF m (Event a) (Event [a])
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF Event a -> ClockInfo m (Event [a], SF m (Event a) (Event [a]))
forall {m :: * -> *} {a}.
Monad m =>
Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
noPendingEvent
where
noPendingEvent :: Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
noPendingEvent Event a
e
= (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
forall a. a -> ReaderT Time m a
forall (m :: * -> *) a. Monad m => a -> m a
return
( Event [a]
forall a. Event a
NoEvent
, case Event a
e of
Event a
NoEvent -> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a]))
-> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall a b. (a -> b) -> a -> b
$ Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
noPendingEvent
Event a
x -> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF (Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
pendingEvents (-Time
q) [] [] (-Time
q) a
x)
)
pendingEvents :: Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
pendingEvents Time
tLast [(Time, a)]
rqxs [(Time, a)]
qxs Time
tNext a
x = Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
forall {m :: * -> *}.
Monad m =>
Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
tf
where
tf :: Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
tf Event a
e = do Time
dt <- ReaderT Time m Time
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
(Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
forall a. a -> ReaderT Time m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Time
-> Event a
-> (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
tf' Time
dt Event a
e)
tf' :: Time
-> Event a
-> (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
tf' Time
dt Event a
e
| Time
tNext' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
0
= Event a
-> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> [a]
-> (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
emitEventsScheduleNext Event a
e Time
tLast' [(Time, a)]
rqxs [(Time, a)]
qxs Time
tNext' [a
x]
| Bool
otherwise
= (Event [a]
forall a. Event a
NoEvent, (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF (Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
pendingEvents Time
tLast'' [(Time, a)]
rqxs' [(Time, a)]
qxs Time
tNext' a
x))
where
tNext' :: Time
tNext' = Time
tNext Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dt
tLast' :: Time
tLast' = Time
tLast Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dt
(Time
tLast'', [(Time, a)]
rqxs') =
case Event a
e of
Event a
NoEvent -> (Time
tLast', [(Time, a)]
rqxs)
Event a
x' -> (-Time
q, (Time
tLast' Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
q, a
x') (Time, a) -> [(Time, a)] -> [(Time, a)]
forall a. a -> [a] -> [a]
: [(Time, a)]
rqxs)
emitEventsScheduleNext :: Event a
-> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> [a]
-> (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
emitEventsScheduleNext Event a
e Time
_ [] [] Time
_ [a]
rxs =
( [a] -> Event [a]
forall a. a -> Event a
Event ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rxs)
, case Event a
e of
Event a
NoEvent -> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a]))
-> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall a b. (a -> b) -> a -> b
$ Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
noPendingEvent
Event a
x -> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a]))
-> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall a b. (a -> b) -> a -> b
$ Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
pendingEvents (-Time
q) [] [] (-Time
q) a
x
)
emitEventsScheduleNext Event a
e Time
tLast [(Time, a)]
rqxs [] Time
tNext [a]
rxs =
Event a
-> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> [a]
-> (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
emitEventsScheduleNext Event a
e Time
tLast [] ([(Time, a)] -> [(Time, a)]
forall a. [a] -> [a]
reverse [(Time, a)]
rqxs) Time
tNext [a]
rxs
emitEventsScheduleNext Event a
e Time
tLast [(Time, a)]
rqxs ((Time
q', a
x') : [(Time, a)]
qxs') Time
tNext [a]
rxs
| Time
q' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
tNext = ( [a] -> Event [a]
forall a. a -> Event a
Event ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rxs)
, case Event a
e of
Event a
NoEvent -> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a]))
-> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall a b. (a -> b) -> a -> b
$
Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
pendingEvents Time
tLast
[(Time, a)]
rqxs
[(Time, a)]
qxs'
(Time
tNext Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
q')
a
x'
Event a
x'' -> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a]))
-> (Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a])))
-> MSF (ReaderT Time m) (Event a) (Event [a])
forall a b. (a -> b) -> a -> b
$
Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> Event a
-> ReaderT
Time m (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
pendingEvents (-Time
q)
((Time
tLast Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
q, a
x'') (Time, a) -> [(Time, a)] -> [(Time, a)]
forall a. a -> [a] -> [a]
: [(Time, a)]
rqxs)
[(Time, a)]
qxs'
(Time
tNext Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
q')
a
x'
)
| Bool
otherwise = Event a
-> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> [a]
-> (Event [a], MSF (ReaderT Time m) (Event a) (Event [a]))
emitEventsScheduleNext Event a
e
Time
tLast
[(Time, a)]
rqxs
[(Time, a)]
qxs'
(Time
tNext Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
q')
(a
x' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rxs)
edge :: Monad m => SF m Bool (Event ())
edge :: forall (m :: * -> *). Monad m => SF m Bool (Event ())
edge = Bool -> SF m Bool (Event ())
forall (m :: * -> *). Monad m => Bool -> SF m Bool (Event ())
edgeFrom Bool
True
iEdge :: Monad m => Bool -> SF m Bool (Event ())
iEdge :: forall (m :: * -> *). Monad m => Bool -> SF m Bool (Event ())
iEdge = Bool -> SF m Bool (Event ())
forall (m :: * -> *). Monad m => Bool -> SF m Bool (Event ())
edgeFrom
edgeFrom :: Monad m => Bool -> SF m Bool (Event())
edgeFrom :: forall (m :: * -> *). Monad m => Bool -> SF m Bool (Event ())
edgeFrom Bool
prev = (Bool
-> ClockInfo m (Event (), MSF (ReaderT Time m) Bool (Event ())))
-> MSF (ReaderT Time m) Bool (Event ())
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((Bool
-> ClockInfo m (Event (), MSF (ReaderT Time m) Bool (Event ())))
-> MSF (ReaderT Time m) Bool (Event ()))
-> (Bool
-> ClockInfo m (Event (), MSF (ReaderT Time m) Bool (Event ())))
-> MSF (ReaderT Time m) Bool (Event ())
forall a b. (a -> b) -> a -> b
$ \Bool
a -> do
let res :: Event ()
res | Bool
prev = Event ()
forall a. Event a
NoEvent
| Bool
a = () -> Event ()
forall a. a -> Event a
Event ()
| Bool
otherwise = Event ()
forall a. Event a
NoEvent
ct :: MSF (ReaderT Time m) Bool (Event ())
ct = Bool -> MSF (ReaderT Time m) Bool (Event ())
forall (m :: * -> *). Monad m => Bool -> SF m Bool (Event ())
edgeFrom Bool
a
(Event (), MSF (ReaderT Time m) Bool (Event ()))
-> ClockInfo m (Event (), MSF (ReaderT Time m) Bool (Event ()))
forall a. a -> ReaderT Time m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event ()
res, MSF (ReaderT Time m) Bool (Event ())
ct)
edgeTag :: Monad m => a -> SF m Bool (Event a)
edgeTag :: forall (m :: * -> *) a. Monad m => a -> SF m Bool (Event a)
edgeTag a
a = SF m Bool (Event ())
forall (m :: * -> *). Monad m => SF m Bool (Event ())
edge SF m Bool (Event ())
-> MSF (ClockInfo m) (Event ()) (Event a)
-> MSF (ClockInfo m) Bool (Event a)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Event () -> Event a) -> MSF (ClockInfo m) (Event ()) (Event a)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Event () -> a -> Event a
forall a b. Event a -> b -> Event b
`tag` a
a)
edgeJust :: Monad m => SF m (Maybe a) (Event a)
edgeJust :: forall (m :: * -> *) a. Monad m => SF m (Maybe a) (Event a)
edgeJust = (Maybe a -> Maybe a -> Maybe a)
-> Maybe a -> SF m (Maybe a) (Event a)
forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Maybe b) -> a -> SF m a (Event b)
edgeBy Maybe a -> Maybe a -> Maybe a
forall {a} {a}. Maybe a -> Maybe a -> Maybe a
isJustEdge (a -> Maybe a
forall a. a -> Maybe a
Just a
forall a. HasCallStack => a
undefined)
where
isJustEdge :: Maybe a -> Maybe a -> Maybe a
isJustEdge Maybe a
Nothing Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
isJustEdge Maybe a
Nothing ma :: Maybe a
ma@(Just a
_) = Maybe a
ma
isJustEdge (Just a
_) (Just a
_) = Maybe a
forall a. Maybe a
Nothing
isJustEdge (Just a
_) Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
edgeBy :: Monad m => (a -> a -> Maybe b) -> a -> SF m a (Event b)
edgeBy :: forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Maybe b) -> a -> SF m a (Event b)
edgeBy a -> a -> Maybe b
isEdge a
aPrev = (a -> ClockInfo m (Event b, MSF (ReaderT Time m) a (Event b)))
-> MSF (ReaderT Time m) a (Event b)
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((a -> ClockInfo m (Event b, MSF (ReaderT Time m) a (Event b)))
-> MSF (ReaderT Time m) a (Event b))
-> (a -> ClockInfo m (Event b, MSF (ReaderT Time m) a (Event b)))
-> MSF (ReaderT Time m) a (Event b)
forall a b. (a -> b) -> a -> b
$ \a
a ->
(Event b, MSF (ReaderT Time m) a (Event b))
-> ClockInfo m (Event b, MSF (ReaderT Time m) a (Event b))
forall a. a -> ReaderT Time m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> Event b
forall a. Maybe a -> Event a
maybeToEvent (a -> a -> Maybe b
isEdge a
aPrev a
a), (a -> a -> Maybe b) -> a -> MSF (ReaderT Time m) a (Event b)
forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Maybe b) -> a -> SF m a (Event b)
edgeBy a -> a -> Maybe b
isEdge a
a)
notYet :: Monad m => SF m (Event a) (Event a)
notYet :: forall (m :: * -> *) a. Monad m => SF m (Event a) (Event a)
notYet = Bool
-> MSF (ClockInfo m) (Event a, Bool) (Event a, Bool)
-> MSF (ClockInfo m) (Event a) (Event a)
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback Bool
False (MSF (ClockInfo m) (Event a, Bool) (Event a, Bool)
-> MSF (ClockInfo m) (Event a) (Event a))
-> MSF (ClockInfo m) (Event a, Bool) (Event a, Bool)
-> MSF (ClockInfo m) (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ ((Event a, Bool) -> (Event a, Bool))
-> MSF (ClockInfo m) (Event a, Bool) (Event a, Bool)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(Event a
e, Bool
c) ->
if Bool
c then (Event a
e, Bool
True) else (Event a
forall a. Event a
NoEvent, Bool
True))
once :: Monad m => SF m (Event a) (Event a)
once :: forall (m :: * -> *) a. Monad m => SF m (Event a) (Event a)
once = Int -> SF m (Event a) (Event a)
forall (m :: * -> *) a. Monad m => Int -> SF m (Event a) (Event a)
takeEvents Int
1
takeEvents :: Monad m => Int -> SF m (Event a) (Event a)
takeEvents :: forall (m :: * -> *) a. Monad m => Int -> SF m (Event a) (Event a)
takeEvents Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = SF m (Event a) (Event a)
forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never
takeEvents Int
n = SF m (Event a) (Event a, Event a)
-> (a -> SF m (Event a) (Event a)) -> SF m (Event a) (Event a)
forall (m :: * -> *) a b c.
Monad m =>
SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b
dSwitch ((Event a -> (Event a, Event a))
-> SF m (Event a) (Event a, Event a)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Event a -> (Event a, Event a)
forall a. a -> (a, a)
dup) (SF m (Event a) (Event a) -> a -> SF m (Event a) (Event a)
forall a b. a -> b -> a
const (Event a
forall a. Event a
NoEvent Event a -> SF m (Event a) (Event a) -> SF m (Event a) (Event a)
forall (m :: * -> *) a b. Monad m => a -> SF m a b -> SF m a b
>-- Int -> SF m (Event a) (Event a)
forall (m :: * -> *) a. Monad m => Int -> SF m (Event a) (Event a)
takeEvents (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
dropEvents :: Monad m => Int -> SF m (Event a) (Event a)
dropEvents :: forall (m :: * -> *) a. Monad m => Int -> SF m (Event a) (Event a)
dropEvents Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = SF m (Event a) (Event a)
forall (m :: * -> *) a. Monad m => SF m a a
identity
dropEvents Int
n =
SF m (Event a) (Event a, Event a)
-> (a -> SF m (Event a) (Event a)) -> SF m (Event a) (Event a)
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 (Event a) (Event a)
forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never SF m (Event a) (Event a)
-> SF m (Event a) (Event a) -> SF m (Event a) (Event a, 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')
&&& SF m (Event a) (Event a)
forall (m :: * -> *) a. Monad m => SF m a a
identity)
(SF m (Event a) (Event a) -> a -> SF m (Event a) (Event a)
forall a b. a -> b -> a
const (Event a
forall a. Event a
NoEvent Event a -> SF m (Event a) (Event a) -> SF m (Event a) (Event a)
forall (m :: * -> *) a b. Monad m => a -> SF m a b -> SF m a b
>-- Int -> SF m (Event a) (Event a)
forall (m :: * -> *) a. Monad m => Int -> SF m (Event a) (Event a)
dropEvents (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
snap :: Monad m => SF m a (Event a)
snap :: forall (m :: * -> *) a. Monad m => SF m a (Event a)
snap =
SF m a (Event a, Event a)
-> (a -> SF m a (Event a)) -> SF m a (Event a)
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 (Event a)
forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never SF m a (Event a) -> SF m a (Event a) -> SF m a (Event a, 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')
&&& (SF m a a
forall (m :: * -> *) a. Monad m => SF m a a
identity SF m a a
-> MSF (ClockInfo m) a (Event ())
-> MSF (ClockInfo m) a (a, 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')
&&& () -> MSF (ClockInfo m) a (Event ())
forall (m :: * -> *) b a. Monad m => b -> SF m a (Event b)
now () MSF (ClockInfo m) a (a, Event ())
-> ((a, Event ()) -> Event a) -> SF m a (Event a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ \(a
a, Event ()
e) -> Event ()
e Event () -> a -> Event a
forall a b. Event a -> b -> Event b
`tag` a
a)) a -> SF m a (Event a)
forall (m :: * -> *) b a. Monad m => b -> SF m a (Event b)
now
snapAfter :: Monad m => Time -> SF m a (Event a)
snapAfter :: forall (m :: * -> *) a. Monad m => Time -> SF m a (Event a)
snapAfter Time
tEv =
SF m a (Event a, Event a)
-> (a -> SF m a (Event a)) -> SF m a (Event a)
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 (Event a)
forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never SF m a (Event a) -> SF m a (Event a) -> SF m a (Event a, 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')
&&& (SF m a a
forall (m :: * -> *) a. Monad m => SF m a a
identity SF m a a
-> MSF (ClockInfo m) a (Event ())
-> MSF (ClockInfo m) a (a, 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')
&&& Time -> () -> MSF (ClockInfo m) a (Event ())
forall (m :: * -> *) b a. Monad m => Time -> b -> SF m a (Event b)
after Time
tEv () MSF (ClockInfo m) a (a, Event ())
-> ((a, Event ()) -> Event a) -> SF m a (Event a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ \(a
a, Event ()
e) -> Event ()
e Event () -> a -> Event a
forall a b. Event a -> b -> Event b
`tag` a
a)) a -> SF m a (Event a)
forall (m :: * -> *) b a. Monad m => b -> SF m a (Event b)
now
sample :: Monad m => Time -> SF m a (Event a)
sample :: forall (m :: * -> *) a. Monad m => Time -> SF m a (Event a)
sample Time
pEv = SF m a a
forall (m :: * -> *) a. Monad m => SF m a a
identity SF m a a
-> MSF (ClockInfo m) a (Event ())
-> MSF (ClockInfo m) a (a, 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')
&&& Time -> () -> MSF (ClockInfo m) a (Event ())
forall (m :: * -> *) b a. Monad m => Time -> b -> SF m a (Event b)
repeatedly Time
pEv () MSF (ClockInfo m) a (a, Event ())
-> ((a, Event ()) -> Event a) -> MSF (ClockInfo m) a (Event a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ \(a
a, Event ()
e) -> Event ()
e Event () -> a -> Event a
forall a b. Event a -> b -> Event b
`tag` a
a
sampleWindow :: Monad m => Int -> Time -> SF m a (Event [a])
sampleWindow :: forall (m :: * -> *) a.
Monad m =>
Int -> Time -> SF m a (Event [a])
sampleWindow Int
wl Time
q =
SF m a a
forall (m :: * -> *) a. Monad m => SF m a a
identity SF m a a
-> MSF (ClockInfo m) a (Event [()])
-> MSF (ClockInfo m) a (a, 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')
&&& [(Time, ())] -> MSF (ClockInfo m) a (Event [()])
forall (m :: * -> *) b a.
Monad m =>
[(Time, b)] -> SF m a (Event [b])
afterEachCat ((Time, ()) -> [(Time, ())]
forall a. a -> [a]
repeat (Time
q, ()))
MSF (ClockInfo m) a (a, Event [()])
-> MSF (ClockInfo m) (a, Event [()]) (Event [a])
-> MSF (ClockInfo m) a (Event [a])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((a, Event [()]) -> Event [a])
-> MSF (ClockInfo m) (a, Event [()]) (Event [a])
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(a
a, Event [()]
e) -> ([()] -> [a]) -> Event [()] -> Event [a]
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((() -> a) -> [()] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> () -> a
forall a b. a -> b -> a
const a
a)) Event [()]
e)
MSF (ClockInfo m) (a, Event [()]) (Event [a])
-> MSF (ClockInfo m) (Event [a]) (Event [a])
-> MSF (ClockInfo m) (a, Event [()]) (Event [a])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([a] -> [a] -> [a])
-> [a] -> MSF (ClockInfo m) (Event [a]) (Event [a])
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> SF m (Event a) (Event b)
accumBy [a] -> [a] -> [a]
forall {a}. [a] -> [a] -> [a]
updateWindow []
where
updateWindow :: [a] -> [a] -> [a]
updateWindow [a]
w [a]
as = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
w' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wl) Int
0) [a]
w'
where
w' :: [a]
w' = [a]
w [a] -> [a] -> [a]
forall {a}. [a] -> [a] -> [a]
++ [a]
as
recur :: Monad m => SF m a (Event b) -> SF m a (Event b)
recur :: forall (m :: * -> *) a b.
Monad m =>
SF m a (Event b) -> SF m a (Event b)
recur SF m a (Event b)
sfe = SF m a (Event b, Event b)
-> (b -> SF m a (Event b)) -> SF m a (Event 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 (Event b)
forall (m :: * -> *) a b. Monad m => SF m a (Event b)
never SF m a (Event b) -> SF m a (Event b) -> SF m a (Event b, Event b)
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')
&&& SF m a (Event b)
sfe) ((b -> SF m a (Event b)) -> SF m a (Event b))
-> (b -> SF m a (Event b)) -> SF m a (Event b)
forall a b. (a -> b) -> a -> b
$ \b
b -> b -> Event b
forall a. a -> Event a
Event b
b Event b -> SF m a (Event b) -> SF m a (Event b)
forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
--> SF m a (Event b) -> SF m a (Event b)
forall (m :: * -> *) a b.
Monad m =>
SF m a (Event b) -> SF m a (Event b)
recur (Event b
forall a. Event a
NoEvent Event b -> SF m a (Event b) -> SF m a (Event b)
forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
--> SF m a (Event b)
sfe)
andThen :: Monad m => SF m a (Event b) -> SF m a (Event b) -> SF m a (Event b)
SF m a (Event b)
sfe1 andThen :: forall (m :: * -> *) a b.
Monad m =>
SF m a (Event b) -> SF m a (Event b) -> SF m a (Event b)
`andThen` SF m a (Event b)
sfe2 = SF m a (Event b, Event b)
-> (b -> SF m a (Event b)) -> SF m a (Event 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 (Event b)
sfe1 SF m a (Event b)
-> (Event b -> (Event b, Event b)) -> SF m a (Event b, Event b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ Event b -> (Event b, Event b)
forall a. a -> (a, a)
dup) (SF m a (Event b) -> b -> SF m a (Event b)
forall a b. a -> b -> a
const SF m a (Event b)
sfe2)