-- |
-- Module:     Control.Wire.Event
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>

module Control.Wire.Event
    ( -- * Events
      Event,

      -- * Time-based
      at,
      never,
      now,
      periodic,
      periodicList,

      -- * Signal analysis
      became,
      noLonger,
      edge,

      -- * Modifiers
      (<&),
      (&>),
      dropE,
      dropWhileE,
      filterE,
      merge,
      mergeL,
      mergeR,
      notYet,
      once,
      takeE,
      takeWhileE,

      -- * Scans
      accumE,
      accum1E,
      iterateE,
      -- ** Special scans
      maximumE,
      minimumE,
      productE,
      sumE
    )
    where

import Control.Applicative
import Control.Arrow
import Control.Monad.Fix
import Control.Wire.Core
import Control.Wire.Session
import Control.Wire.Unsafe.Event
import Data.Fixed


-- | Merge events with the leftmost event taking precedence.  Equivalent
-- to using the monoid interface with 'First'.  Infixl 5.
--
-- * Depends: now on both.
--
-- * Inhibits: when any of the two wires inhibit.

(<&) :: (Monad m) => Wire s e m a (Event b) -> Wire s e m a (Event b) -> Wire s e m a (Event b)
<& :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a (Event b)
-> Wire s e m a (Event b) -> Wire s e m a (Event b)
(<&) = (Event b -> Event b -> Event b)
-> Wire s e m a (Event b)
-> Wire s e m a (Event b)
-> Wire s e m a (Event b)
forall a b c.
(a -> b -> c) -> Wire s e m a a -> Wire s e m a b -> Wire s e m a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((b -> b -> b) -> Event b -> Event b -> Event b
forall a. (a -> a -> a) -> Event a -> Event a -> Event a
merge b -> b -> b
forall a b. a -> b -> a
const)

infixl 5 <&


-- | Merge events with the rightmost event taking precedence.
-- Equivalent to using the monoid interface with 'Last'.  Infixl 5.
--
-- * Depends: now on both.
--
-- * Inhibits: when any of the two wires inhibit.

(&>) :: (Monad m) => Wire s e m a (Event b) -> Wire s e m a (Event b) -> Wire s e m a (Event b)
&> :: forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a (Event b)
-> Wire s e m a (Event b) -> Wire s e m a (Event b)
(&>) = (Event b -> Event b -> Event b)
-> Wire s e m a (Event b)
-> Wire s e m a (Event b)
-> Wire s e m a (Event b)
forall a b c.
(a -> b -> c) -> Wire s e m a a -> Wire s e m a b -> Wire s e m a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((b -> b -> b) -> Event b -> Event b -> Event b
forall a. (a -> a -> a) -> Event a -> Event a -> Event a
merge ((b -> b) -> b -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
id))

infixl 5 &>


-- | Left scan for events.  Each time an event occurs, apply the given
-- function.
--
-- * Depends: now.

accumE ::
    (b -> a -> b)  -- ^ Fold function
    -> b           -- ^ Initial value.
    -> Wire s e m (Event a) (Event b)
accumE :: forall b a s e (m :: * -> *).
(b -> a -> b) -> b -> Wire s e m (Event a) (Event b)
accumE b -> a -> b
f = b -> Wire s e m (Event a) (Event b)
forall {s} {e} {m :: * -> *}. b -> Wire s e m (Event a) (Event b)
loop
    where
    loop :: b -> Wire s e m (Event a) (Event b)
loop b
x' =
        (Event a -> (Event b, Wire s e m (Event a) (Event b)))
-> Wire s e m (Event a) (Event b)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((Event a -> (Event b, Wire s e m (Event a) (Event b)))
 -> Wire s e m (Event a) (Event b))
-> (Event a -> (Event b, Wire s e m (Event a) (Event b)))
-> Wire s e m (Event a) (Event b)
forall a b. (a -> b) -> a -> b
$
            (Event b, Wire s e m (Event a) (Event b))
-> (a -> (Event b, Wire s e m (Event a) (Event b)))
-> Event a
-> (Event b, Wire s e m (Event a) (Event b))
forall b a. b -> (a -> b) -> Event a -> b
event (Event b
forall a. Event a
NoEvent, b -> Wire s e m (Event a) (Event b)
loop b
x')
                  (\a
y -> let x :: b
x = b -> a -> b
f b
x' a
y in (b -> Event b
forall a. a -> Event a
Event b
x, b -> Wire s e m (Event a) (Event b)
loop b
x))


-- | Left scan for events with no initial value.  Each time an event
-- occurs, apply the given function.  The first event is produced
-- unchanged.
--
-- * Depends: now.

accum1E ::
    (a -> a -> a)  -- ^ Fold function
    -> Wire s e m (Event a) (Event a)
accum1E :: forall a s e (m :: * -> *).
(a -> a -> a) -> Wire s e m (Event a) (Event a)
accum1E a -> a -> a
f = Wire s e m (Event a) (Event a)
forall {s} {e} {m :: * -> *}. Wire s e m (Event a) (Event a)
initial
    where
    initial :: Wire s e m (Event a) (Event a)
initial =
        (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((Event a -> (Event a, Wire s e m (Event a) (Event a)))
 -> Wire s e m (Event a) (Event a))
-> (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ (Event a, Wire s e m (Event a) (Event a))
-> (a -> (Event a, Wire s e m (Event a) (Event a)))
-> Event a
-> (Event a, Wire s e m (Event a) (Event a))
forall b a. b -> (a -> b) -> Event a -> b
event (Event a
forall a. Event a
NoEvent, Wire s e m (Event a) (Event a)
initial) (a -> Event a
forall a. a -> Event a
Event (a -> Event a)
-> (a -> Wire s e m (Event a) (Event a))
-> a
-> (Event a, Wire s e m (Event a) (Event a))
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (a -> a -> a) -> a -> Wire s e m (Event a) (Event a)
forall b a s e (m :: * -> *).
(b -> a -> b) -> b -> Wire s e m (Event a) (Event b)
accumE a -> a -> a
f)


-- | At the given point in time.
--
-- * Depends: now when occurring.

at ::
    (HasTime t s)
    => t  -- ^ Time of occurrence.
    -> Wire s e m a (Event a)
at :: forall t s e (m :: * -> *) a.
HasTime t s =>
t -> Wire s e m a (Event a)
at t
t' =
    (s -> a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> a -> (Event a, Wire s e m a (Event a)))
 -> Wire s e m a (Event a))
-> (s -> a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall a b. (a -> b) -> a -> b
$ \s
ds a
x ->
        let t :: t
t = t
t' t -> t -> t
forall a. Num a => a -> a -> a
- s -> t
forall t s. HasTime t s => s -> t
dtime s
ds
        in if t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0
             then (a -> Event a
forall a. a -> Event a
Event a
x, Wire s e m a (Event a)
forall s e (m :: * -> *) a b. Wire s e m a (Event b)
never)
             else (Event a
forall a. Event a
NoEvent, t -> Wire s e m a (Event a)
forall t s e (m :: * -> *) a.
HasTime t s =>
t -> Wire s e m a (Event a)
at t
t)


-- | Occurs each time the predicate becomes true for the input signal,
-- for example each time a given threshold is reached.
--
-- * Depends: now.

became :: (a -> Bool) -> Wire s e m a (Event a)
became :: forall a s e (m :: * -> *). (a -> Bool) -> Wire s e m a (Event a)
became a -> Bool
p = Wire s e m a (Event a)
forall {s} {e} {m :: * -> *}. Wire s e m a (Event a)
off
    where
    off :: Wire s e m a (Event a)
off = (a -> (Event a, Wire s e m a (Event a))) -> Wire s e m a (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (Event a, Wire s e m a (Event a)))
 -> Wire s e m a (Event a))
-> (a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall a b. (a -> b) -> a -> b
$ \a
x -> if a -> Bool
p a
x then (a -> Event a
forall a. a -> Event a
Event a
x, Wire s e m a (Event a)
on) else (Event a
forall a. Event a
NoEvent, Wire s e m a (Event a)
off)
    on :: Wire s e m a (Event a)
on = (a -> (Event a, Wire s e m a (Event a))) -> Wire s e m a (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (Event a, Wire s e m a (Event a)))
 -> Wire s e m a (Event a))
-> (a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall a b. (a -> b) -> a -> b
$ \a
x -> (Event a
forall a. Event a
NoEvent, if a -> Bool
p a
x then Wire s e m a (Event a)
on else Wire s e m a (Event a)
off)


-- | Forget the first given number of occurrences.
--
-- * Depends: now.

dropE :: Int -> Wire s e m (Event a) (Event a)
dropE :: forall s e (m :: * -> *) a. Int -> Wire s e m (Event a) (Event a)
dropE Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Wire s e m (Event a) (Event a)
forall s e (m :: * -> *) a. Wire s e m a a
mkId
dropE Int
n =
    (Wire s e m (Event a) (Event a) -> Wire s e m (Event a) (Event a))
-> Wire s e m (Event a) (Event a)
forall a. (a -> a) -> a
fix ((Wire s e m (Event a) (Event a) -> Wire s e m (Event a) (Event a))
 -> Wire s e m (Event a) (Event a))
-> (Wire s e m (Event a) (Event a)
    -> Wire s e m (Event a) (Event a))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ \Wire s e m (Event a) (Event a)
again ->
    (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((Event a -> (Event a, Wire s e m (Event a) (Event a)))
 -> Wire s e m (Event a) (Event a))
-> (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ \Event a
mev ->
        (Event a
forall a. Event a
NoEvent, if Event a -> Bool
forall a. Event a -> Bool
occurred Event a
mev then Int -> Wire s e m (Event a) (Event a)
forall s e (m :: * -> *) a. Int -> Wire s e m (Event a) (Event a)
dropE (Int -> Int
forall a. Enum a => a -> a
pred Int
n) else Wire s e m (Event a) (Event a)
again)


-- | Forget all initial occurrences until the given predicate becomes
-- false.
--
-- * Depends: now.

dropWhileE :: (a -> Bool) -> Wire s e m (Event a) (Event a)
dropWhileE :: forall a s e (m :: * -> *).
(a -> Bool) -> Wire s e m (Event a) (Event a)
dropWhileE a -> Bool
p =
    (Wire s e m (Event a) (Event a) -> Wire s e m (Event a) (Event a))
-> Wire s e m (Event a) (Event a)
forall a. (a -> a) -> a
fix ((Wire s e m (Event a) (Event a) -> Wire s e m (Event a) (Event a))
 -> Wire s e m (Event a) (Event a))
-> (Wire s e m (Event a) (Event a)
    -> Wire s e m (Event a) (Event a))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ \Wire s e m (Event a) (Event a)
again ->
    (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((Event a -> (Event a, Wire s e m (Event a) (Event a)))
 -> Wire s e m (Event a) (Event a))
-> (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ \Event a
mev ->
        case Event a
mev of
          Event a
x | Bool -> Bool
not (a -> Bool
p a
x) -> (Event a
mev, Wire s e m (Event a) (Event a)
forall s e (m :: * -> *) a. Wire s e m a a
mkId)
          Event a
_ -> (Event a
forall a. Event a
NoEvent, Wire s e m (Event a) (Event a)
again)


-- | Forget all occurrences for which the given predicate is false.
--
-- * Depends: now.

filterE :: (a -> Bool) -> Wire s e m (Event a) (Event a)
filterE :: forall a s e (m :: * -> *).
(a -> Bool) -> Wire s e m (Event a) (Event a)
filterE a -> Bool
p =
    (Event a -> Event a) -> Wire s e m (Event a) (Event a)
forall a b s e (m :: * -> *). (a -> b) -> Wire s e m a b
mkSF_ ((Event a -> Event a) -> Wire s e m (Event a) (Event a))
-> (Event a -> Event a) -> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ \Event a
mev ->
        case Event a
mev of
          Event a
x | a -> Bool
p a
x -> Event a
mev
          Event a
_ -> Event a
forall a. Event a
NoEvent


-- | On each occurrence, apply the function the event carries.
--
-- * Depends: now.

iterateE :: a -> Wire s e m (Event (a -> a)) (Event a)
iterateE :: forall a s e (m :: * -> *).
a -> Wire s e m (Event (a -> a)) (Event a)
iterateE = (a -> (a -> a) -> a) -> a -> Wire s e m (Event (a -> a)) (Event a)
forall b a s e (m :: * -> *).
(b -> a -> b) -> b -> Wire s e m (Event a) (Event b)
accumE (\a
x a -> a
f -> a -> a
f a
x)


-- | Maximum of all events.
--
-- * Depends: now.

maximumE :: (Ord a) => Wire s e m (Event a) (Event a)
maximumE :: forall a s e (m :: * -> *). Ord a => Wire s e m (Event a) (Event a)
maximumE = (a -> a -> a) -> Wire s e m (Event a) (Event a)
forall a s e (m :: * -> *).
(a -> a -> a) -> Wire s e m (Event a) (Event a)
accum1E a -> a -> a
forall a. Ord a => a -> a -> a
max


-- | Minimum of all events.
--
-- * Depends: now.

minimumE :: (Ord a) => Wire s e m (Event a) (Event a)
minimumE :: forall a s e (m :: * -> *). Ord a => Wire s e m (Event a) (Event a)
minimumE = (a -> a -> a) -> Wire s e m (Event a) (Event a)
forall a s e (m :: * -> *).
(a -> a -> a) -> Wire s e m (Event a) (Event a)
accum1E a -> a -> a
forall a. Ord a => a -> a -> a
min


-- | Left-biased event merge.

mergeL :: Event a -> Event a -> Event a
mergeL :: forall a. Event a -> Event a -> Event a
mergeL = (a -> a -> a) -> Event a -> Event a -> Event a
forall a. (a -> a -> a) -> Event a -> Event a -> Event a
merge a -> a -> a
forall a b. a -> b -> a
const


-- | Right-biased event merge.

mergeR :: Event a -> Event a -> Event a
mergeR :: forall a. Event a -> Event a -> Event a
mergeR = (a -> a -> a) -> Event a -> Event a -> Event a
forall a. (a -> a -> a) -> Event a -> Event a -> Event a
merge ((a -> a) -> a -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id)


-- | Never occurs.

never :: Wire s e m a (Event b)
never :: forall s e (m :: * -> *) a b. Wire s e m a (Event b)
never = Either e (Event b) -> Wire s e m a (Event b)
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
mkConst (Event b -> Either e (Event b)
forall a b. b -> Either a b
Right Event b
forall a. Event a
NoEvent)


-- | Occurs each time the predicate becomes false for the input signal,
-- for example each time a given threshold is no longer exceeded.
--
-- * Depends: now.

noLonger :: (a -> Bool) -> Wire s e m a (Event a)
noLonger :: forall a s e (m :: * -> *). (a -> Bool) -> Wire s e m a (Event a)
noLonger a -> Bool
p = Wire s e m a (Event a)
forall {s} {e} {m :: * -> *}. Wire s e m a (Event a)
off
    where
    off :: Wire s e m a (Event a)
off = (a -> (Event a, Wire s e m a (Event a))) -> Wire s e m a (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (Event a, Wire s e m a (Event a)))
 -> Wire s e m a (Event a))
-> (a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall a b. (a -> b) -> a -> b
$ \a
x -> if a -> Bool
p a
x then (Event a
forall a. Event a
NoEvent, Wire s e m a (Event a)
off) else (a -> Event a
forall a. a -> Event a
Event a
x, Wire s e m a (Event a)
on)
    on :: Wire s e m a (Event a)
on = (a -> (Event a, Wire s e m a (Event a))) -> Wire s e m a (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (Event a, Wire s e m a (Event a)))
 -> Wire s e m a (Event a))
-> (a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall a b. (a -> b) -> a -> b
$ \a
x -> (Event a
forall a. Event a
NoEvent, if a -> Bool
p a
x then Wire s e m a (Event a)
off else Wire s e m a (Event a)
on)


-- | Events occur first when the predicate is false then when it is
-- true, and then this pattern repeats.
--
-- * Depends: now.

edge :: (a -> Bool) -> Wire s e m a (Event a)
edge :: forall a s e (m :: * -> *). (a -> Bool) -> Wire s e m a (Event a)
edge a -> Bool
p = Wire s e m a (Event a)
forall {s} {e} {m :: * -> *}. Wire s e m a (Event a)
off
    where
    off :: Wire s e m a (Event a)
off = (a -> (Event a, Wire s e m a (Event a))) -> Wire s e m a (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (Event a, Wire s e m a (Event a)))
 -> Wire s e m a (Event a))
-> (a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall a b. (a -> b) -> a -> b
$ \a
x -> if a -> Bool
p a
x then (a -> Event a
forall a. a -> Event a
Event a
x, Wire s e m a (Event a)
on) else (Event a
forall a. Event a
NoEvent, Wire s e m a (Event a)
off)
    on :: Wire s e m a (Event a)
on = (a -> (Event a, Wire s e m a (Event a))) -> Wire s e m a (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (Event a, Wire s e m a (Event a)))
 -> Wire s e m a (Event a))
-> (a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall a b. (a -> b) -> a -> b
$ \a
x -> if a -> Bool
p a
x then (Event a
forall a. Event a
NoEvent, Wire s e m a (Event a)
on) else (a -> Event a
forall a. a -> Event a
Event a
x, Wire s e m a (Event a)
off)


-- | Forget the first occurrence.
--
-- * Depends: now.

notYet :: Wire s e m (Event a) (Event a)
notYet :: forall s e (m :: * -> *) a. Wire s e m (Event a) (Event a)
notYet =
    (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((Event a -> (Event a, Wire s e m (Event a) (Event a)))
 -> Wire s e m (Event a) (Event a))
-> (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ (Event a, Wire s e m (Event a) (Event a))
-> (a -> (Event a, Wire s e m (Event a) (Event a)))
-> Event a
-> (Event a, Wire s e m (Event a) (Event a))
forall b a. b -> (a -> b) -> Event a -> b
event (Event a
forall a. Event a
NoEvent, Wire s e m (Event a) (Event a)
forall s e (m :: * -> *) a. Wire s e m (Event a) (Event a)
notYet) ((Event a, Wire s e m (Event a) (Event a))
-> a -> (Event a, Wire s e m (Event a) (Event a))
forall a b. a -> b -> a
const (Event a
forall a. Event a
NoEvent, Wire s e m (Event a) (Event a)
forall s e (m :: * -> *) a. Wire s e m a a
mkId))


-- | Occurs once immediately.
--
-- * Depends: now when occurring.

now :: Wire s e m a (Event a)
now :: forall s e (m :: * -> *) a. Wire s e m a (Event a)
now = (a -> (Event a, Wire s e m a (Event a))) -> Wire s e m a (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (Event a, Wire s e m a (Event a)))
 -> Wire s e m a (Event a))
-> (a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> Event a
forall a. a -> Event a
Event a
x, Wire s e m a (Event a)
forall s e (m :: * -> *) a b. Wire s e m a (Event b)
never)


-- | Forget all occurrences except the first.
--
-- * Depends: now when occurring.

once :: Wire s e m (Event a) (Event a)
once :: forall s e (m :: * -> *) a. Wire s e m (Event a) (Event a)
once =
    (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((Event a -> (Event a, Wire s e m (Event a) (Event a)))
 -> Wire s e m (Event a) (Event a))
-> (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ \Event a
mev ->
        (Event a
mev, if Event a -> Bool
forall a. Event a -> Bool
occurred Event a
mev then Wire s e m (Event a) (Event a)
forall s e (m :: * -> *) a b. Wire s e m a (Event b)
never else Wire s e m (Event a) (Event a)
forall s e (m :: * -> *) a. Wire s e m (Event a) (Event a)
once)


-- | Periodic occurrence with the given time period.  First occurrence
-- is now.
--
-- * Depends: now when occurring.

periodic :: (HasTime t s) => t -> Wire s e m a (Event a)
periodic :: forall t s e (m :: * -> *) a.
HasTime t s =>
t -> Wire s e m a (Event a)
periodic t
int | t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [Char] -> Wire s e m a (Event a)
forall a. HasCallStack => [Char] -> a
error [Char]
"periodic: Non-positive interval"
periodic t
int = (a -> (Event a, Wire s e m a (Event a))) -> Wire s e m a (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (Event a, Wire s e m a (Event a)))
 -> Wire s e m a (Event a))
-> (a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> Event a
forall a. a -> Event a
Event a
x, t -> Wire s e m a (Event a)
forall {s} {e} {m :: * -> *} {a}.
HasTime t s =>
t -> Wire s e m a (Event a)
loop t
int)
    where
    loop :: t -> Wire s e m a (Event a)
loop t
0 = t -> Wire s e m a (Event a)
loop t
int
    loop t
t' =
        (s -> a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> a -> (Event a, Wire s e m a (Event a)))
 -> Wire s e m a (Event a))
-> (s -> a -> (Event a, Wire s e m a (Event a)))
-> Wire s e m a (Event a)
forall a b. (a -> b) -> a -> b
$ \s
ds a
x ->
            let t :: t
t = t
t' t -> t -> t
forall a. Num a => a -> a -> a
- s -> t
forall t s. HasTime t s => s -> t
dtime s
ds
            in if t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0
                 then (a -> Event a
forall a. a -> Event a
Event a
x, t -> Wire s e m a (Event a)
loop (t -> t -> t
forall a. Real a => a -> a -> a
mod' t
t t
int))
                 else (Event a
forall a. Event a
NoEvent, t -> Wire s e m a (Event a)
loop t
t)


-- | Periodic occurrence with the given time period.  First occurrence
-- is now.  The event values are picked one by one from the given list.
-- When the list is exhausted, the event does not occur again.

periodicList :: (HasTime t s) => t -> [b] -> Wire s e m a (Event b)
periodicList :: forall t s b e (m :: * -> *) a.
HasTime t s =>
t -> [b] -> Wire s e m a (Event b)
periodicList t
int [b]
_ | t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [Char] -> Wire s e m a (Event b)
forall a. HasCallStack => [Char] -> a
error [Char]
"periodic: Non-positive interval"
periodicList t
_ [] = Wire s e m a (Event b)
forall s e (m :: * -> *) a b. Wire s e m a (Event b)
never
periodicList t
int (b
x:[b]
xs) = (a -> (Event b, Wire s e m a (Event b))) -> Wire s e m a (Event b)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (Event b, Wire s e m a (Event b)))
 -> Wire s e m a (Event b))
-> (a -> (Event b, Wire s e m a (Event b)))
-> Wire s e m a (Event b)
forall a b. (a -> b) -> a -> b
$ \a
_ -> (b -> Event b
forall a. a -> Event a
Event b
x, t -> [b] -> Wire s e m a (Event b)
forall {s} {b} {e} {m :: * -> *} {a}.
HasTime t s =>
t -> [b] -> Wire s e m a (Event b)
loop t
int [b]
xs)
    where
    loop :: t -> [b] -> Wire s e m a (Event b)
loop t
_ [] = Wire s e m a (Event b)
forall s e (m :: * -> *) a b. Wire s e m a (Event b)
never
    loop t
0 [b]
xs = t -> [b] -> Wire s e m a (Event b)
loop t
int [b]
xs
    loop t
t' xs0 :: [b]
xs0@(b
x:[b]
xs) =
        (s -> a -> (Event b, Wire s e m a (Event b)))
-> Wire s e m a (Event b)
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> a -> (Event b, Wire s e m a (Event b)))
 -> Wire s e m a (Event b))
-> (s -> a -> (Event b, Wire s e m a (Event b)))
-> Wire s e m a (Event b)
forall a b. (a -> b) -> a -> b
$ \s
ds a
_ ->
            let t :: t
t = t
t' t -> t -> t
forall a. Num a => a -> a -> a
- s -> t
forall t s. HasTime t s => s -> t
dtime s
ds
            in if t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0
                 then (b -> Event b
forall a. a -> Event a
Event b
x, t -> [b] -> Wire s e m a (Event b)
loop (t -> t -> t
forall a. Real a => a -> a -> a
mod' t
t t
int) [b]
xs)
                 else (Event b
forall a. Event a
NoEvent, t -> [b] -> Wire s e m a (Event b)
loop t
t [b]
xs0)


-- | Product of all events.
--
-- * Depends: now.

productE :: (Num a) => Wire s e m (Event a) (Event a)
productE :: forall a s e (m :: * -> *). Num a => Wire s e m (Event a) (Event a)
productE = (a -> a -> a) -> a -> Wire s e m (Event a) (Event a)
forall b a s e (m :: * -> *).
(b -> a -> b) -> b -> Wire s e m (Event a) (Event b)
accumE a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1


-- | Sum of all events.
--
-- * Depends: now.

sumE :: (Num a) => Wire s e m (Event a) (Event a)
sumE :: forall a s e (m :: * -> *). Num a => Wire s e m (Event a) (Event a)
sumE = (a -> a -> a) -> a -> Wire s e m (Event a) (Event a)
forall b a s e (m :: * -> *).
(b -> a -> b) -> b -> Wire s e m (Event a) (Event b)
accumE a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0


-- | Forget all but the first given number of occurrences.
--
-- * Depends: now.

takeE :: Int -> Wire s e m (Event a) (Event a)
takeE :: forall s e (m :: * -> *) a. Int -> Wire s e m (Event a) (Event a)
takeE Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Wire s e m (Event a) (Event a)
forall s e (m :: * -> *) a b. Wire s e m a (Event b)
never
takeE Int
n =
    (Wire s e m (Event a) (Event a) -> Wire s e m (Event a) (Event a))
-> Wire s e m (Event a) (Event a)
forall a. (a -> a) -> a
fix ((Wire s e m (Event a) (Event a) -> Wire s e m (Event a) (Event a))
 -> Wire s e m (Event a) (Event a))
-> (Wire s e m (Event a) (Event a)
    -> Wire s e m (Event a) (Event a))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ \Wire s e m (Event a) (Event a)
again ->
    (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((Event a -> (Event a, Wire s e m (Event a) (Event a)))
 -> Wire s e m (Event a) (Event a))
-> (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ \Event a
mev ->
        (Event a
mev, if Event a -> Bool
forall a. Event a -> Bool
occurred Event a
mev then Int -> Wire s e m (Event a) (Event a)
forall s e (m :: * -> *) a. Int -> Wire s e m (Event a) (Event a)
takeE (Int -> Int
forall a. Enum a => a -> a
pred Int
n) else Wire s e m (Event a) (Event a)
again)


-- | Forget all but the initial occurrences for which the given
-- predicate is true.
--
-- * Depends: now.

takeWhileE :: (a -> Bool) -> Wire s e m (Event a) (Event a)
takeWhileE :: forall a s e (m :: * -> *).
(a -> Bool) -> Wire s e m (Event a) (Event a)
takeWhileE a -> Bool
p =
    (Wire s e m (Event a) (Event a) -> Wire s e m (Event a) (Event a))
-> Wire s e m (Event a) (Event a)
forall a. (a -> a) -> a
fix ((Wire s e m (Event a) (Event a) -> Wire s e m (Event a) (Event a))
 -> Wire s e m (Event a) (Event a))
-> (Wire s e m (Event a) (Event a)
    -> Wire s e m (Event a) (Event a))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ \Wire s e m (Event a) (Event a)
again ->
    (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((Event a -> (Event a, Wire s e m (Event a) (Event a)))
 -> Wire s e m (Event a) (Event a))
-> (Event a -> (Event a, Wire s e m (Event a) (Event a)))
-> Wire s e m (Event a) (Event a)
forall a b. (a -> b) -> a -> b
$ \Event a
mev ->
        case Event a
mev of
          Event a
x | Bool -> Bool
not (a -> Bool
p a
x) -> (Event a
forall a. Event a
NoEvent, Wire s e m (Event a) (Event a)
forall s e (m :: * -> *) a b. Wire s e m a (Event b)
never)
          Event a
_ -> (Event a
mev, Wire s e m (Event a) (Event a)
again)