module FRP.Yampa.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 FRP.Yampa.Arrow (dup)
import FRP.Yampa.Basic (identity, initially, (-->), (>--))
import FRP.Yampa.Diagnostics (usrErr)
import FRP.Yampa.Event (Event (..), maybeToEvent, tag)
import FRP.Yampa.Hybrid (accumBy)
import FRP.Yampa.InternalCore (SF (..), SF' (..), Time, sfConst)
import FRP.Yampa.Scan (sscanPrim)
import FRP.Yampa.Switches (dSwitch, switch)
infixr 5 `andThen`
{-# ANN never "HLint: ignore Use const" #-}
never :: SF a (Event b)
never :: forall a b. SF a (Event b)
never = SF {sfTF :: a -> Transition a (Event b)
sfTF = \a
_ -> (SF' a (Event b)
forall a b. SF' a (Event b)
sfNever, Event b
forall a. Event a
NoEvent)}
sfNever :: SF' a (Event b)
sfNever :: forall a b. SF' a (Event b)
sfNever = Event b -> SF' a (Event b)
forall b a. b -> SF' a b
sfConst Event b
forall a. Event a
NoEvent
now :: b -> SF a (Event b)
now :: forall b a. b -> SF a (Event b)
now b
b0 = b -> Event b
forall a. a -> Event a
Event b
b0 Event b -> SF a (Event b) -> SF a (Event b)
forall b a. b -> SF a b -> SF a b
--> SF a (Event b)
forall a b. SF a (Event b)
never
after :: Time
-> b
-> SF a (Event b)
after :: forall b a. Time -> b -> SF a (Event b)
after Time
q b
x = [(Time, b)] -> SF a (Event b)
forall b a. [(Time, b)] -> SF a (Event b)
afterEach [(Time
q, b
x)]
repeatedly :: Time -> b -> SF a (Event b)
repeatedly :: forall b a. Time -> b -> SF 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 a (Event b)
forall b a. [(Time, b)] -> SF a (Event b)
afterEach [(Time, b)]
qxs
| Bool
otherwise = String -> String -> String -> SF a (Event b)
forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"repeatedly" String
"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 :: [(Time, b)] -> SF a (Event b)
afterEach :: forall b a. [(Time, b)] -> SF a (Event b)
afterEach [(Time, b)]
qxs = [(Time, b)] -> SF a (Event [b])
forall b a. [(Time, b)] -> SF a (Event [b])
afterEachCat [(Time, b)]
qxs SF a (Event [b]) -> SF (Event [b]) (Event b) -> SF 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) -> SF (Event [b]) (Event b)
forall b c. (b -> c) -> SF 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 :: [(Time, b)] -> SF a (Event [b])
afterEachCat :: forall b a. [(Time, b)] -> SF a (Event [b])
afterEachCat [] = SF a (Event [b])
forall a b. SF a (Event b)
never
afterEachCat ((Time
q, b
x) : [(Time, b)]
qxs)
| Time
q Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 = String -> String -> String -> SF a (Event [b])
forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"afterEachCat" String
"Negative period."
| Bool
otherwise = SF {sfTF :: a -> Transition a (Event [b])
sfTF = a -> Transition a (Event [b])
forall {p} {a}. p -> (SF' a (Event [b]), Event [b])
tf0}
where
tf0 :: p -> (SF' a (Event [b]), Event [b])
tf0 p
_ = if Time
q Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
0
then Time -> [b] -> [(Time, b)] -> (SF' a (Event [b]), Event [b])
forall {t} {a}.
Time -> [t] -> [(Time, t)] -> (SF' a (Event [t]), Event [t])
emitEventsScheduleNext Time
0.0 [b
x] [(Time, b)]
qxs
else (Time -> b -> [(Time, b)] -> SF' a (Event [b])
forall {t} {a}. Time -> t -> [(Time, t)] -> SF' a (Event [t])
awaitNextEvent (-Time
q) b
x [(Time, b)]
qxs, Event [b]
forall a. Event a
NoEvent)
emitEventsScheduleNext :: Time -> [t] -> [(Time, t)] -> (SF' a (Event [t]), Event [t])
emitEventsScheduleNext Time
_ [t]
xs [] = (SF' a (Event [t])
forall a b. SF' a (Event b)
sfNever, [t] -> Event [t]
forall a. a -> Event a
Event ([t] -> [t]
forall a. [a] -> [a]
reverse [t]
xs))
emitEventsScheduleNext Time
t [t]
xs ((Time
q, t
x) : [(Time, t)]
qxs)
| Time
q Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 = String -> String -> String -> (SF' a (Event [t]), Event [t])
forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"afterEachCat" String
"Negative period."
| Time
t' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
0 = Time -> [t] -> [(Time, t)] -> (SF' a (Event [t]), Event [t])
emitEventsScheduleNext Time
t' (t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
xs) [(Time, t)]
qxs
| Bool
otherwise = (Time -> t -> [(Time, t)] -> SF' a (Event [t])
awaitNextEvent Time
t' t
x [(Time, t)]
qxs, [t] -> Event [t]
forall a. a -> Event a
Event ([t] -> [t]
forall a. [a] -> [a]
reverse [t]
xs))
where
t' :: Time
t' = Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
q
awaitNextEvent :: Time -> t -> [(Time, t)] -> SF' a (Event [t])
awaitNextEvent Time
t t
x [(Time, t)]
qxs = (Time -> a -> (SF' a (Event [t]), Event [t])) -> SF' a (Event [t])
forall a b. (Time -> a -> Transition a b) -> SF' a b
SF' Time -> a -> (SF' a (Event [t]), Event [t])
forall {p}. Time -> p -> (SF' a (Event [t]), Event [t])
tf
where
tf :: Time -> p -> (SF' a (Event [t]), Event [t])
tf Time
dt p
_ | Time
t' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
0 = Time -> [t] -> [(Time, t)] -> (SF' a (Event [t]), Event [t])
emitEventsScheduleNext Time
t' [t
x] [(Time, t)]
qxs
| Bool
otherwise = (Time -> t -> [(Time, t)] -> SF' a (Event [t])
awaitNextEvent Time
t' t
x [(Time, t)]
qxs, Event [t]
forall a. Event a
NoEvent)
where
t' :: Time
t' = Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dt
delayEvent :: Time -> SF (Event a) (Event a)
delayEvent :: forall a. Time -> SF (Event a) (Event a)
delayEvent Time
q | Time
q Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 = String -> String -> String -> SF (Event a) (Event a)
forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"delayEvent" String
"Negative delay."
| Time
q Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
0 = SF (Event a) (Event a)
forall a. SF a a
identity
| Bool
otherwise = Time -> SF (Event a) (Event [a])
forall a. Time -> SF (Event a) (Event [a])
delayEventCat Time
q SF (Event a) (Event [a])
-> SF (Event [a]) (Event a) -> SF (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) -> SF (Event [a]) (Event a)
forall b c. (b -> c) -> SF 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 :: Time -> SF (Event a) (Event [a])
delayEventCat :: forall a. Time -> SF (Event a) (Event [a])
delayEventCat Time
q | Time
q Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 = String -> String -> String -> SF (Event a) (Event [a])
forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"delayEventCat" String
"Negative delay."
| Time
q Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
0 = (Event a -> Event [a]) -> SF (Event a) (Event [a])
forall b c. (b -> c) -> SF 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 = SF {sfTF :: Event a -> Transition (Event a) (Event [a])
sfTF = Event a -> Transition (Event a) (Event [a])
forall {a} {a}. Event a -> (SF' (Event a) (Event [a]), Event a)
tf0}
where
tf0 :: Event a -> (SF' (Event a) (Event [a]), Event a)
tf0 Event a
e = ( case Event a
e of
Event a
NoEvent -> SF' (Event a) (Event [a])
forall {a}. SF' (Event a) (Event [a])
noPendingEvent
Event a
x -> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (Event a) (Event [a])
forall {a}.
Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (Event a) (Event [a])
pendingEvents (-Time
q) [] [] (-Time
q) a
x
, Event a
forall a. Event a
NoEvent
)
noPendingEvent :: SF' (Event a) (Event [a])
noPendingEvent = (Time -> Event a -> Transition (Event a) (Event [a]))
-> SF' (Event a) (Event [a])
forall a b. (Time -> a -> Transition a b) -> SF' a b
SF' Time -> Event a -> Transition (Event a) (Event [a])
forall {p} {a}.
p -> Event a -> (SF' (Event a) (Event [a]), Event a)
tf
where
tf :: p -> Event a -> (SF' (Event a) (Event [a]), Event a)
tf p
_ Event a
e = ( case Event a
e of
Event a
NoEvent -> SF' (Event a) (Event [a])
noPendingEvent
Event a
x -> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (Event a) (Event [a])
pendingEvents (-Time
q) [] [] (-Time
q) a
x
, Event a
forall a. Event a
NoEvent
)
pendingEvents :: Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (Event a) (Event [a])
pendingEvents Time
tLast [(Time, a)]
rqxs [(Time, a)]
qxs Time
tNext a
x = (Time -> Event a -> Transition (Event a) (Event [a]))
-> SF' (Event a) (Event [a])
forall a b. (Time -> a -> Transition a b) -> SF' a b
SF' Time -> Event a -> Transition (Event a) (Event [a])
tf
where
tf :: Time -> Event a -> Transition (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]
-> Transition (Event a) (Event [a])
emitEventsScheduleNext Event a
e Time
tLast' [(Time, a)]
rqxs [(Time, a)]
qxs Time
tNext' [a
x]
| Bool
otherwise
= (Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (Event a) (Event [a])
pendingEvents Time
tLast'' [(Time, a)]
rqxs' [(Time, a)]
qxs Time
tNext' a
x, Event [a]
forall a. Event a
NoEvent)
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]
-> Transition (Event a) (Event [a])
emitEventsScheduleNext Event a
e Time
_ [] [] Time
_ [a]
rxs =
( case Event a
e of
Event a
NoEvent -> SF' (Event a) (Event [a])
noPendingEvent
Event a
x -> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (Event a) (Event [a])
pendingEvents (-Time
q) [] [] (-Time
q) a
x
, [a] -> Event [a]
forall a. a -> Event a
Event ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rxs)
)
emitEventsScheduleNext Event a
e Time
tLast [(Time, a)]
rqxs [] Time
tNext [a]
rxs =
Event a
-> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> [a]
-> Transition (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 = ( case Event a
e of
Event a
NoEvent ->
Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (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'' ->
Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (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'
, [a] -> Event [a]
forall a. a -> Event a
Event ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rxs)
)
| Bool
otherwise = Event a
-> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> [a]
-> Transition (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 :: SF Bool (Event ())
edge :: SF Bool (Event ())
edge = Bool -> SF Bool (Event ())
iEdge Bool
True
iEdge :: Bool -> SF Bool (Event ())
iEdge :: Bool -> SF Bool (Event ())
iEdge Bool
b = (Int -> Bool -> Maybe (Int, Event ()))
-> Int -> Event () -> SF Bool (Event ())
forall c a b. (c -> a -> Maybe (c, b)) -> c -> b -> SF a b
sscanPrim Int -> Bool -> Maybe (Int, Event ())
f (if Bool
b then Int
2 else Int
0) Event ()
forall a. Event a
NoEvent
where
f :: Int -> Bool -> Maybe (Int, Event ())
f :: Int -> Bool -> Maybe (Int, Event ())
f Int
0 Bool
False = Maybe (Int, Event ())
forall a. Maybe a
Nothing
f Int
0 Bool
True = (Int, Event ()) -> Maybe (Int, Event ())
forall a. a -> Maybe a
Just (Int
1, () -> Event ()
forall a. a -> Event a
Event ())
f Int
1 Bool
False = (Int, Event ()) -> Maybe (Int, Event ())
forall a. a -> Maybe a
Just (Int
0, Event ()
forall a. Event a
NoEvent)
f Int
1 Bool
True = (Int, Event ()) -> Maybe (Int, Event ())
forall a. a -> Maybe a
Just (Int
2, Event ()
forall a. Event a
NoEvent)
f Int
2 Bool
False = (Int, Event ()) -> Maybe (Int, Event ())
forall a. a -> Maybe a
Just (Int
0, Event ()
forall a. Event a
NoEvent)
f Int
2 Bool
True = Maybe (Int, Event ())
forall a. Maybe a
Nothing
f Int
_ Bool
_ = Maybe (Int, Event ())
forall a. HasCallStack => a
undefined
edgeTag :: a -> SF Bool (Event a)
edgeTag :: forall a. a -> SF Bool (Event a)
edgeTag a
a = SF Bool (Event ())
edge SF Bool (Event ()) -> SF (Event ()) (Event a) -> SF 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) -> SF (Event ()) (Event a)
forall b c. (b -> c) -> SF 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 :: SF (Maybe a) (Event a)
edgeJust :: forall a. SF (Maybe a) (Event a)
edgeJust = (Maybe a -> Maybe a -> Maybe a)
-> Maybe a -> SF (Maybe a) (Event a)
forall a b. (a -> a -> Maybe b) -> a -> SF 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 ma :: Maybe a
ma@(Just a
_) = Maybe a
ma
isJustEdge Maybe a
_ Maybe a
_ = Maybe a
forall a. Maybe a
Nothing
edgeBy :: (a -> a -> Maybe b) -> a -> SF a (Event b)
edgeBy :: forall a b. (a -> a -> Maybe b) -> a -> SF a (Event b)
edgeBy a -> a -> Maybe b
isEdge a
aInit = SF {sfTF :: a -> Transition a (Event b)
sfTF = a -> Transition a (Event b)
tf0}
where
tf0 :: a -> Transition a (Event b)
tf0 a
a0 = (a -> SF' a (Event b)
ebAux a
a0, Maybe b -> Event b
forall a. Maybe a -> Event a
maybeToEvent (a -> a -> Maybe b
isEdge a
aInit a
a0))
ebAux :: a -> SF' a (Event b)
ebAux a
aPrev = (Time -> a -> Transition a (Event b)) -> SF' a (Event b)
forall a b. (Time -> a -> Transition a b) -> SF' a b
SF' Time -> a -> Transition a (Event b)
forall {p}. p -> a -> Transition a (Event b)
tf
where
tf :: p -> a -> Transition a (Event b)
tf p
_ a
a = (a -> SF' a (Event b)
ebAux a
a, Maybe b -> Event b
forall a. Maybe a -> Event a
maybeToEvent (a -> a -> Maybe b
isEdge a
aPrev a
a))
notYet :: SF (Event a) (Event a)
notYet :: forall a. SF (Event a) (Event a)
notYet = Event a -> SF (Event a) (Event a)
forall a. a -> SF a a
initially Event a
forall a. Event a
NoEvent
once :: SF (Event a) (Event a)
once :: forall a. SF (Event a) (Event a)
once = Int -> SF (Event a) (Event a)
forall a. Int -> SF (Event a) (Event a)
takeEvents Int
1
takeEvents :: Int -> SF (Event a) (Event a)
takeEvents :: forall a. Int -> SF (Event a) (Event a)
takeEvents Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = SF (Event a) (Event a)
forall a b. SF a (Event b)
never
takeEvents Int
n = SF (Event a) (Event a, Event a)
-> (a -> SF (Event a) (Event a)) -> SF (Event a) (Event a)
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch ((Event a -> (Event a, Event a)) -> SF (Event a) (Event a, Event a)
forall b c. (b -> c) -> SF 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 (Event a) (Event a) -> a -> SF (Event a) (Event a)
forall a b. a -> b -> a
const (Event a
forall a. Event a
NoEvent Event a -> SF (Event a) (Event a) -> SF (Event a) (Event a)
forall a b. a -> SF a b -> SF a b
>-- Int -> SF (Event a) (Event a)
forall a. Int -> SF (Event a) (Event a)
takeEvents (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
dropEvents :: Int -> SF (Event a) (Event a)
dropEvents :: forall a. Int -> SF (Event a) (Event a)
dropEvents Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = SF (Event a) (Event a)
forall a. SF a a
identity
dropEvents Int
n =
SF (Event a) (Event a, Event a)
-> (a -> SF (Event a) (Event a)) -> SF (Event a) (Event a)
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch (SF (Event a) (Event a)
forall a b. SF a (Event b)
never SF (Event a) (Event a)
-> SF (Event a) (Event a) -> SF (Event a) (Event a, Event a)
forall b c c'. SF b c -> SF b c' -> SF b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SF (Event a) (Event a)
forall a. SF a a
identity)
(SF (Event a) (Event a) -> a -> SF (Event a) (Event a)
forall a b. a -> b -> a
const (Event a
forall a. Event a
NoEvent Event a -> SF (Event a) (Event a) -> SF (Event a) (Event a)
forall a b. a -> SF a b -> SF a b
>-- Int -> SF (Event a) (Event a)
forall a. Int -> SF (Event a) (Event a)
dropEvents (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
snap :: SF a (Event a)
snap :: forall a. SF a (Event a)
snap =
SF a (Event a, Event a) -> (a -> SF a (Event a)) -> SF a (Event a)
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (SF a (Event a)
forall a b. SF a (Event b)
never SF a (Event a) -> SF a (Event a) -> SF a (Event a, Event a)
forall b c c'. SF b c -> SF b c' -> SF b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (SF a a
forall a. SF a a
identity SF a a -> SF a (Event ()) -> SF a (a, Event ())
forall b c c'. SF b c -> SF b c' -> SF b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& () -> SF a (Event ())
forall b a. b -> SF a (Event b)
now () SF a (a, Event ()) -> ((a, Event ()) -> Event a) -> SF 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 a (Event a)
forall b a. b -> SF a (Event b)
now
snapAfter :: Time -> SF a (Event a)
snapAfter :: forall a. Time -> SF a (Event a)
snapAfter Time
tEv =
SF a (Event a, Event a) -> (a -> SF a (Event a)) -> SF a (Event a)
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (SF a (Event a)
forall a b. SF a (Event b)
never SF a (Event a) -> SF a (Event a) -> SF a (Event a, Event a)
forall b c c'. SF b c -> SF b c' -> SF b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (SF a a
forall a. SF a a
identity SF a a -> SF a (Event ()) -> SF a (a, Event ())
forall b c c'. SF b c -> SF b c' -> SF b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Time -> () -> SF a (Event ())
forall b a. Time -> b -> SF a (Event b)
after Time
tEv () SF a (a, Event ()) -> ((a, Event ()) -> Event a) -> SF 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 a (Event a)
forall b a. b -> SF a (Event b)
now
sample :: Time -> SF a (Event a)
sample :: forall a. Time -> SF a (Event a)
sample Time
pEv = SF a a
forall a. SF a a
identity SF a a -> SF a (Event ()) -> SF a (a, Event ())
forall b c c'. SF b c -> SF b c' -> SF b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Time -> () -> SF a (Event ())
forall b a. Time -> b -> SF a (Event b)
repeatedly Time
pEv () SF a (a, Event ()) -> ((a, Event ()) -> Event a) -> SF 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 :: Int -> Time -> SF a (Event [a])
sampleWindow :: forall a. Int -> Time -> SF a (Event [a])
sampleWindow Int
wl Time
q =
SF a a
forall a. SF a a
identity SF a a -> SF a (Event [()]) -> SF a (a, Event [()])
forall b c c'. SF b c -> SF b c' -> SF b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [(Time, ())] -> SF a (Event [()])
forall b a. [(Time, b)] -> SF a (Event [b])
afterEachCat ((Time, ()) -> [(Time, ())]
forall a. a -> [a]
repeat (Time
q, ()))
SF a (a, Event [()])
-> SF (a, Event [()]) (Event [a]) -> SF 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]) -> SF (a, Event [()]) (Event [a])
forall b c. (b -> c) -> SF 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)
SF (a, Event [()]) (Event [a])
-> SF (Event [a]) (Event [a]) -> SF (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] -> SF (Event [a]) (Event [a])
forall b a. (b -> a -> b) -> b -> SF (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 :: SF a (Event b) -> SF a (Event b)
recur :: forall a b. SF a (Event b) -> SF a (Event b)
recur SF a (Event b)
sfe = SF a (Event b, Event b) -> (b -> SF a (Event b)) -> SF a (Event b)
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (SF a (Event b)
forall a b. SF a (Event b)
never SF a (Event b) -> SF a (Event b) -> SF a (Event b, Event b)
forall b c c'. SF b c -> SF b c' -> SF b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SF a (Event b)
sfe) ((b -> SF a (Event b)) -> SF a (Event b))
-> (b -> SF a (Event b)) -> SF 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 a (Event b) -> SF a (Event b)
forall b a. b -> SF a b -> SF a b
--> SF a (Event b) -> SF a (Event b)
forall a b. SF a (Event b) -> SF a (Event b)
recur (Event b
forall a. Event a
NoEvent Event b -> SF a (Event b) -> SF a (Event b)
forall b a. b -> SF a b -> SF a b
--> SF a (Event b)
sfe)
andThen :: SF a (Event b) -> SF a (Event b) -> SF a (Event b)
SF a (Event b)
sfe1 andThen :: forall a b. SF a (Event b) -> SF a (Event b) -> SF a (Event b)
`andThen` SF a (Event b)
sfe2 = SF a (Event b, Event b) -> (b -> SF a (Event b)) -> SF a (Event b)
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch (SF a (Event b)
sfe1 SF a (Event b)
-> (Event b -> (Event b, Event b)) -> SF 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 a (Event b) -> b -> SF a (Event b)
forall a b. a -> b -> a
const SF a (Event b)
sfe2)