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

module Control.Wire.Unsafe.Event
    ( -- * Events
      Event(..),

      -- * Helper functions
      event,
      merge,
      occurred,
      onEventM
    )
    where

import Control.DeepSeq
import Control.Monad
import Control.Wire.Core
import Data.Semigroup
import Data.Typeable


-- | Denotes a stream of values, each together with time of occurrence.
-- Since 'Event' is commonly used for functional reactive programming it
-- does not define most of the usual instances to protect continuous
-- time and discrete event occurrence semantics.

data Event a = Event a | NoEvent  deriving (Typeable)

instance Functor Event where
    fmap :: (a -> b) -> Event a -> Event b
fmap f :: a -> b
f = Event b -> (a -> Event b) -> Event a -> Event b
forall b a. b -> (a -> b) -> Event a -> b
event Event b
forall a. Event a
NoEvent (b -> Event b
forall a. a -> Event a
Event (b -> Event b) -> (a -> b) -> a -> Event b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance (Semigroup a) => Monoid (Event a) where
    mempty :: Event a
mempty = Event a
forall a. Event a
NoEvent
    mappend :: Event a -> Event a -> Event a
mappend = Event a -> Event a -> Event a
forall a. Semigroup a => a -> a -> a
(<>)

instance (NFData a) => NFData (Event a) where
    rnf :: Event a -> ()
rnf (Event x :: a
x) = a -> ()
forall a. NFData a => a -> ()
rnf a
x
    rnf NoEvent   = ()

instance (Semigroup a) => Semigroup (Event a) where
    <> :: Event a -> Event a -> Event a
(<>) = (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. Semigroup a => a -> a -> a
(<>)


-- | Fold the given event.

event :: b -> (a -> b) -> Event a -> b
event :: b -> (a -> b) -> Event a -> b
event _ j :: a -> b
j (Event x :: a
x) = a -> b
j a
x
event n :: b
n _ NoEvent   = b
n


-- | Merge two events using the given function when both occur at the
-- same time.

merge :: (a -> a -> a) -> Event a -> Event a -> Event a
merge :: (a -> a -> a) -> Event a -> Event a -> Event a
merge _ NoEvent NoEvent     = Event a
forall a. Event a
NoEvent
merge _ (Event x :: a
x) NoEvent   = a -> Event a
forall a. a -> Event a
Event a
x
merge _ NoEvent (Event y :: a
y)   = a -> Event a
forall a. a -> Event a
Event a
y
merge f :: a -> a -> a
f (Event x :: a
x) (Event y :: a
y) = a -> Event a
forall a. a -> Event a
Event (a -> a -> a
f a
x a
y)


-- | Did the given event occur?

occurred :: Event a -> Bool
occurred :: Event a -> Bool
occurred = Bool -> (a -> Bool) -> Event a -> Bool
forall b a. b -> (a -> b) -> Event a -> b
event Bool
False (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)


-- | Each time the given event occurs, perform the given action with the
-- value the event carries.  The resulting event carries the result of
-- the action.
--
-- * Depends: now.

onEventM :: (Monad m) => (a -> m b) -> Wire s e m (Event a) (Event b)
onEventM :: (a -> m b) -> Wire s e m (Event a) (Event b)
onEventM c :: a -> m b
c = (Event a -> m (Either e (Event b)))
-> Wire s e m (Event a) (Event b)
forall (m :: * -> *) a e b s.
Monad m =>
(a -> m (Either e b)) -> Wire s e m a b
mkGen_ ((Event a -> m (Either e (Event b)))
 -> Wire s e m (Event a) (Event b))
-> (Event a -> m (Either e (Event b)))
-> Wire s e m (Event a) (Event b)
forall a b. (a -> b) -> a -> b
$ (Event b -> Either e (Event b))
-> m (Event b) -> m (Either e (Event b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Event b -> Either e (Event b)
forall a b. b -> Either a b
Right (m (Event b) -> m (Either e (Event b)))
-> (Event a -> m (Event b)) -> Event a -> m (Either e (Event b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Event b) -> (a -> m (Event b)) -> Event a -> m (Event b)
forall b a. b -> (a -> b) -> Event a -> b
event (Event b -> m (Event b)
forall (m :: * -> *) a. Monad m => a -> m a
return Event b
forall a. Event a
NoEvent) ((b -> Event b) -> m b -> m (Event b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Event b
forall a. a -> Event a
Event (m b -> m (Event b)) -> (a -> m b) -> a -> m (Event b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
c)