{- |
Copyright   :  (c) Henning Thielemann 2007

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


Event lists starting with a time difference
and ending with either a data body or 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,
    splitAfterTime, takeAfterTime, dropAfterTime,
   ) 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, mapSnd, mapPair, )


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

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



mapBodyR ::
   (TimeTimeList.T time0 body -> TimeTimeList.T time1 body, body -> body) ->
   TimeBodyList.T time0 body -> TimeBodyList.T time1 body
mapBodyR :: forall time0 body time1.
(T time0 body -> T time1 body, body -> body)
-> T time0 body -> T time1 body
mapBodyR = forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
TimeBodyPriv.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b0 b1. (T a b0 -> T a b1, a -> a) -> T b0 a -> T b1 a
Mixed.mapFirstR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T body0 time0 -> T body1 time1
TimeTimePriv.unlift

mapBodyLast ::
   (body -> body) ->
   TimeBodyList.T time body -> TimeBodyList.T time body
mapBodyLast :: forall body time. (body -> body) -> T time body -> T time body
mapBodyLast = forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
TimeBodyPriv.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> a) -> T b a -> T b a
Mixed.mapFirstLast

mapBodyInit ::
   (TimeTimeList.T time0 body -> TimeTimeList.T time1 body) ->
   TimeBodyList.T time0 body -> TimeBodyList.T time1 body
mapBodyInit :: forall time0 body time1.
(T time0 body -> T time1 body) -> T time0 body -> T time1 body
mapBodyInit = forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
TimeBodyPriv.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b0 b1. (T a b0 -> T a b1) -> T b0 a -> T b1 a
Mixed.mapFirstInit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T body0 time0 -> T body1 time1
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 :: forall time body.
C time =>
T time body -> T time body -> T time body
appendBodyEnd =
   forall time body a. (T time body -> time -> a) -> T time body -> a
switchTimeR
   (\ T time body
xs time
t -> forall time body. T time body -> T time body -> T time body
TimeBodyList.append T time body
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. C time => time -> T time body -> T time body
TimeBodyList.delay time
t)

{- |
This is not a good name, expect a change.
-}
prependBodyEnd ::
   TimeBodyList.T time body -> TimeTimeList.T time body -> TimeTimeList.T time body
prependBodyEnd :: forall time body. T time body -> T time body -> T time body
prependBodyEnd =
   forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
TimeTimePriv.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. T b a -> T a b -> T a b
Mixed.appendDisparateUniform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> T time body
TimeBodyPriv.decons


liftSplit ::
   (Disp.T time0 body0 -> (Uniform.T body1 time1, Disp.T time2 body2)) ->
   TimeBodyList.T time0 body0 ->
   (TimeTimeList.T time1 body1, TimeBodyList.T time2 body2)
liftSplit :: forall time0 body0 body1 time1 time2 body2.
(T time0 body0 -> (T body1 time1, T time2 body2))
-> T time0 body0 -> (T time1 body1, T time2 body2)
liftSplit T time0 body0 -> (T body1 time1, T time2 body2)
f =
   forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall time body. T body time -> T time body
TimeTimePriv.Cons, forall time body. T time body -> T time body
TimeBodyPriv.Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> (T body1 time1, T time2 body2)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> T time body
TimeBodyPriv.decons

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

{- |
At the division time move all zero time differences to the suffix part,
that is we will always split before a group of events.
-}
splitAtTime :: (NonNeg.C time) =>
   time -> TimeBodyList.T time body ->
   (TimeTimeList.T time body, TimeBodyList.T time body)
splitAtTime :: forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAtTime = forall time0 body0 body1 time1 time2 body2.
(T time0 body0 -> (T body1 time1, T time2 body2))
-> T time0 body0 -> (T time1 body1, T time2 body2)
liftSplit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body.
C time =>
(time -> time -> (time, (Bool, time)))
-> time -> T time body -> (T body time, T time body)
splitAtTimeAux forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split

takeTime :: (NonNeg.C time) =>
   time -> TimeBodyList.T time body -> TimeTimeList.T time body
takeTime :: forall time body. C time => time -> T time body -> T time body
takeTime time
t = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAtTime time
t

dropTime :: (NonNeg.C time) =>
   time -> TimeBodyList.T time body -> TimeBodyList.T time body
dropTime :: forall time body. C time => time -> T time body -> T time body
dropTime time
t = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAtTime time
t


{- |
At the division time move all zero time differences to the prefix part,
that is we will always split after a group of events.
-}
splitAfterTime :: (NonNeg.C time) =>
   time -> TimeBodyList.T time body ->
   (TimeTimeList.T time body, TimeBodyList.T time body)
splitAfterTime :: forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAfterTime =
   forall time0 body0 body1 time1 time2 body2.
(T time0 body0 -> (T body1 time1, T time2 body2))
-> T time0 body0 -> (T time1 body1, T time2 body2)
liftSplit forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time body.
C time =>
(time -> time -> (time, (Bool, time)))
-> time -> T time body -> (T body time, T time body)
splitAtTimeAux (\time
t0 time
t1 -> forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Bool -> Bool
not) forall a b. (a -> b) -> a -> b
$ forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split time
t1 time
t0)

takeAfterTime :: (NonNeg.C time) =>
   time -> TimeBodyList.T time body -> TimeTimeList.T time body
takeAfterTime :: forall time body. C time => time -> T time body -> T time body
takeAfterTime time
t = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAfterTime time
t

dropAfterTime :: (NonNeg.C time) =>
   time -> TimeBodyList.T time body -> TimeBodyList.T time body
dropAfterTime :: forall time body. C time => time -> T time body -> T time body
dropAfterTime time
t = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAfterTime time
t