Event.hs

-- |
-- 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,

      -- * 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)
(<&) = liftA2 (merge 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)
(&>) = liftA2 (merge (const 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 f = loop
    where
    loop x' =
        mkSFN $
            event (NoEvent, loop x')
                  (\y -> let x = f x' y in (Event x, loop 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 f = initial
    where
    initial =
        mkSFN $ event (NoEvent, initial) (Event &&& accumE 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 t' =
    mkSF $ \ds x ->
        let t = t' - dtime ds
        in if t <= 0
             then (Event x, never)
             else (NoEvent, at 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 p = off
    where
    off = mkSFN $ \x -> if p x then (Event x, on) else (NoEvent, off)
    on = mkSFN $ \x -> (NoEvent, if p x then on else off)


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

dropE :: Int -> Wire s e m (Event a) (Event a)
dropE n | n <= 0 = mkId
dropE n =
    fix $ \again ->
    mkSFN $ \mev ->
        (NoEvent, if occurred mev then dropE (pred n) else 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 p =
    fix $ \again ->
    mkSFN $ \mev ->
        case mev of
          Event x | not (p x) -> (mev, mkId)
          _ -> (NoEvent, 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 p =
    mkSF_ $ \mev ->
        case mev of
          Event x | p x -> mev
          _ -> NoEvent


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

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


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

maximumE :: (Ord a) => Wire s e m (Event a) (Event a)
maximumE = accum1E max


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

minimumE :: (Ord a) => Wire s e m (Event a) (Event a)
minimumE = accum1E min


-- | Left-biased event merge.

mergeL :: Event a -> Event a -> Event a
mergeL = merge const


-- | Right-biased event merge.

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


-- | Never occurs.

never :: Wire s e m a (Event b)
never = mkConst (Right 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 p = off
    where
    off = mkSFN $ \x -> if p x then (NoEvent, off) else (Event x, on)
    on = mkSFN $ \x -> (NoEvent, if p x then off else on)


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

notYet :: Wire s e m (Event a) (Event a)
notYet =
    mkSFN $ event (NoEvent, notYet) (const (NoEvent, mkId))


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

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


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

once :: Wire s e m (Event a) (Event a)
once =
    mkSFN $ \mev ->
        (mev, if occurred mev then never else 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 int | int <= 0 = error "periodic: Non-positive interval"
periodic int = mkSFN $ \x -> (Event x, loop int)
    where
    loop 0 = loop int
    loop t' =
        mkSF $ \ds x ->
            let t = t' - dtime ds
            in if t <= 0
                 then (Event x, loop (mod' t int))
                 else (NoEvent, loop 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 int _ | int <= 0 = error "periodic: Non-positive interval"
periodicList _ [] = never
periodicList int (x:xs) = mkSFN $ \_ -> (Event x, loop int xs)
    where
    loop _ [] = never
    loop 0 xs = loop int xs
    loop t' xs0@(x:xs) =
        mkSF $ \ds _ ->
            let t = t' - dtime ds
            in if t <= 0
                 then (Event x, loop (mod' t int) xs)
                 else (NoEvent, loop t xs0)


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

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


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

sumE :: (Num a) => Wire s e m (Event a) (Event a)
sumE = accumE (+) 0


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

takeE :: Int -> Wire s e m (Event a) (Event a)
takeE n | n <= 0 = never
takeE n =
    fix $ \again ->
    mkSFN $ \mev ->
        (mev, if occurred mev then takeE (pred n) else 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 p =
    fix $ \again ->
    mkSFN $ \mev ->
        case mev of
          Event x | not (p x) -> (NoEvent, never)
          _ -> (mev, again)