TimeMixed.hs

{- |
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,
    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, 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.EventList.Utility (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 =
   (\ ~(xs, t) -> TimeBodyList.append xs . TimeBodyList.delay t) .
   viewTimeR

{- |
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 =
   maybe
      (Uniform.singleton 0, Disp.empty)
      (\(t1,xs) ->
          if t0<=t1
            then (Uniform.singleton t0, Mixed.consFirst (t1-t0) xs)
            else
               (\(b,ys) -> mapFst (Uniform.cons t1 b) (splitAtTimeAux (t0-t1) ys))
               (Mixed.viewSecondL xs)) .
   Mixed.viewFirstL

splitAtTime :: (NonNeg.C time) =>
   time -> TimeBodyList.T time body ->
   (TimeTimeList.T time body, TimeBodyList.T time body)
splitAtTime t0 =
   mapPair (TimeTimePriv.Cons, TimeBodyPriv.Cons) .
   splitAtTimeAux t0 .
   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