MEvent.hs

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE TypeOperators, TypeSynonymInstances, MultiParamTypeClasses #-}

----------------------------------------------------------------------
-- |
-- Module      :  Data.MEvent
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Event implementation via semantics & Maybe
----------------------------------------------------------------------

module Data.MEvent
  (
    -- * Event primitives
    Event', accumE
  ) where

import Data.Monoid
import Data.Maybe
import Control.Monad (MonadPlus(..))

-- TypeCompose
import Control.Compose ((:.)(..),inO,inO2)

import qualified Data.SEvent as SR  -- semantics


{----------------------------------------------------------
    Event primitives
----------------------------------------------------------}

-- | General events.  'Functor', 'Applicative', and 'Monoid' by
-- construction.  See also 'Event\''.
-- In this representation, an event is a list of time/maybe pairs.  The
-- 'Just's correspond to occurrences and the 'Nothing's to
-- non-occurrences.
type Event' t = SR.Event' t :. Maybe

-- The 'Monad' instance is thanks to Data.SEvent:
-- 
--   instance Ord t => DistribM (Event' t) Maybe where ...

-- TODO: revisit Phooey.  Can I use :. in place of monad transformers?
-- How to monad transformers relate to the monad instance of (:.)?
-- Follow up on references from my chat with Cale on 2008-03-02.

-- One of the standard Monoid instances for type compositions.  This one
-- interleaves occurrences.
instance Ord t => Monoid (Event' t a) where
  mempty  = O mempty
  mappend = inO2 mappend  -- interleave

-- This MonadPlus instance could go in EventExtras, but it would be an
-- orphan there.
instance Ord t => MonadPlus (Event' t) where { mzero = mempty; mplus = mappend }


-- | Accumulating event, starting from an initial value and a
-- update-function event.
accumE :: Ord t => a -> Event' t (a -> a) -> Event' t a
accumE a = inO $ fmap Just . SR.accumE a . fmap (fromMaybe id)

-- TODO: redefine accumE to preserve 'Nothing's, for later optimization.

-- (<*>) :: Fut (a->a) -> Fut a -> Fut a

-- (<*>) (on futures) does some unnecessary work here, since the function
-- is guaranteed to be at least as new as the argument.