-- |
-- Module      :  FRP.Yampa.EventS
-- Copyright   :  (c) Ivan Perez, 2014-2022
--                (c) George Giorgidze, 2007-2012
--                (c) Henrik Nilsson, 2005-2006
--                (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  :  ivan.perez@keera.co.uk
-- Stability   :  provisional
-- Portability :  non-portable (GHC extensions)
--
-- Event Signal Functions and SF combinators.
--
-- Events represent values that only exist instantaneously, at discrete points
-- in time. Examples include mouse clicks, zero-crosses of monotonic continuous
-- signals, and square waves.
--
-- For signals that carry events, there should be a limit in the number of
-- events we can observe in a time period, no matter how much we increase the
-- sampling frequency.
module FRP.Yampa.EventS
    (
      -- * Basic event sources
      never
    , now
    , after
    , repeatedly
    , afterEach
    , afterEachCat
    , delayEvent
    , delayEventCat
    , edge
    , iEdge
    , edgeTag
    , edgeJust
    , edgeBy

      -- * Stateful event suppression
    , notYet
    , once
    , takeEvents
    , dropEvents

      -- * Hybrid SF combinators
    , snap
    , snapAfter
    , sample
    , sampleWindow

      -- * Repetition and switching
    , recur
    , andThen
    )
  where

import Control.Arrow

import FRP.Yampa.Arrow
import FRP.Yampa.Basic
import FRP.Yampa.Diagnostics
import FRP.Yampa.Event
import FRP.Yampa.Hybrid
import FRP.Yampa.InternalCore (SF (..), SF' (..), Time, sfConst)
import FRP.Yampa.Scan
import FRP.Yampa.Switches

infixr 5 `andThen`

-- * Basic event sources

-- | Event source that never occurs.
{-# 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
_ -> (forall a b. SF' a (Event b)
sfNever, forall a. Event a
NoEvent)}

sfNever :: SF' a (Event b)
sfNever :: forall a b. SF' a (Event b)
sfNever = forall b a. b -> SF' a b
sfConst forall a. Event a
NoEvent

-- | Event source with a single occurrence at time 0. The value of the event
-- is given by the function argument.
now :: b -> SF a (Event b)
now :: forall b a. b -> SF a (Event b)
now b
b0 = forall a. a -> Event a
Event b
b0 forall b a. b -> SF a b -> SF a b
--> forall a b. SF a (Event b)
never

-- | Event source with a single occurrence at or as soon after (local) time /q/
-- as possible.
after :: Time -- ^ The time /q/ after which the event should be produced
      -> b    -- ^ Value to produce at that time
      -> SF a (Event b)
after :: forall b a. Time -> b -> SF a (Event b)
after Time
q b
x = forall b a. [(Time, b)] -> SF a (Event b)
afterEach [(Time
q,b
x)]

-- | Event source with repeated occurrences with interval q.
-- Note: If the interval is too short w.r.t. the sampling intervals,
-- the result will be that events occur at every sample. However, no more
-- than one event results from any sampling interval, thus avoiding an
-- "event backlog" should sampling become more frequent at some later
-- point in time.
repeatedly :: Time -> b -> SF a (Event b)
repeatedly :: forall b a. Time -> b -> SF a (Event b)
repeatedly Time
q b
x | Time
q forall a. Ord a => a -> a -> Bool
> Time
0 = forall b a. [(Time, b)] -> SF a (Event b)
afterEach [(Time, b)]
qxs
               | Bool
otherwise = forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"repeatedly" String
"Non-positive period."
  where
    qxs :: [(Time, b)]
qxs = (Time
q,b
x)forall a. a -> [a] -> [a]
:[(Time, b)]
qxs

-- | Event source with consecutive occurrences at the given intervals.
-- Should more than one event be scheduled to occur in any sampling interval,
-- only the first will in fact occur to avoid an event backlog.
afterEach :: [(Time,b)] -> SF a (Event b)
afterEach :: forall b a. [(Time, b)] -> SF a (Event b)
afterEach [(Time, b)]
qxs = forall b a. [(Time, b)] -> SF a (Event [b])
afterEachCat [(Time, b)]
qxs forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> a
head)

-- | Event source with consecutive occurrences at the given intervals.
-- Should more than one event be scheduled to occur in any sampling interval,
-- the output list will contain all events produced during that interval.
afterEachCat :: [(Time,b)] -> SF a (Event [b])
afterEachCat :: forall b a. [(Time, b)] -> SF a (Event [b])
afterEachCat [] = forall a b. SF a (Event b)
never
afterEachCat ((Time
q,b
x):[(Time, b)]
qxs)
    | Time
q forall a. Ord a => a -> a -> Bool
< Time
0     = forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"afterEachCat" String
"Negative period."
    | Bool
otherwise = SF {sfTF :: a -> Transition a (Event [b])
sfTF = 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 forall a. Ord a => a -> a -> Bool
<= Time
0
              then forall {t} {a}.
Time -> [t] -> [(Time, t)] -> (SF' a (Event [t]), Event [t])
emitEventsScheduleNext Time
0.0 [b
x] [(Time, b)]
qxs
              else (forall {t} {a}. Time -> t -> [(Time, t)] -> SF' a (Event [t])
awaitNextEvent (-Time
q) b
x [(Time, b)]
qxs, forall a. Event a
NoEvent)

    emitEventsScheduleNext :: Time -> [t] -> [(Time, t)] -> (SF' a (Event [t]), Event [t])
emitEventsScheduleNext Time
_ [t]
xs [] = (forall a b. SF' a (Event b)
sfNever, forall a. a -> Event a
Event (forall a. [a] -> [a]
reverse [t]
xs))
    emitEventsScheduleNext Time
t [t]
xs ((Time
q,t
x):[(Time, t)]
qxs)
        | Time
q forall a. Ord a => a -> a -> Bool
< Time
0     = forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"afterEachCat" String
"Negative period."
        | Time
t' forall a. Ord a => a -> a -> Bool
>= Time
0   = Time -> [t] -> [(Time, t)] -> (SF' a (Event [t]), Event [t])
emitEventsScheduleNext Time
t' (t
xforall 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, forall a. a -> Event a
Event (forall a. [a] -> [a]
reverse [t]
xs))
      where
        t' :: Time
t' = Time
t 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 = forall a b. (Time -> a -> Transition a b) -> SF' a b
SF' forall {p}. Time -> p -> (SF' a (Event [t]), Event [t])
tf -- False
      where
        tf :: Time -> p -> (SF' a (Event [t]), Event [t])
tf Time
dt p
_ | Time
t' 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, forall a. Event a
NoEvent)
          where
            t' :: Time
t' = Time
t forall a. Num a => a -> a -> a
+ Time
dt

-- | Delay for events. (Consider it a triggered after, hence /basic/.)
delayEvent :: Time -> SF (Event a) (Event a)
delayEvent :: forall a. Time -> SF (Event a) (Event a)
delayEvent Time
q | Time
q forall a. Ord a => a -> a -> Bool
< Time
0     = forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"delayEvent" String
"Negative delay."
             | Time
q forall a. Eq a => a -> a -> Bool
== Time
0    = forall a. SF a a
identity
             | Bool
otherwise = forall a. Time -> SF (Event a) (Event [a])
delayEventCat Time
q forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> a
head)

-- | Delay an event by a given delta and catenate events that occur so closely
-- so as to be /inseparable/.
delayEventCat :: Time -> SF (Event a) (Event [a])
delayEventCat :: forall a. Time -> SF (Event a) (Event [a])
delayEventCat Time
q | Time
q forall a. Ord a => a -> a -> Bool
< Time
0     = forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"delayEventCat" String
"Negative delay."
                | Time
q forall a. Eq a => a -> a -> Bool
== Time
0    = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]))
                | Bool
otherwise = SF {sfTF :: Event a -> Transition (Event a) (Event [a])
sfTF = 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 -> forall {a}. SF' (Event a) (Event [a])
noPendingEvent
                Event a
x -> forall {a}.
Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (Event a) (Event [a])
pendingEvents (-Time
q) [] [] (-Time
q) a
x
            , forall a. Event a
NoEvent
            )

    noPendingEvent :: SF' (Event a) (Event [a])
noPendingEvent = forall a b. (Time -> a -> Transition a b) -> SF' a b
SF' forall {p} {a}.
p -> Event a -> (SF' (Event a) (Event [a]), Event a)
tf -- True
      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
                 , forall a. Event a
NoEvent
                 )

    -- t_next is the present time w.r.t. the next scheduled event.
    -- t_last is the present time w.r.t. the last scheduled event.
    -- In the event queues, events are associated with their time
    -- w.r.t. to preceding event (positive).
    pendingEvents :: Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (Event a) (Event [a])
pendingEvents Time
t_last [(Time, a)]
rqxs [(Time, a)]
qxs Time
t_next a
x = forall a b. (Time -> a -> Transition a b) -> SF' a b
SF' Time -> Event a -> (SF' (Event a) (Event [a]), Event [a])
tf -- True
      where
        tf :: Time -> Event a -> (SF' (Event a) (Event [a]), Event [a])
tf Time
dt Event a
e
            | Time
t_next' forall a. Ord a => a -> a -> Bool
>= Time
0
            = Event a
-> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> [a]
-> (SF' (Event a) (Event [a]), Event [a])
emitEventsScheduleNext Event a
e Time
t_last' [(Time, a)]
rqxs [(Time, a)]
qxs Time
t_next' [a
x]
            | Bool
otherwise
            = (Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (Event a) (Event [a])
pendingEvents Time
t_last'' [(Time, a)]
rqxs' [(Time, a)]
qxs Time
t_next' a
x, forall a. Event a
NoEvent)
          where
            t_next' :: Time
t_next' = Time
t_next  forall a. Num a => a -> a -> a
+ Time
dt
            t_last' :: Time
t_last' = Time
t_last  forall a. Num a => a -> a -> a
+ Time
dt
            (Time
t_last'', [(Time, a)]
rqxs') =
              case Event a
e of
                Event a
NoEvent  -> (Time
t_last', [(Time, a)]
rqxs)
                Event a
x' -> (-Time
q, (Time
t_last'forall a. Num a => a -> a -> a
+Time
q,a
x') forall a. a -> [a] -> [a]
: [(Time, a)]
rqxs)

    -- t_next is the present time w.r.t. the *scheduled* time of the
    -- event that is about to be emitted (i.e. >= 0).
    -- The time associated with any event at the head of the event
    -- queue is also given w.r.t. the event that is about to be emitted.
    -- Thus, t_next - q' is the present time w.r.t. the event at the head
    -- of the event queue.
    emitEventsScheduleNext :: Event a
-> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> [a]
-> (SF' (Event a) (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
      , forall a. a -> Event a
Event (forall a. [a] -> [a]
reverse [a]
rxs)
      )
    emitEventsScheduleNext Event a
e Time
t_last [(Time, a)]
rqxs [] Time
t_next [a]
rxs =
      Event a
-> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> [a]
-> (SF' (Event a) (Event [a]), Event [a])
emitEventsScheduleNext Event a
e Time
t_last [] (forall a. [a] -> [a]
reverse [(Time, a)]
rqxs) Time
t_next [a]
rxs
    emitEventsScheduleNext Event a
e Time
t_last [(Time, a)]
rqxs ((Time
q', a
x') : [(Time, a)]
qxs') Time
t_next [a]
rxs
      | Time
q' forall a. Ord a => a -> a -> Bool
> Time
t_next = ( case Event a
e of
                          Event a
NoEvent ->
                            Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> a
-> SF' (Event a) (Event [a])
pendingEvents Time
t_last
                                          [(Time, a)]
rqxs
                                          [(Time, a)]
qxs'
                                          (Time
t_next 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
t_lastforall a. Num a => a -> a -> a
+Time
q, a
x'') forall a. a -> [a] -> [a]
: [(Time, a)]
rqxs)
                                          [(Time, a)]
qxs'
                                          (Time
t_next forall a. Num a => a -> a -> a
- Time
q')
                                          a
x'
                      , forall a. a -> Event a
Event (forall a. [a] -> [a]
reverse [a]
rxs)
                      )
      | Bool
otherwise   = Event a
-> Time
-> [(Time, a)]
-> [(Time, a)]
-> Time
-> [a]
-> (SF' (Event a) (Event [a]), Event [a])
emitEventsScheduleNext Event a
e
                                             Time
t_last
                                             [(Time, a)]
rqxs
                                             [(Time, a)]
qxs'
                                             (Time
t_next forall a. Num a => a -> a -> a
- Time
q')
                                             (a
x' forall a. a -> [a] -> [a]
: [a]
rxs)

-- | A rising edge detector. Useful for things like detecting key presses.
-- It is initialised as /up/, meaning that events occurring at time 0 will
-- not be detected.
edge :: SF Bool (Event ())
edge :: SF Bool (Event ())
edge = Bool -> SF Bool (Event ())
iEdge Bool
True

-- | A rising edge detector that can be initialized as up ('True', meaning
--   that events occurring at time 0 will not be detected) or down
--   ('False', meaning that events occurring at time 0 will be detected).
iEdge :: Bool -> SF Bool (Event ())
iEdge :: Bool -> SF Bool (Event ())
iEdge Bool
b = 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) forall a. Event a
NoEvent
  where
    f :: Int -> Bool -> Maybe (Int, Event ())
    f :: Int -> Bool -> Maybe (Int, Event ())
f Int
0 Bool
False = forall a. Maybe a
Nothing
    f Int
0 Bool
True  = forall a. a -> Maybe a
Just (Int
1, forall a. a -> Event a
Event ())
    f Int
1 Bool
False = forall a. a -> Maybe a
Just (Int
0, forall a. Event a
NoEvent)
    f Int
1 Bool
True  = forall a. a -> Maybe a
Just (Int
2, forall a. Event a
NoEvent)
    f Int
2 Bool
False = forall a. a -> Maybe a
Just (Int
0, forall a. Event a
NoEvent)
    f Int
2 Bool
True  = forall a. Maybe a
Nothing
    f Int
_ Bool
_     = forall a. HasCallStack => a
undefined

-- | Like 'edge', but parameterized on the tag value.
edgeTag :: a -> SF Bool (Event a)
edgeTag :: forall a. a -> SF Bool (Event a)
edgeTag a
a = SF Bool (Event ())
edge forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b. Event a -> b -> Event b
`tag` a
a)

-- | Edge detector particularized for detecting transitions
--   on a 'Maybe' signal from 'Nothing' to 'Just'.
edgeJust :: SF (Maybe a) (Event a)
edgeJust :: forall a. SF (Maybe a) (Event a)
edgeJust = forall a b. (a -> a -> Maybe b) -> a -> SF a (Event b)
edgeBy forall {a} {a}. Maybe a -> Maybe a -> Maybe a
isJustEdge (forall a. a -> Maybe a
Just forall a. HasCallStack => a
undefined)
  where
    isJustEdge :: Maybe a -> Maybe a -> Maybe a
isJustEdge Maybe a
Nothing  Maybe a
Nothing     = forall a. Maybe a
Nothing
    isJustEdge Maybe a
Nothing  ma :: Maybe a
ma@(Just a
_) = Maybe a
ma
    isJustEdge (Just a
_) (Just a
_)    = forall a. Maybe a
Nothing
    isJustEdge (Just a
_) Maybe a
Nothing     = forall a. Maybe a
Nothing

-- | Edge detector parameterized on the edge detection function and initial
-- state, i.e., the previous input sample. The first argument to the
-- edge detection function is the previous sample, the second the current one.
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
a_init = 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, forall a. Maybe a -> Event a
maybeToEvent (a -> a -> Maybe b
isEdge a
a_init a
a0))

    ebAux :: a -> SF' a (Event b)
ebAux a
a_prev = forall a b. (Time -> a -> Transition a b) -> SF' a b
SF' forall {p}. p -> a -> Transition a (Event b)
tf -- True
      where
        tf :: p -> a -> Transition a (Event b)
tf p
_ a
a = (a -> SF' a (Event b)
ebAux a
a, forall a. Maybe a -> Event a
maybeToEvent (a -> a -> Maybe b
isEdge a
a_prev a
a))

-- * Stateful event suppression

-- | Suppression of initial (at local time 0) event.
notYet :: SF (Event a) (Event a)
notYet :: forall a. SF (Event a) (Event a)
notYet = forall a. a -> SF a a
initially forall a. Event a
NoEvent

-- | Suppress all but the first event.
once :: SF (Event a) (Event a)
once :: forall a. SF (Event a) (Event a)
once = forall a. Int -> SF (Event a) (Event a)
takeEvents Int
1

-- | Suppress all but the first n events.
takeEvents :: Int -> SF (Event a) (Event a)
takeEvents :: forall a. Int -> SF (Event a) (Event a)
takeEvents Int
n | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a b. SF a (Event b)
never
takeEvents Int
n = forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> (a, a)
dup) (forall a b. a -> b -> a
const (forall a. Event a
NoEvent forall a b. a -> SF a b -> SF a b
>-- forall a. Int -> SF (Event a) (Event a)
takeEvents (Int
n forall a. Num a => a -> a -> a
- Int
1)))

-- | Suppress first n events.
dropEvents :: Int -> SF (Event a) (Event a)
dropEvents :: forall a. Int -> SF (Event a) (Event a)
dropEvents Int
n | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0  = forall a. SF a a
identity
dropEvents Int
n =
  -- Here dSwitch or switch does not really matter.
  forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch (forall a b. SF a (Event b)
never forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. SF a a
identity)
          (forall a b. a -> b -> a
const (forall a. Event a
NoEvent forall a b. a -> SF a b -> SF a b
>-- forall a. Int -> SF (Event a) (Event a)
dropEvents (Int
n forall a. Num a => a -> a -> a
- Int
1)))

-- ** Hybrid continuous-to-discrete SF combinators.

-- | Event source with a single occurrence at time 0. The value of the event is
-- obtained by sampling the input at that time.
snap :: SF a (Event a)
snap :: forall a. SF a (Event a)
snap =
  -- switch ensures that the entire signal function will become just
  -- "constant" once the sample has been taken.
  forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (forall a b. SF a (Event b)
never forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (forall a. SF a a
identity forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall b a. b -> SF a (Event b)
now () forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ \(a
a, Event ()
e) -> Event ()
e forall a b. Event a -> b -> Event b
`tag` a
a)) forall b a. b -> SF a (Event b)
now

-- | Event source with a single occurrence at or as soon after (local) time
-- @t_ev@ as possible. The value of the event is obtained by sampling the input
-- a that time.
snapAfter :: Time -> SF a (Event a)
snapAfter :: forall a. Time -> SF a (Event a)
snapAfter Time
t_ev =
  forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (forall a b. SF a (Event b)
never forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (forall a. SF a a
identity forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall b a. Time -> b -> SF a (Event b)
after Time
t_ev () forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ \(a
a, Event ()
e) -> Event ()
e forall a b. Event a -> b -> Event b
`tag` a
a)) forall b a. b -> SF a (Event b)
now

-- | Sample a signal at regular intervals.
sample :: Time -> SF a (Event a)
sample :: forall a. Time -> SF a (Event a)
sample Time
p_ev = forall a. SF a a
identity forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall b a. Time -> b -> SF a (Event b)
repeatedly Time
p_ev () forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ \(a
a, Event ()
e) -> Event ()
e forall a b. Event a -> b -> Event b
`tag` a
a

-- | Window sampling
--
-- First argument is the window length wl, second is the sampling interval t.
-- The output list should contain (min (truncate (T/t) wl)) samples, where
-- T is the time the signal function has been running. This requires some
-- care in case of sparse sampling. In case of sparse sampling, the
-- current input value is assumed to have been present at all points where
-- sampling was missed.
sampleWindow :: Int -> Time -> SF a (Event [a])
sampleWindow :: forall a. Int -> Time -> SF a (Event [a])
sampleWindow Int
wl Time
q =
    forall a. SF a a
identity forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall b a. [(Time, b)] -> SF a (Event [b])
afterEachCat (forall a. a -> [a]
repeat (Time
q, ()))
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(a
a, Event [()]
e) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const a
a)) Event [()]
e)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall b a. (b -> a -> b) -> b -> SF (Event a) (Event b)
accumBy forall {a}. [a] -> [a] -> [a]
updateWindow []
  where
    updateWindow :: [a] -> [a] -> [a]
updateWindow [a]
w [a]
as = forall a. Int -> [a] -> [a]
drop (forall a. Ord a => a -> a -> a
max (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
w' forall a. Num a => a -> a -> a
- Int
wl) Int
0) [a]
w'
      where w' :: [a]
w' = [a]
w forall {a}. [a] -> [a] -> [a]
++ [a]
as

-- * Repetition and switching

-- | Makes an event source recurring by restarting it as soon as it has an
-- occurrence.
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 = forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (forall a b. SF a (Event b)
never forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SF a (Event b)
sfe) forall a b. (a -> b) -> a -> b
$ \b
b -> forall a. a -> Event a
Event b
b forall b a. b -> SF a b -> SF a b
--> (forall a b. SF a (Event b) -> SF a (Event b)
recur (forall a. Event a
NoEventforall b a. b -> SF a b -> SF a b
-->SF a (Event b)
sfe))

-- | Apply the first SF until it produces an event, and, afterwards, switch to
-- the second SF. This is just a convenience function, used to write what
-- sometimes is more understandable switch-based code.
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 = forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch (SF a (Event b)
sfe1 forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a. a -> (a, a)
dup) (forall a b. a -> b -> a
const SF a (Event b)
sfe2)