EventExtras.hs

{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.EventExtras
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Event "extras", i.e., independent of representation
----------------------------------------------------------------------

module Data.EventExtras
  (
    module Data.SEvent
    -- * Event extras
  , EventD, EventI
  , traceE, pairE, scanlE, monoidE
  , withPrevE, countE, countE_, diffE
    -- * To be moved elsewhere
  , joinMaybes, filterMP
  ) where

import Control.Monad (liftM)
import Control.Applicative ((<$>),liftA2)
import Data.Pair (pairEdit)
import Data.Monoid
import Control.Monad (MonadPlus(..))
import Debug.Trace (trace)

import Data.SEvent
-- import Data.MEvent

import Data.Improving

-- | Event, using Double for time
type EventD = Event' Double

-- | Event, using an /improving/ double for time
type EventI = Event' (Improving Double)

-- | Tracing of events.
traceE :: (a -> String) -> Event' t a -> Event' t a
traceE shw = fmap (\ a -> trace (shw a) a)

pairE :: Ord t => (c,d) -> (Event' t c, Event' t d) -> Event' t (c,d)
pairE cd cde = cd `accumE` pairEdit cde

-- | Like 'scanl' for events.  See also 'scanlR'.
scanlE :: Ord t => (a -> b -> a) -> a -> Event' t b -> Event' t a
scanlE f a e = a `accumE` (flip f <$> e)

-- | Accumulate values from a monoid-valued event.  Specialization of
-- 'scanlE', using 'mappend' and 'mempty'.  See also 'monoidR'.
monoidE :: (Ord t, Monoid o) => Event' t o -> Event' t o
monoidE = scanlE mappend mempty

-- | Pair each event value with the previous one, given an initial value.
withPrevE :: Ord t => Event' t a -> Event' t (a,a)
withPrevE e = (joinMaybes . fmap combineMaybes) $
              (Nothing,Nothing) `accumE` fmap (shift.Just) e
 where
   -- Shift newer value into (old,new) pair if present.
   shift :: u -> (u,u) -> (u,u)
   shift new (_,old) = (old,new)
   combineMaybes :: (Maybe u, Maybe v) -> Maybe (u,v)
   combineMaybes = uncurry (liftA2 (,))

-- | Count occurrences of an event, remembering the occurrence values.
-- See also 'countE_'.
countE :: (Ord t, Num n) => Event' t b -> Event' t (b,n)
countE = scanlE h (b0,0)
 where
   b0        = error "withCountE: no initial value"
   h (_,n) b = (b,n+1)

-- | Count occurrences of an event, forgetting the occurrence values.  See
-- also 'countE'.  See also 'countR'.
countE_ :: (Ord t, Num n) => Event' t b -> Event' t n
countE_ e = snd <$> countE e

-- | Difference of successive event occurrences.
diffE :: (Ord t, Num n) => Event' t n -> Event' t n
diffE e = uncurry (-) <$> withPrevE e


{--------------------------------------------------------------------
    To be moved elsewhere
--------------------------------------------------------------------}

-- | Pass through @Just@ occurrences.
joinMaybes :: MonadPlus m => m (Maybe a) -> m a
joinMaybes = (>>= maybe mzero return)

-- | Pass through values satisfying @p@.
filterMP :: MonadPlus m => (a -> Bool) -> m a -> m a
filterMP p m = joinMaybes (liftM f m)
 where
   f a | p a       = Just a
       | otherwise = Nothing

-- Alternatively:
-- filterMP p m = m >>= guarded p
--  where
--    guarded p x = guard (p x) >> return x