-- | -- Module : FRP.Animas.Event -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 -- License : BSD-style (see the LICENSE file in the distribution) -- -- Maintainer : nilsson@cs.yale.edu -- Stability : provisional -- Portability : portable -- -- Definition of Animas Event type and functions on that type. -- 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` -- | Event type data Event a = NoEvent | Event a -- | Not an event noEvent :: Event a noEvent = NoEvent -- | Force the first item of a pair to not be an event noEventFst :: (Event a, b) -- ^ Input pair -> (Event c, b) -- ^ No event pair noEventFst (_, b) = (NoEvent, b) -- | Force the second item of a pair to not be an event noEventSnd :: (a, Event b) -- ^ Input pair -> (a, Event c) -- ^ No event pair 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 -- | Internal: Convert a 'Maybe' value to an event maybeToEvent :: Maybe a -> Event a maybeToEvent Nothing = NoEvent maybeToEvent (Just a) = Event a -- | Apply a function to an event, or return a default value event :: a -- ^ Default value -> (b -> a) -- ^ Function from event value -> Event b -- ^ Event -> a -- ^ Return value event a _ NoEvent = a event _ f (Event b) = f b -- | Extract a value from an event. This function will produce an error if -- applied to a NoEvent function fromEvent :: Event a -> a fromEvent (Event a) = a fromEvent NoEvent = usrErr "AFRP" "fromEvent" "Not an event." -- | Predicate: is a value an event occurence isEvent :: Event a -> Bool isEvent NoEvent = False isEvent (Event _) = True -- | Predicate: is a value not an event occurence isNoEvent :: Event a -> Bool isNoEvent = not . isEvent -- | Replace a possible event occurence with a new occurence carrying a -- replacement value tag :: Event a -- ^ Possible event occurence -> b -- ^ Replacement value -> Event b e `tag` b = fmap (const b) e -- | See above tagWith :: b -> Event a -> Event b tagWith = flip tag -- | Pair a value with an event occurrence's value, creating a new -- event occurrence attach :: Event a -> b -> Event (a, b) e `attach` b = fmap (\a -> (a, b)) e -- | If both inputs are event occurrences, produce the left event. lMerge :: Event a -> Event a -> Event a le `lMerge` re = event re Event le -- | If both inputs are event occurences, produce the right event. rMerge :: Event a -> Event a -> Event a rMerge = flip lMerge -- | If both inputs are event occurences, produce an error. merge :: Event a -> Event a -> Event a merge = mergeBy (usrErr "AFRP" "merge" "Simultaneous event occurrence.") -- | If both inputs are event occurences, merge them with the supplied -- function 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) -- | Apply functions to an event occurences from two sources mapMerge :: (a -> c) -- ^ Function for occurences in first source -> (b -> c) -- ^ Function for occurences in second source -> (a -> b -> c) -- ^ Function for occurences in both sources -> Event a -- ^ First source -> Event b -- ^ Second source -> Event c -- ^ Merged/mapped events 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) -- | Produce the event occurence closest to the head of the list, -- if one exists. mergeEvents :: [Event a] -> Event a mergeEvents = foldr lMerge NoEvent -- | From a list of event sources -- produce an event occurence with a list of values of occurrences catEvents :: [Event a] -> Event [a] catEvents eas = case [ a | Event a <- eas ] of [] -> NoEvent as -> Event as -- | If there is an occurence from both sources, produce an occurence -- with both values. joinE :: Event a -> Event b -> Event (a,b) joinE NoEvent _ = NoEvent joinE _ NoEvent = NoEvent joinE (Event l) (Event r) = Event (l,r) -- | Create a pair of event occurences from a single event occurence -- with a pair of values splitE :: Event (a,b) -> (Event a, Event b) splitE NoEvent = (NoEvent, NoEvent) splitE (Event (a,b)) = (Event a, Event b) -- | Apply a predicate to event occurences and forward them only if -- it matches filterE :: (a -> Bool) -> Event a -> Event a filterE p e@(Event a) = if (p a) then e else NoEvent filterE _ NoEvent = NoEvent -- | Apply a 'Maybe' function to event occurences, -- producing events only for 'Just' values. 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 -- | Only pass through events if some external condition is true. gate :: Event a -> Bool -> Event a _ `gate` False = NoEvent e `gate` True = e