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 :: t -> Wire s e m a a
after t' :: 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
$ \ds :: s
ds x :: 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
<= 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 :: 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 :: 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
$ \(x :: a
x, onEv :: Event b
onEv, _) ->
(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 b. Wire s e m (b, Event b, Event b) b
active))
Event b
onEv
where
active :: Wire s e m (b, Event b, Event b) b
active =
((b, Event b, Event b)
-> (Either e b, Wire s e m (b, Event b, Event b) b))
-> Wire s e m (b, Event b, Event b) 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 b)
-> (Either e b, Wire s e m (b, Event b, Event b) b))
-> Wire s e m (b, Event b, Event b) b)
-> ((b, Event b, Event b)
-> (Either e b, Wire s e m (b, Event b, Event b) b))
-> Wire s e m (b, Event b, Event b) b
forall a b. (a -> b) -> a -> b
$ \(x :: b
x, _, offEv :: Event b
offEv) ->
(Either e b, Wire s e m (b, Event b, Event b) b)
-> (b -> (Either e b, Wire s e m (b, Event b, Event b) b))
-> Event b
-> (Either e b, Wire s e m (b, Event b, Event b) 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 b) b
active)
((Either e b, Wire s e m (b, Event b, Event b) b)
-> b -> (Either e b, Wire s e m (b, Event b, Event b) 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 b) b
forall e s (m :: * -> *) a b c.
Monoid e =>
Wire s e m (a, Event b, Event c) a
between))
Event b
offEv
for :: (HasTime t s, Monoid e) => t -> Wire s e m a a
for :: t -> Wire s e m a a
for t' :: 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
$ \ds :: s
ds x :: 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
<= 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 :: 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 (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 x :: 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 (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 :: t -> Wire s e m (Event a) a
holdFor int :: t
int | t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [Char] -> Wire s e m (Event a) a
forall a. HasCallStack => [Char] -> a
error "holdFor: Non-positive interval."
holdFor int :: 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
$ \_ ->
(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 (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
t' x' :: 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
$ \ds :: 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
<= 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 (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 :: 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 :: (a -> Bool) -> Wire s e m a a
unless p :: 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
$ \x :: 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 :: 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
$ \x :: 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 :: (a -> Bool) -> Wire s e m a a
when p :: 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
$ \x :: 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