TimeBodyPrivate.hs

{- |
Copyright   :  (c) Henning Thielemann 2007

Maintainer  :  haskell@henning-thielemann.de
Stability   :  stable
Portability :  Haskell 98
-}
module Data.EventList.Relative.TimeBodyPrivate where

import qualified Data.EventList.Relative.BodyBodyPrivate as BodyBodyList
import qualified Data.EventList.Relative.BodyBodyPrivate as BodyBodyPriv

import qualified Data.AlternatingList.List.Disparate as Disp
-- import qualified Data.AlternatingList.List.Uniform as Uniform
import qualified Data.AlternatingList.List.Mixed as Mixed

import qualified Control.Monad as Monad

import Data.Tuple.HT (mapSnd, )

import Test.QuickCheck (Arbitrary(..))



newtype T time body = Cons {decons :: Disp.T time body}
   deriving (Eq, Ord)


instance (Show time, Show body) => Show (T time body) where
   showsPrec p = Disp.format " /. " " ./ " p . decons


instance (Arbitrary time, Arbitrary body) =>
             Arbitrary (T time body) where
   arbitrary = Monad.liftM Cons arbitrary
   coarbitrary = undefined


infixl 5 $~*

($~*) :: (Disp.T time body -> a) -> (T time body -> a)
($~*) f = f . decons


lift ::
   (Disp.T time0 body0 -> Disp.T time1 body1) ->
   (T time0 body0 -> T time1 body1)
lift f = Cons . f . decons

liftM :: Monad m =>
   (Disp.T time0 body0 -> m (Disp.T time1 body1)) ->
   (T time0 body0 -> m (T time1 body1))
liftM f = Monad.liftM Cons . f . decons

unlift ::
   (T time0 body0 -> T time1 body1) ->
   (Disp.T time0 body0 -> Disp.T time1 body1)
unlift f = decons . f . Cons



mapTimeL ::
   (time -> time, BodyBodyList.T time body0 -> BodyBodyList.T time body1) ->
   T time body0 -> T time body1
mapTimeL = lift . Mixed.mapFirstL . mapSnd BodyBodyPriv.unlift

mapTimeHead ::
   (time -> time) ->
   T time body -> T time body
mapTimeHead = lift . Mixed.mapFirstHead

mapTimeTail ::
   (BodyBodyList.T time body0 -> BodyBodyList.T time body1) ->
   T time body0 -> T time body1
mapTimeTail = lift . Mixed.mapFirstTail . BodyBodyPriv.unlift