{- |
Copyright   :  (c) Henning Thielemann 2007

Maintainer  :  haskell@henning-thielemann.de
Stability   :  stable
Portability :  Haskell 98


Event lists starting with a body and ending with a time difference.

-}
module Data.EventList.Relative.BodyTime
   (T, empty,
    fromPairList, toPairList,
    mapM,
    foldr, foldrPair,
    cons, snoc, viewL, viewR, switchL, switchR,
    span,
   ) where

import Data.EventList.Relative.BodyTimePrivate

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

import Data.EventList.Utility (mapPair, mapFst, mapSnd, )

import Prelude hiding
   (mapM, foldr, span, )


fromPairList :: [(body, time)] -> T time body
fromPairList = Cons . Disp.fromPairList

toPairList :: T time body -> [(body, time)]
toPairList = Disp.toPairList . decons


mapM :: Monad m =>
   (time0 -> m time1) -> (body0 -> m body1) ->
   T time0 body0 -> m (T time1 body1)
mapM timeAction bodyAction =
   liftM (Disp.mapM bodyAction timeAction)


foldr :: (body -> a -> b) -> (time -> b -> a) -> b -> T time body -> b
foldr f g x = Disp.foldr f g x . decons

foldrPair :: (body -> time -> a -> a) -> a -> T time body -> a
foldrPair f x = Disp.foldrPair f x . decons


empty :: T time body
empty = Cons Disp.empty


cons :: body -> time -> T time body -> T time body
cons body time = lift (Disp.cons body time)

snoc :: T time body -> body -> time -> T time body
snoc xs body time =
   Cons $ (Disp.snoc $*~ xs) body time


viewL :: T time body -> Maybe ((body, time), T time body)
viewL = fmap (mapSnd Cons) . Disp.viewL . decons

viewR :: T time body -> Maybe (T time body, (body, time))
viewR = fmap (mapFst Cons) . Disp.viewR . decons


{-# INLINE switchL #-}
switchL :: c -> (body -> time -> T time body -> c) -> T time body -> c
switchL f g = Disp.switchL f (\ b t  -> g b t . Cons) . decons

{-# INLINE switchR #-}
switchR :: c -> (T time body -> body -> time -> c) -> T time body -> c
switchR f g = Disp.switchR f (\xs b t -> g (Cons xs) b t) . decons


span :: (body -> Bool) -> T time body -> (T time body, T time body)
span p = mapPair (Cons, Cons) . Disp.spanFirst p . decons