{- |
Copyright   :  (c) Henning Thielemann 2007

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

import qualified Data.EventList.Relative.TimeBodyPrivate as TimeBodyList
import qualified Data.EventList.Relative.TimeBodyPrivate as TimeBodyPriv

import qualified Data.EventList.Relative.BodyTimePrivate as BodyTimeList
import qualified Data.EventList.Relative.BodyTimePrivate as BodyTimePriv

-- 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 Data.EventList.Utility (mapFst, mapSnd)

import qualified Control.Monad as Monad

import Test.QuickCheck (Arbitrary(..))



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


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

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


infixl 5 $~~

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


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

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

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




consBody :: body -> T time body -> BodyTimeList.T time body
consBody b = BodyTimePriv.Cons . Mixed.consFirst b . decons

consTime :: time -> BodyTimeList.T time body -> T time body
consTime t = Cons . Mixed.consSecond t . BodyTimePriv.decons

viewTimeL :: T time body -> (time, BodyTimeList.T time body)
viewTimeL = mapSnd BodyTimePriv.Cons . Mixed.viewSecondL . decons

viewBodyL :: BodyTimeList.T time body -> Maybe (body, T time body)
viewBodyL = fmap (mapSnd Cons) . Mixed.viewFirstL . BodyTimePriv.decons


viewTimeR :: T time body -> (TimeBodyList.T time body, time)
viewTimeR = mapFst TimeBodyPriv.Cons . Mixed.viewSecondR . decons

viewBodyR :: TimeBodyList.T time body -> Maybe (T time body, body)
viewBodyR = fmap (mapFst Cons) . Mixed.viewFirstR . TimeBodyPriv.decons


mapTimeL ::
   (time -> time, BodyTimeList.T time body0 -> BodyTimeList.T time body1) ->
   T time body0 -> T time body1
mapTimeL = lift . Mixed.mapSecondL . mapSnd BodyTimePriv.unlift

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

mapTimeTail ::
   (BodyTimeList.T time body0 -> BodyTimeList.T time body1) ->
   T time body0 -> T time body1
mapTimeTail = lift . Mixed.mapSecondTail . BodyTimePriv.unlift


mapTimeR ::
   (TimeBodyList.T time body0 -> TimeBodyList.T time body1, time -> time) ->
   T time body0 -> T time body1
mapTimeR = lift . Mixed.mapSecondR . mapFst TimeBodyPriv.unlift

mapTimeLast ::
   (time -> time) ->
   T time body -> T time body
mapTimeLast = lift . Mixed.mapSecondLast

mapTimeInit ::
   (TimeBodyList.T time body0 -> TimeBodyList.T time body1) ->
   T time body0 -> T time body1
mapTimeInit = lift . Mixed.mapSecondInit . TimeBodyPriv.unlift