content: {-# LANGUAGE CPP #-}
  -- |
  -- Module      : FRP.BearRiver.Event
  -- Copyright   : (c) Ivan Perez, 2014-2022
  --               (c) George Giorgidze, 2007-2012
  --               (c) Henrik Nilsson, 2005-2006
  --               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
  -- License     : BSD3
  --
  -- Maintainer  : ivan.perez@keera.co.uk
  -- Stability   : provisional
  -- Portability : portable
  --
  -- Events in BearRiver represent discrete time-signals, meaning those that do
  -- not change continuously. Examples of event-carrying signals would be mouse
  -- clicks (in between clicks it is assumed that there is no click), some
  -- keyboard events, button presses on wiimotes or window-manager events.
  --
  -- The type 'Event' is isomorphic to 'Maybe' (@Event a = NoEvent | Event a@)
  -- but, semantically, a 'Maybe'-carrying signal could change continuously,
  -- whereas an 'Event'-carrying signal should not: for two events in subsequent
  -- samples, there should be an small enough sampling frequency such that we
  -- sample between those two samples and there are no 'Event's between them.
  -- Nevertheless, no mechanism in Yampa will check this or misbehave if this
  -- assumption is violated.
  --
  -- Events are essential for many other BearRiver constructs, like switches (see
  -- 'FRP.BearRiver.Switches.switch' for details).
  module FRP.BearRiver.Event
      (
        -- * The Event type
        Event(..)
      , noEvent
      , noEventFst
      , noEventSnd
  
        -- * Utility functions similar to those available for Maybe
      , event
      , fromEvent
      , isEvent
      , isNoEvent
  
        -- * Event tagging
      , tag
      , tagWith
      , attach
  
        -- * Event merging (disjunction) and joining (conjunction)
      , lMerge
      , rMerge
      , merge
      , mergeBy
      , mapMerge
      , mergeEvents
      , catEvents
      , joinE
      , splitE
  
        -- * Event filtering
      , filterE
      , mapFilterE
      , gate
  
        -- * Utilities for easy event construction
      , maybeToEvent
  
      )
    where
  
  -- External imports
  #if !MIN_VERSION_base(4,8,0)
  import           Control.Applicative (Applicative (..), (<$>))
  #endif
  import           Control.Applicative (Alternative (..))
  import           Control.DeepSeq     (NFData (..))
  import qualified Control.Monad.Fail  as Fail
  
  infixl 8 `tag`, `attach`, `gate`
  infixl 7 `joinE`
  infixl 6 `lMerge`, `rMerge`, `merge`
  
  -- * The Event type
  
  -- | A single possible event occurrence, that is, a value that may or may not
  -- occur. Events are used to represent values that are not produced
  -- continuously, such as mouse clicks (only produced when the mouse is clicked,
  -- as opposed to mouse positions, which are always defined).
  data Event a = Event a | NoEvent
    deriving (Eq, Ord, Show)
  
  -- | Make the NoEvent constructor available. Useful e.g. for initialization,
  -- ((-->) & friends), and it's easily available anyway (e.g. mergeEvents []).
  noEvent :: Event a
  noEvent = NoEvent
  
  -- | Suppress any event in the first component of a pair.
  noEventFst :: (Event a, b) -> (Event c, b)
  noEventFst (_, b) = (NoEvent, b)
  
  -- | Suppress any event in the second component of a pair.
  noEventSnd :: (a, Event b) -> (a, Event c)
  noEventSnd (a, _) = (a, NoEvent)
  
  
  -- | Functor instance (could be derived).
  instance Functor Event where
    -- | Apply function to value carried by 'Event', if any.
    fmap _ NoEvent   = NoEvent
    fmap f (Event c) = Event (f c)
  
  -- | Applicative instance (similar to 'Maybe').
  instance Applicative Event where
    -- | Wrap a pure value in an 'Event'.
    pure = Event
    -- | If any value (function or arg) is 'NoEvent', everything is.
    Event f <*> Event x = Event (f x)
    _       <*> _       = NoEvent
  
  -- | Monad instance.
  instance Monad Event where
    -- | Combine events, return 'NoEvent' if any value in the sequence is
    -- 'NoEvent'.
    Event x >>= f = f x
    NoEvent >>= _ = NoEvent
  
    -- | See 'pure'.
    return = pure
  
  -- | MonadFail instance
  instance Fail.MonadFail Event where
    -- | Fail with 'NoEvent'.
    fail _ = NoEvent
  
  -- | Alternative instance.
  instance Alternative Event where
    -- | An empty alternative carries no event, so it is ignored.
    empty = NoEvent
    -- | Merge favouring the left event ('NoEvent' only if both are 'NoEvent').
    NoEvent <|> r = r
    l       <|> _ = l
  
  -- | NFData instance.
  instance NFData a => NFData (Event a) where
    -- | Evaluate value carried by event.
    rnf NoEvent   = ()
    rnf (Event a) = rnf a `seq` ()
  
  -- * Utility functions similar to those available for Maybe
  
  -- | An event-based version of the maybe function.
  event :: a -> (b -> a) -> Event b -> a
  event _ f (Event x) = f x
  event x _ NoEvent   = x
  
  -- | Extract the value from an event. Fails if there is no event.
  fromEvent :: Event a -> a
  fromEvent (Event x) = x
  fromEvent _         = error "fromEvent NoEvent"
  
  -- | Tests whether the input represents an actual event.
  isEvent :: Event a -> Bool
  isEvent (Event _) = True
  isEvent _         = False
  
  -- | Negation of 'isEvent'.
  isNoEvent :: Event a -> Bool
  isNoEvent = not . isEvent
  
  -- * Event tagging
  
  -- | Tags an (occurring) event with a value ("replacing" the old value).
  --
  -- Applicative-based definition: tag = ($>)
  tag :: Event a -> b -> Event b
  e `tag` b = fmap (const b) e
  
  -- | Tags an (occurring) event with a value ("replacing" the old value). Same as
  -- 'tag' with the arguments swapped.
  --
  -- Applicative-based definition: tagWith = (<$)
  tagWith :: b -> Event a -> Event b
  tagWith = flip tag
  
  -- | Attaches an extra value to the value of an occurring event.
  attach :: Event a -> b -> Event (a, b)
  e `attach` b = fmap (\a -> (a, b)) e
  
  -- * Event merging (disjunction) and joining (conjunction)
  
  -- | Left-biased event merge (always prefer left event, if present).
  lMerge :: Event a -> Event a -> Event a
  lMerge = (<|>)
  
  -- | Right-biased event merge (always prefer right event, if present).
  rMerge :: Event a -> Event a -> Event a
  rMerge = flip (<|>)
  
  -- | Unbiased event merge: simultaneous occurrence is an error.
  merge :: Event a -> Event a -> Event a
  merge = mergeBy $ error "Bearriver: merge: Simultaneous event occurrence."
  
  -- | Event merge parameterized by a conflict resolution function.
  --
  -- Applicative-based definition:
  -- mergeBy f le re = (f <$> le <*> re) <|> le <|> re
  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)
  
  -- | A generic event merge-map utility that maps event occurrences, merging the
  -- results. The first three arguments are mapping functions, the third of which
  -- will only be used when both events are present. Therefore, 'mergeBy' =
  -- 'mapMerge' 'id' 'id'.
  --
  -- Applicative-based definition:
  -- mapMerge lf rf lrf le re = (f <$> le <*> re) <|> (lf <$> le) <|> (rf <$> re)
  mapMerge :: (a -> c)
              -- ^ Mapping function used when first event is present.
           -> (b -> c)
              -- ^ Mapping function used when second event is present.
           -> (a -> b -> c)
              -- ^ Mapping function used when both events are present.
           -> Event a
              -- ^ First event
           -> Event b
              -- ^ Second event
           -> 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)
  
  -- | Merge a list of events; foremost event has priority.
  --
  -- Foldable-based definition:
  -- mergeEvents :: Foldable t => t (Event a) -> Event a
  -- mergeEvents =  asum
  mergeEvents :: [Event a] -> Event a
  mergeEvents = foldr lMerge NoEvent
  
  -- | Collect simultaneous event occurrences; no event if none.
  catEvents :: [Event a] -> Event [a]
  catEvents eas = case [ a | Event a <- eas ] of
                    [] -> NoEvent
                    as -> Event as
  
  -- | Join (conjunction) of two events. Only produces an event if both events
  -- exist.
  --
  -- Applicative-based definition:
  -- joinE = liftA2 (,)
  joinE :: Event a -> Event b -> Event (a, b)
  joinE NoEvent   _         = NoEvent
  joinE _         NoEvent   = NoEvent
  joinE (Event l) (Event r) = Event (l, r)
  
  -- | Split event carrying pairs into two events.
  splitE :: Event (a, b) -> (Event a, Event b)
  splitE NoEvent        = (NoEvent, NoEvent)
  splitE (Event (a, b)) = (Event a, Event b)
  
  -- * Event filtering
  
  -- | Filter out events that don't satisfy some predicate.
  filterE :: (a -> Bool) -> Event a -> Event a
  filterE p e@(Event a) = if p a then e else NoEvent
  filterE _ NoEvent     = NoEvent
  
  -- | Combined event mapping and filtering. Note: since 'Event' is a 'Functor',
  -- see 'fmap' for a simpler version of this function with no filtering.
  mapFilterE :: (a -> Maybe b) -> Event a -> Event b
  mapFilterE f e = e >>= (maybeToEvent . f)
  
  -- | Enable/disable event occurrences based on an external condition.
  gate :: Event a -> Bool -> Event a
  _ `gate` False = NoEvent
  e `gate` True  = e
  
  -- * Utilities for easy event construction
  
  -- | Convert a maybe value into a event ('Event' is isomorphic to 'Maybe').
  maybeToEvent :: Maybe a -> Event a
  maybeToEvent Nothing  = NoEvent
  maybeToEvent (Just a) = Event a
  