module Control.Wire.Interval
(
inhibit,
after,
for,
unless,
when,
asSoonAs,
between,
hold,
holdFor,
until
)
where
import Control.Arrow
import Control.Wire.Core
import Control.Wire.Event
import Control.Wire.Session
import Control.Wire.Unsafe.Event
import Data.Monoid
import Prelude hiding (until)
after :: (HasTime t s, Monoid e) => t -> Wire s e m a a
after :: forall t s e (m :: * -> *) a.
(HasTime t s, Monoid e) =>
t -> Wire s e m a a
after t
t' =
(s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a)
-> (s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a 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 -> Either e a
forall a b. b -> Either a b
Right a
x, Wire s e m a a
forall s e (m :: * -> *) a. Wire s e m a a
mkId)
else (e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty, t -> Wire s e m a a
forall t s e (m :: * -> *) a.
(HasTime t s, Monoid e) =>
t -> Wire s e m a a
after t
t)
asSoonAs :: (Monoid e) => Wire s e m (Event a) a
asSoonAs :: forall e s (m :: * -> *) a. Monoid e => Wire s e m (Event a) a
asSoonAs = Wire s e m (Event a) a
forall e s (m :: * -> *) a. Monoid e => Wire s e m (Event a) a
hold
between :: (Monoid e) => Wire s e m (a, Event b, Event c) a
between :: forall e s (m :: * -> *) a b c.
Monoid e =>
Wire s e m (a, Event b, Event c) a
between =
((a, Event b, Event c)
-> (Either e a, Wire s e m (a, Event b, Event c) a))
-> Wire s e m (a, Event b, Event c) a
forall a e b s (m :: * -> *).
(a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPureN (((a, Event b, Event c)
-> (Either e a, Wire s e m (a, Event b, Event c) a))
-> Wire s e m (a, Event b, Event c) a)
-> ((a, Event b, Event c)
-> (Either e a, Wire s e m (a, Event b, Event c) a))
-> Wire s e m (a, Event b, Event c) a
forall a b. (a -> b) -> a -> b
$ \(a
x, Event b
onEv, Event c
_) ->
(Either e a, Wire s e m (a, Event b, Event c) a)
-> (b -> (Either e a, Wire s e m (a, Event b, Event c) a))
-> Event b
-> (Either e a, Wire s e m (a, Event b, Event c) a)
forall b a. b -> (a -> b) -> Event a -> b
event (e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty, Wire s e m (a, Event b, Event c) a
forall e s (m :: * -> *) a b c.
Monoid e =>
Wire s e m (a, Event b, Event c) a
between)
((Either e a, Wire s e m (a, Event b, Event c) a)
-> b -> (Either e a, Wire s e m (a, Event b, Event c) a)
forall a b. a -> b -> a
const (a -> Either e a
forall a b. b -> Either a b
Right a
x, Wire s e m (a, Event b, Event c) a
forall {s} {m :: * -> *} {b} {b} {a}.
Wire s e m (b, Event b, Event a) b
active))
Event b
onEv
where
active :: Wire s e m (b, Event b, Event a) b
active =
((b, Event b, Event a)
-> (Either e b, Wire s e m (b, Event b, Event a) b))
-> Wire s e m (b, Event b, Event a) b
forall a e b s (m :: * -> *).
(a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPureN (((b, Event b, Event a)
-> (Either e b, Wire s e m (b, Event b, Event a) b))
-> Wire s e m (b, Event b, Event a) b)
-> ((b, Event b, Event a)
-> (Either e b, Wire s e m (b, Event b, Event a) b))
-> Wire s e m (b, Event b, Event a) b
forall a b. (a -> b) -> a -> b
$ \(b
x, Event b
_, Event a
offEv) ->
(Either e b, Wire s e m (b, Event b, Event a) b)
-> (a -> (Either e b, Wire s e m (b, Event b, Event a) b))
-> Event a
-> (Either e b, Wire s e m (b, Event b, Event a) b)
forall b a. b -> (a -> b) -> Event a -> b
event (b -> Either e b
forall a b. b -> Either a b
Right b
x, Wire s e m (b, Event b, Event a) b
active)
((Either e b, Wire s e m (b, Event b, Event a) b)
-> a -> (Either e b, Wire s e m (b, Event b, Event a) b)
forall a b. a -> b -> a
const (e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty, Wire s e m (b, Event b, Event a) b
forall e s (m :: * -> *) a b c.
Monoid e =>
Wire s e m (a, Event b, Event c) a
between))
Event a
offEv
for :: (HasTime t s, Monoid e) => t -> Wire s e m a a
for :: forall t s e (m :: * -> *) a.
(HasTime t s, Monoid e) =>
t -> Wire s e m a a
for t
t' =
(s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a)
-> (s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a 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 (e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty, Wire s e m a a
forall e s (m :: * -> *) a b. Monoid e => Wire s e m a b
mkEmpty)
else (a -> Either e a
forall a b. b -> Either a b
Right a
x, t -> Wire s e m a a
forall t s e (m :: * -> *) a.
(HasTime t s, Monoid e) =>
t -> Wire s e m a a
for t
t)
hold :: (Monoid e) => Wire s e m (Event a) a
hold :: forall e s (m :: * -> *) a. Monoid e => Wire s e m (Event a) a
hold =
(Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a
forall a e b s (m :: * -> *).
(a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPureN ((Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a)
-> (Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a
forall a b. (a -> b) -> a -> b
$
(Either e a, Wire s e m (Event a) a)
-> (a -> (Either e a, Wire s e m (Event a) a))
-> Event a
-> (Either e a, Wire s e m (Event a) a)
forall b a. b -> (a -> b) -> Event a -> b
event (e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty, Wire s e m (Event a) a
forall e s (m :: * -> *) a. Monoid e => Wire s e m (Event a) a
hold)
(a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a)
-> (a -> Wire s e m (Event a) a)
-> a
-> (Either e a, Wire s e m (Event a) 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 -> Wire s e m (Event a) a
forall {a} {s} {e} {m :: * -> *}. a -> Wire s e m (Event a) a
holdWith)
where
holdWith :: a -> Wire s e m (Event a) a
holdWith a
x =
(Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a
forall a e b s (m :: * -> *).
(a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPureN ((Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a)
-> (Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a
forall a b. (a -> b) -> a -> b
$
(Either e a, Wire s e m (Event a) a)
-> (a -> (Either e a, Wire s e m (Event a) a))
-> Event a
-> (Either e a, Wire s e m (Event a) a)
forall b a. b -> (a -> b) -> Event a -> b
event (a -> Either e a
forall a b. b -> Either a b
Right a
x, a -> Wire s e m (Event a) a
holdWith a
x)
(a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a)
-> (a -> Wire s e m (Event a) a)
-> a
-> (Either e a, Wire s e m (Event a) 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 -> Wire s e m (Event a) a
holdWith)
holdFor :: (HasTime t s, Monoid e) => t -> Wire s e m (Event a) a
holdFor :: forall t s e (m :: * -> *) a.
(HasTime t s, Monoid e) =>
t -> Wire s e m (Event a) a
holdFor t
int | t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [Char] -> Wire s e m (Event a) a
forall a. HasCallStack => [Char] -> a
error [Char]
"holdFor: Non-positive interval."
holdFor t
int = Wire s e m (Event a) a
forall {m :: * -> *} {a}. Wire s e m (Event a) a
off
where
off :: Wire s e m (Event a) a
off =
(s -> Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a)
-> (s -> Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a
forall a b. (a -> b) -> a -> b
$ \s
_ ->
(Either e a, Wire s e m (Event a) a)
-> (a -> (Either e a, Wire s e m (Event a) a))
-> Event a
-> (Either e a, Wire s e m (Event a) a)
forall b a. b -> (a -> b) -> Event a -> b
event (e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty, Wire s e m (Event a) a
off)
(a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a)
-> (a -> Wire s e m (Event a) a)
-> a
-> (Either e a, Wire s e m (Event a) 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')
&&& t -> a -> Wire s e m (Event a) a
on t
int)
on :: t -> a -> Wire s e m (Event a) a
on t
t' a
x' =
(s -> Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a)
-> (s -> Event a -> (Either e a, Wire s e m (Event a) a))
-> Wire s e m (Event a) a
forall a b. (a -> b) -> a -> b
$ \s
ds ->
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
(Either e a, Wire s e m (Event a) a)
-> (a -> (Either e a, Wire s e m (Event a) a))
-> Event a
-> (Either e a, Wire s e m (Event a) a)
forall b a. b -> (a -> b) -> Event a -> b
event (if t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0
then (e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty, Wire s e m (Event a) a
off)
else (a -> Either e a
forall a b. b -> Either a b
Right a
x', t -> a -> Wire s e m (Event a) a
on t
t a
x'))
(a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a)
-> (a -> Wire s e m (Event a) a)
-> a
-> (Either e a, Wire s e m (Event a) 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')
&&& t -> a -> Wire s e m (Event a) a
on t
int)
inhibit :: e -> Wire s e m a b
inhibit :: forall e s (m :: * -> *) a b. e -> Wire s e m a b
inhibit = Either e b -> Wire s e m a b
forall e b s (m :: * -> *) a. Either e b -> Wire s e m a b
mkConst (Either e b -> Wire s e m a b)
-> (e -> Either e b) -> e -> Wire s e m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e b
forall a b. a -> Either a b
Left
unless :: (Monoid e) => (a -> Bool) -> Wire s e m a a
unless :: forall e a s (m :: * -> *).
Monoid e =>
(a -> Bool) -> Wire s e m a a
unless a -> Bool
p =
(a -> Either e a) -> Wire s e m a a
forall a e b s (m :: * -> *). (a -> Either e b) -> Wire s e m a b
mkPure_ ((a -> Either e a) -> Wire s e m a a)
-> (a -> Either e a) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \a
x ->
if a -> Bool
p a
x then e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty else a -> Either e a
forall a b. b -> Either a b
Right a
x
until :: (Monoid e) => Wire s e m (a, Event b) a
until :: forall e s (m :: * -> *) a b. Monoid e => Wire s e m (a, Event b) a
until =
((a, Event b) -> (Either e a, Wire s e m (a, Event b) a))
-> Wire s e m (a, Event b) a
forall a e b s (m :: * -> *).
(a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPureN (((a, Event b) -> (Either e a, Wire s e m (a, Event b) a))
-> Wire s e m (a, Event b) a)
-> ((a -> Event b -> (Either e a, Wire s e m (a, Event b) a))
-> (a, Event b) -> (Either e a, Wire s e m (a, Event b) a))
-> (a -> Event b -> (Either e a, Wire s e m (a, Event b) a))
-> Wire s e m (a, Event b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Event b -> (Either e a, Wire s e m (a, Event b) a))
-> (a, Event b) -> (Either e a, Wire s e m (a, Event b) a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> Event b -> (Either e a, Wire s e m (a, Event b) a))
-> Wire s e m (a, Event b) a)
-> (a -> Event b -> (Either e a, Wire s e m (a, Event b) a))
-> Wire s e m (a, Event b) a
forall a b. (a -> b) -> a -> b
$ \a
x ->
(Either e a, Wire s e m (a, Event b) a)
-> (b -> (Either e a, Wire s e m (a, Event b) a))
-> Event b
-> (Either e a, Wire s e m (a, Event b) a)
forall b a. b -> (a -> b) -> Event a -> b
event (a -> Either e a
forall a b. b -> Either a b
Right a
x, Wire s e m (a, Event b) a
forall e s (m :: * -> *) a b. Monoid e => Wire s e m (a, Event b) a
until) ((Either e a, Wire s e m (a, Event b) a)
-> b -> (Either e a, Wire s e m (a, Event b) a)
forall a b. a -> b -> a
const (e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty, Wire s e m (a, Event b) a
forall e s (m :: * -> *) a b. Monoid e => Wire s e m a b
mkEmpty))
when :: (Monoid e) => (a -> Bool) -> Wire s e m a a
when :: forall e a s (m :: * -> *).
Monoid e =>
(a -> Bool) -> Wire s e m a a
when a -> Bool
p =
(a -> Either e a) -> Wire s e m a a
forall a e b s (m :: * -> *). (a -> Either e b) -> Wire s e m a b
mkPure_ ((a -> Either e a) -> Wire s e m a a)
-> (a -> Either e a) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \a
x ->
if a -> Bool
p a
x then a -> Either e a
forall a b. b -> Either a b
Right a
x else e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty