module FRP.Animas.Event where
import FRP.Animas.Diagnostics
import FRP.Animas.Forceable
infixl 8 `tag`, `attach`, `gate`
infixl 7 `joinE`
infixl 6 `lMerge`, `rMerge`, `merge`
data Event a = NoEvent
| Event a
noEvent :: Event a
noEvent = NoEvent
noEventFst :: (Event a, b)
-> (Event c, b)
noEventFst (_, b) = (NoEvent, b)
noEventSnd :: (a, Event b)
-> (a, Event c)
noEventSnd (a, _) = (a, NoEvent)
instance Eq a => Eq (Event a) where
NoEvent == NoEvent = True
(Event x) == (Event y) = x == y
_ == _ = False
instance Ord a => Ord (Event a) where
compare NoEvent NoEvent = EQ
compare NoEvent (Event _) = LT
compare (Event _) NoEvent = GT
compare (Event x) (Event y) = compare x y
instance Functor Event where
fmap _ NoEvent = NoEvent
fmap f (Event a) = Event (f a)
instance Forceable a => Forceable (Event a) where
force ea@NoEvent = ea
force ea@(Event a) = force a `seq` ea
maybeToEvent :: Maybe a -> Event a
maybeToEvent Nothing = NoEvent
maybeToEvent (Just a) = Event a
event :: a
-> (b -> a)
-> Event b
-> a
event a _ NoEvent = a
event _ f (Event b) = f b
fromEvent :: Event a -> a
fromEvent (Event a) = a
fromEvent NoEvent = usrErr "AFRP" "fromEvent" "Not an event."
isEvent :: Event a -> Bool
isEvent NoEvent = False
isEvent (Event _) = True
isNoEvent :: Event a -> Bool
isNoEvent = not . isEvent
tag :: Event a
-> b
-> Event b
e `tag` b = fmap (const b) e
tagWith :: b -> Event a -> Event b
tagWith = flip tag
attach :: Event a -> b -> Event (a, b)
e `attach` b = fmap (\a -> (a, b)) e
lMerge :: Event a -> Event a -> Event a
le `lMerge` re = event re Event le
rMerge :: Event a -> Event a -> Event a
rMerge = flip lMerge
merge :: Event a -> Event a -> Event a
merge = mergeBy (usrErr "AFRP" "merge" "Simultaneous event occurrence.")
mergeBy :: (a -> a -> a) -> Event a -> Event a -> Event a
mergeBy _ NoEvent NoEvent = NoEvent
mergeBy _ le@(Event _) NoEvent = le
mergeBy _ NoEvent re@(Event _) = re
mergeBy resolve (Event l) (Event r) = Event (resolve l r)
mapMerge :: (a -> c)
-> (b -> c)
-> (a -> b -> c)
-> Event a
-> Event b
-> Event c
mapMerge _ _ _ NoEvent NoEvent = NoEvent
mapMerge lf _ _ (Event l) NoEvent = Event (lf l)
mapMerge _ rf _ NoEvent (Event r) = Event (rf r)
mapMerge _ _ lrf (Event l) (Event r) = Event (lrf l r)
mergeEvents :: [Event a] -> Event a
mergeEvents = foldr lMerge NoEvent
catEvents :: [Event a] -> Event [a]
catEvents eas = case [ a | Event a <- eas ] of
[] -> NoEvent
as -> Event as
joinE :: Event a -> Event b -> Event (a,b)
joinE NoEvent _ = NoEvent
joinE _ NoEvent = NoEvent
joinE (Event l) (Event r) = Event (l,r)
splitE :: Event (a,b) -> (Event a, Event b)
splitE NoEvent = (NoEvent, NoEvent)
splitE (Event (a,b)) = (Event a, Event b)
filterE :: (a -> Bool) -> Event a -> Event a
filterE p e@(Event a) = if (p a) then e else NoEvent
filterE _ NoEvent = NoEvent
mapFilterE :: (a -> Maybe b) -> Event a -> Event b
mapFilterE _ NoEvent = NoEvent
mapFilterE f (Event a) = case f a of
Nothing -> NoEvent
Just b -> Event b
gate :: Event a -> Bool -> Event a
_ `gate` False = NoEvent
e `gate` True = e