1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
-- |
-- 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 f = event NoEvent (Event . f)
instance (Semigroup a) => Monoid (Event a) where
mempty = NoEvent
mappend = (<>)
instance (NFData a) => NFData (Event a) where
rnf (Event x) = rnf x
rnf NoEvent = ()
instance (Semigroup a) => Semigroup (Event a) where
(<>) = merge (<>)
-- | Fold the given event.
event :: b -> (a -> b) -> Event a -> b
event _ j (Event x) = j x
event n _ NoEvent = 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 _ NoEvent NoEvent = NoEvent
merge _ (Event x) NoEvent = Event x
merge _ NoEvent (Event y) = Event y
merge f (Event x) (Event y) = Event (f x y)
-- | Did the given event occur?
occurred :: Event a -> Bool
occurred = event False (const 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 c = mkGen_ $ liftM Right . event (return NoEvent) (liftM Event . c)
|
