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

module Control.Wire.Interval
    ( -- * Basic intervals
      inhibit,

      -- * Time intervals
      after,
      for,

      -- * Signal analysis
      unless,
      when,

      -- * Event-based intervals
      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 the given time period.
--
-- * Depends: now after the given time period.
--
-- * Inhibits: for the given time period.

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)


-- | Alias for 'hold'.

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


-- | Start each time the left event occurs, stop each time the right
-- event occurs.
--
-- * Depends: now when active.
--
-- * Inhibits: after the right event occurred, before the left event
-- occurs.

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 the given time period.
--
-- * Depends: now for the given time period.
--
-- * Inhibits: after the given time period.

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)


-- | Start when the event occurs for the first time reflecting its
-- latest value.
--
-- * Depends: now.
--
-- * Inhibits: until the event occurs for the first time.

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 (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 (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)


-- | Hold each event occurrence for the given time period.  Inhibits
-- when no event occurred for the given amount of time.  New occurrences
-- override old occurrences, even when they are still held.
--
-- * Depends: now.
--
-- * Inhibits: when no event occurred for the given amount of time.

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 (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 (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 forever with the given value.
--
-- * Inhibits: always.

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


-- | When the given predicate is false for the input signal.
--
-- * Depends: now.
--
-- * Inhibits: unless the predicate is false.

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


-- | Produce until the given event occurs.  When it occurs, inhibit with
-- its value forever.
--
-- * Depends: now until event occurs.
--
-- * Inhibits: forever after event occurs.

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 the given predicate is true for the input signal.
--
-- * Depends: now.
--
-- * Inhibits: when the predicate is false.

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