{- |
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.TimeMixed
   (snocBody, snocTime,
--    (/.), (./),
    viewTimeR,   viewBodyR,
    switchTimeR, switchBodyR,
    mapTimeR, mapTimeLast, mapTimeInit,
    mapBodyR, mapBodyLast, mapBodyInit,
    appendBodyEnd, prependBodyEnd,
    splitAtTime, takeTime, dropTime,
   ) where

import qualified Data.EventList.Relative.TimeBody as TimeBodyList
import qualified Data.EventList.Relative.TimeTime as TimeTimeList

import qualified Data.EventList.Relative.TimeBodyPrivate as TimeBodyPriv
import qualified Data.EventList.Relative.TimeTimePrivate as TimeTimePriv
-- import Data.EventList.Relative.TimeBodyPrivate (($~*))

import Data.EventList.Relative.TimeTimePrivate
   (viewTimeR, viewBodyR, switchTimeR, switchBodyR,
    mapTimeR, mapTimeLast, mapTimeInit)

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.AlternatingList.List.Mixed ((/.), (./))

import qualified Numeric.NonNegative.Class as NonNeg
import Data.Tuple.HT (mapFst, mapPair, )


snocBody :: TimeTimeList.T time body -> body -> TimeBodyList.T time body
snocBody xs = TimeBodyPriv.Cons . Mixed.snocFirst (TimeTimePriv.decons xs)

snocTime :: TimeBodyList.T time body -> time -> TimeTimeList.T time body
snocTime xs = TimeTimePriv.Cons . Mixed.snocSecond (TimeBodyPriv.decons xs)



mapBodyR ::
   (TimeTimeList.T time0 body -> TimeTimeList.T time1 body, body -> body) ->
   TimeBodyList.T time0 body -> TimeBodyList.T time1 body
mapBodyR = TimeBodyPriv.lift . Mixed.mapFirstR . mapFst TimeTimePriv.unlift

mapBodyLast ::
   (body -> body) ->
   TimeBodyList.T time body -> TimeBodyList.T time body
mapBodyLast = TimeBodyPriv.lift . Mixed.mapFirstLast

mapBodyInit ::
   (TimeTimeList.T time0 body -> TimeTimeList.T time1 body) ->
   TimeBodyList.T time0 body -> TimeBodyList.T time1 body
mapBodyInit = TimeBodyPriv.lift . Mixed.mapFirstInit . TimeTimePriv.unlift


{-
propInsertPadded :: Event time body -> T time body -> Bool
propInsertPadded (Event time body) evs =
   TimeBodyList.insert time body (fst evs)  ==  fst (insert time body evs)
-}

{- |
This is not a good name, expect a change.
-}
appendBodyEnd :: (NonNeg.C time) =>
   TimeTimeList.T time body -> TimeBodyList.T time body -> TimeBodyList.T time body
appendBodyEnd =
   switchTimeR
   (\ xs t -> TimeBodyList.append xs . TimeBodyList.delay t)

{- |
This is not a good name, expect a change.
-}
prependBodyEnd ::
   TimeBodyList.T time body -> TimeTimeList.T time body -> TimeTimeList.T time body
prependBodyEnd =
   TimeTimePriv.lift . Mixed.appendDisparateUniform . TimeBodyPriv.decons



splitAtTimeAux :: (NonNeg.C time) =>
   time -> Disp.T time body ->
   (Uniform.T body time, Disp.T time body)
splitAtTimeAux t0 =
   mapFst Uniform.forceSecondHead .
   Mixed.switchFirstL
      (Mixed.consSecond NonNeg.zero Disp.empty, Disp.empty)
      (\t1 xs ->
         let (mt,~(before,dt)) = NonNeg.split t0 t1
         in  mapFst (Mixed.consSecond mt) $
             if before
               then (Disp.empty, Mixed.consFirst dt xs)
               else
                  Mixed.switchSecondL
                     (\b ys ->
                        mapFst (Mixed.consFirst b) $
                        splitAtTimeAux dt ys)
                     xs)

splitAtTime :: (NonNeg.C time) =>
   time -> TimeBodyList.T time body ->
   (TimeTimeList.T time body, TimeBodyList.T time body)
splitAtTime t =
   mapPair (TimeTimePriv.Cons, TimeBodyPriv.Cons) .
   splitAtTimeAux t .
   TimeBodyPriv.decons

takeTime :: (NonNeg.C time) =>
   time -> TimeBodyList.T time body -> TimeTimeList.T time body
takeTime t = fst . splitAtTime t

dropTime :: (NonNeg.C time) =>
   time -> TimeBodyList.T time body -> TimeBodyList.T time body
dropTime t = snd . splitAtTime t


