{- |
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 = T time body -> T time body
forall time body. T time body -> T time body
TimeBodyPriv.Cons (T time body -> T time body)
-> (body -> T time body) -> body -> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body time -> body -> T time body
forall a b. T a b -> a -> T b a
Mixed.snocFirst (T time body -> T body time
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 = T body time -> T time body
forall time body. T body time -> T time body
TimeTimePriv.Cons (T body time -> T time body)
-> (time -> T body time) -> time -> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> time -> T body time
forall b a. T b a -> b -> T a b
Mixed.snocSecond (T time body -> T time body
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 = (T time0 body -> T time1 body) -> T time0 body -> T time1 body
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
TimeBodyPriv.lift ((T time0 body -> T time1 body) -> T time0 body -> T time1 body)
-> ((T time0 body -> T time1 body, body -> body)
    -> T time0 body -> T time1 body)
-> (T time0 body -> T time1 body, body -> body)
-> T time0 body
-> T time1 body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T body time0 -> T body time1, body -> body)
-> T time0 body -> T time1 body
forall a b0 b1. (T a b0 -> T a b1, a -> a) -> T b0 a -> T b1 a
Mixed.mapFirstR ((T body time0 -> T body time1, body -> body)
 -> T time0 body -> T time1 body)
-> ((T time0 body -> T time1 body, body -> body)
    -> (T body time0 -> T body time1, body -> body))
-> (T time0 body -> T time1 body, body -> body)
-> T time0 body
-> T time1 body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((T time0 body -> T time1 body) -> T body time0 -> T body time1)
-> (T time0 body -> T time1 body, body -> body)
-> (T body time0 -> T body time1, body -> body)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (T time0 body -> T time1 body) -> T body time0 -> T body time1
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 = (T time body -> T time body) -> T time body -> T time body
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
TimeBodyPriv.lift ((T time body -> T time body) -> T time body -> T time body)
-> ((body -> body) -> T time body -> T time body)
-> (body -> body)
-> T time body
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (body -> body) -> T time body -> T time body
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 = (T time0 body -> T time1 body) -> T time0 body -> T time1 body
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
TimeBodyPriv.lift ((T time0 body -> T time1 body) -> T time0 body -> T time1 body)
-> ((T time0 body -> T time1 body) -> T time0 body -> T time1 body)
-> (T time0 body -> T time1 body)
-> T time0 body
-> T time1 body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T body time0 -> T body time1) -> T time0 body -> T time1 body
forall a b0 b1. (T a b0 -> T a b1) -> T b0 a -> T b1 a
Mixed.mapFirstInit ((T body time0 -> T body time1) -> T time0 body -> T time1 body)
-> ((T time0 body -> T time1 body) -> T body time0 -> T body time1)
-> (T time0 body -> T time1 body)
-> T time0 body
-> T time1 body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T time0 body -> T time1 body) -> T body time0 -> T body time1
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 =
   (T time body -> time -> T time body -> T time body)
-> T time body -> T time body -> T time body
forall time body a. (T time body -> time -> a) -> T time body -> a
switchTimeR
   (\ T time body
xs time
t -> T time body -> T time body -> T time body
forall time body. T time body -> T time body -> T time body
TimeBodyList.append T time body
xs (T time body -> T time body)
-> (T time body -> T time body) -> T time body -> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> T time body -> T time body
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 =
   (T body time -> T body time) -> T time body -> T time body
forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
TimeTimePriv.lift ((T body time -> T body time) -> T time body -> T time body)
-> (T time body -> T body time -> T body time)
-> T time body
-> T time body
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T body time -> T body time
forall b a. T b a -> T a b -> T a b
Mixed.appendDisparateUniform (T time body -> T body time -> T body time)
-> (T time body -> T time body)
-> T time body
-> T body time
-> T body time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T time body
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 =
   (T body1 time1 -> T time1 body1, T time2 body2 -> T time2 body2)
-> (T body1 time1, T time2 body2) -> (T time1 body1, T time2 body2)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (T body1 time1 -> T time1 body1
forall time body. T body time -> T time body
TimeTimePriv.Cons, T time2 body2 -> T time2 body2
forall time body. T time body -> T time body
TimeBodyPriv.Cons) ((T body1 time1, T time2 body2) -> (T time1 body1, T time2 body2))
-> (T time0 body0 -> (T body1 time1, T time2 body2))
-> T time0 body0
-> (T time1 body1, T time2 body2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> (T body1 time1, T time2 body2)
f (T time0 body0 -> (T body1 time1, T time2 body2))
-> (T time0 body0 -> T time0 body0)
-> T time0 body0
-> (T body1 time1, T time2 body2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> T time0 body0
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 =
         (T a time -> T a time)
-> (T a time, T time a) -> (T a time, T time a)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst T a time -> T a time
forall a b. T a b -> T a b
Uniform.forceSecondHead ((T a time, T time a) -> (T a time, T time a))
-> (T time a -> (T a time, T time a))
-> T time a
-> (T a time, T time a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (T a time, T time a)
-> (time -> T time a -> (T a time, T time a))
-> T time a
-> (T a time, T time a)
forall c a b. c -> (a -> T a b -> c) -> T a b -> c
Mixed.switchFirstL
            (time -> T a time -> T a time
forall b a. b -> T a b -> T a b
Mixed.consSecond time
forall a. C a => a
NonNeg.zero T a time
forall a b. T a b
Disp.empty, T time a
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  (T a time -> T a time)
-> (T a time, T time a) -> (T a time, T time a)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (time -> T a time -> T a time
forall b a. b -> T a b -> T a b
Mixed.consSecond time
mt) ((T a time, T time a) -> (T a time, T time a))
-> (T a time, T time a) -> (T a time, T time a)
forall a b. (a -> b) -> a -> b
$
                   if Bool
before
                     then (T a time
forall a b. T a b
Disp.empty, time -> T time a -> T time a
forall a b. a -> T a b -> T a b
Mixed.consFirst time
dt T time a
xs)
                     else
                        (a -> T time a -> (T a time, T time a))
-> T time a -> (T a time, T time a)
forall b a c. (b -> T a b -> c) -> T a b -> c
Mixed.switchSecondL
                           (\a
b T time a
ys -> (T a time -> T a time)
-> (T a time, T time a) -> (T a time, T time a)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a -> T a time -> T a time
forall a b. a -> T a b -> T a b
Mixed.consFirst a
b) ((T a time, T time a) -> (T a time, T time a))
-> (T a time, T time a) -> (T a time, T time a)
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  time -> T time body -> (T body time, T time body)
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 = (T time body -> (T body time, T time body))
-> T time body -> (T time body, T time body)
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 time body -> (T body time, T time body))
 -> T time body -> (T time body, T time body))
-> (time -> T time body -> (T body time, T time body))
-> time
-> T time body
-> (T time body, T time body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time -> time -> (time, (Bool, time)))
-> time -> T time body -> (T body time, T time body)
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))
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 = (T time body, T time body) -> T time body
forall a b. (a, b) -> a
fst ((T time body, T time body) -> T time body)
-> (T time body -> (T time body, T time body))
-> T time body
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> T time body -> (T time body, T time body)
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 = (T time body, T time body) -> T time body
forall a b. (a, b) -> b
snd ((T time body, T time body) -> T time body)
-> (T time body -> (T time body, T time body))
-> T time body
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> T time body -> (T time body, T time body)
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 =
   (T time body -> (T body time, T time body))
-> T time body -> (T time body, T time body)
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 time body -> (T body time, T time body))
 -> T time body -> (T time body, T time body))
-> (time -> T time body -> (T body time, T time body))
-> time
-> T time body
-> (T time body, T time body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (time -> time -> (time, (Bool, time)))
-> time -> T time body -> (T body time, T time body)
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 -> ((Bool, time) -> (Bool, time))
-> (time, (Bool, time)) -> (time, (Bool, time))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((Bool -> Bool) -> (Bool, time) -> (Bool, time)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Bool -> Bool
not) ((time, (Bool, time)) -> (time, (Bool, time)))
-> (time, (Bool, time)) -> (time, (Bool, time))
forall a b. (a -> b) -> a -> b
$ time -> time -> (time, (Bool, time))
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 = (T time body, T time body) -> T time body
forall a b. (a, b) -> a
fst ((T time body, T time body) -> T time body)
-> (T time body -> (T time body, T time body))
-> T time body
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> T time body -> (T time body, T time body)
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 = (T time body, T time body) -> T time body
forall a b. (a, b) -> b
snd ((T time body, T time body) -> T time body)
-> (T time body -> (T time body, T time body))
-> T time body
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> T time body -> (T time body, T time body)
forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAfterTime time
t