module Control.Wire.Event
(
Event,
at,
never,
now,
periodic,
periodicList,
became,
noLonger,
edge,
(<&),
(&>),
dropE,
dropWhileE,
filterE,
merge,
mergeL,
mergeR,
notYet,
once,
takeE,
takeWhileE,
accumE,
accum1E,
iterateE,
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
(<&) :: (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 <&
(&>) :: (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 &>
accumE ::
(b -> a -> b)
-> b
-> 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))
accum1E ::
(a -> a -> a)
-> 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 ::
(HasTime t s)
=> t
-> 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)
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)
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)
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)
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
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)
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
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
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
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 :: 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)
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)
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)
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))
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)
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 :: (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)
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)
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
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
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)
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)