{- |
Copyright   :  (c) Henning Thielemann 2007-2010

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


Event lists starting with a time difference and ending with a body.


The time is stored in differences between the events.
Thus there is no increase of time information for long,
or even infinite, streams of events.
Further on, the time difference is stored
in the latter of two neighbouring events.
This is necessary for real-time computing
where it is not known whether and when the next event happens.

-}
module Data.EventList.Relative.TimeBody
   (T,
    empty, singleton, null,
    viewL, viewR, switchL, switchR, cons, snoc,
    fromPairList, toPairList,
    getTimes, getBodies, duration,
    mapBody, mapTime,
    zipWithBody, zipWithTime, unzip,
    concatMapMonoid,
    traverse, traverse_, traverseBody, traverseTime,
    mapM, mapM_, mapBodyM, mapTimeM,
    foldr, foldrPair,
    merge, mergeBy, insert, insertBy,
    moveForward,
    decreaseStart, delay, filter, partition, partitionMaybe, slice, span,
    mapMaybe, catMaybes,
    normalize, isNormalized,
    collectCoincident, flatten, mapCoincident,
    append, concat, cycle,
    discretize, resample,
    toAbsoluteEventList, fromAbsoluteEventList,
    toAbsoluteEventListGen, fromAbsoluteEventListGen,
   ) where

import Data.EventList.Relative.TimeBodyPrivate
import qualified Data.EventList.Relative.BodyBodyPrivate as BodyBodyPriv

import qualified Data.EventList.Absolute.TimeBodyPrivate as AbsoluteEventPriv
import qualified Data.EventList.Absolute.TimeBody as AbsoluteEventList

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 qualified Data.List as List
import qualified Data.EventList.Utility as Utility

import Control.Applicative (Applicative, WrappedMonad(WrapMonad, unwrapMonad), )
import Data.Monoid (Monoid, )

import qualified Numeric.NonNegative.Class as NonNeg
import Numeric.NonNegative.Class ((-|), zero, add, )
import Data.Tuple.HT (mapFst, mapSnd, mapPair, )
import Data.Maybe.HT (toMaybe, )
import Data.List.HT (isAscending, )
import Control.Monad.Trans.State (evalState, modify, get, put, )
import Control.Monad (Monad, return, (>>), )

import Data.Function (flip, const, (.), ($), )
import Data.Functor (fmap, )
import Data.Maybe (Maybe(Just, Nothing), maybe, )
import Data.Bool (Bool, not, (||), (&&), )
import Data.Tuple (uncurry, fst, snd, )
import Data.Ord (Ord, (<), )
import Data.Eq (Eq, (/=), )
import Prelude (Num, Integral, RealFrac, (*), (+), (-), error, )



empty :: T time body
empty :: forall time body. T time body
empty = T time body -> T time body
forall time body. T time body -> T time body
Cons T time body
forall a b. T a b
Disp.empty

null :: T time body -> Bool
null :: forall time body. T time body -> Bool
null = T time body -> Bool
forall a b. T a b -> Bool
Disp.null (T time body -> Bool)
-> (T time body -> T time body) -> T time body -> Bool
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
decons

singleton :: time -> body -> T time body
singleton :: forall time body. time -> body -> T time body
singleton time
time body
body = T time body -> T time body
forall time body. T time body -> T time body
Cons (T time body -> T time body) -> T time body -> T time body
forall a b. (a -> b) -> a -> b
$ time -> body -> T time body
forall a b. a -> b -> T a b
Disp.singleton time
time body
body


cons :: time -> body -> T time body -> T time body
cons :: forall time body. time -> body -> T time body -> T time body
cons time
time body
body = (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
lift (time -> body -> T time body -> T time body
forall a b. a -> b -> T a b -> T a b
Disp.cons time
time body
body)

snoc :: T time body -> time -> body -> T time body
snoc :: forall time body. T time body -> time -> body -> T time body
snoc T time body
xs time
time body
body = T time body -> T time body
forall time body. T time body -> T time body
Cons (T time body -> T time body) -> T time body -> T time body
forall a b. (a -> b) -> a -> b
$ (T time body -> time -> body -> T time body
forall a b. T a b -> a -> b -> T a b
Disp.snoc (T time body -> time -> body -> T time body)
-> T time body -> time -> body -> T time body
forall time body a. (T time body -> a) -> T time body -> a
$~* T time body
xs) time
time body
body



viewL :: T time body -> Maybe ((time, body), T time body)
viewL :: forall time body. T time body -> Maybe ((time, body), T time body)
viewL = (((time, body), T time body) -> ((time, body), T time body))
-> Maybe ((time, body), T time body)
-> Maybe ((time, body), T time body)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T time body -> T time body)
-> ((time, body), T time body) -> ((time, body), T time body)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd T time body -> T time body
forall time body. T time body -> T time body
Cons) (Maybe ((time, body), T time body)
 -> Maybe ((time, body), T time body))
-> (T time body -> Maybe ((time, body), T time body))
-> T time body
-> Maybe ((time, body), T time body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> Maybe ((time, body), T time body)
forall a b. T a b -> Maybe ((a, b), T a b)
Disp.viewL (T time body -> Maybe ((time, body), T time body))
-> (T time body -> T time body)
-> T time body
-> Maybe ((time, body), T time body)
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
decons

viewR :: T time body -> Maybe (T time body, (time, body))
viewR :: forall time body. T time body -> Maybe (T time body, (time, body))
viewR = ((T time body, (time, body)) -> (T time body, (time, body)))
-> Maybe (T time body, (time, body))
-> Maybe (T time body, (time, body))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T time body -> T time body)
-> (T time body, (time, body)) -> (T time body, (time, body))
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst T time body -> T time body
forall time body. T time body -> T time body
Cons) (Maybe (T time body, (time, body))
 -> Maybe (T time body, (time, body)))
-> (T time body -> Maybe (T time body, (time, body)))
-> T time body
-> Maybe (T time body, (time, body))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> Maybe (T time body, (time, body))
forall a b. T a b -> Maybe (T a b, (a, b))
Disp.viewR (T time body -> Maybe (T time body, (time, body)))
-> (T time body -> T time body)
-> T time body
-> Maybe (T time body, (time, body))
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
decons


{-# INLINE switchL #-}
switchL :: c -> ((time, body) -> T time body -> c) -> T time body -> c
switchL :: forall c time body.
c -> ((time, body) -> T time body -> c) -> T time body -> c
switchL c
f (time, body) -> T time body -> c
g = c -> (time -> body -> T time body -> c) -> T time body -> c
forall c a b. c -> (a -> b -> T a b -> c) -> T a b -> c
Disp.switchL c
f (\ time
t body
b  -> (time, body) -> T time body -> c
g (time
t,body
b) (T time body -> c)
-> (T time body -> T time body) -> T time body -> c
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
Cons) (T time body -> c)
-> (T time body -> T time body) -> T time body -> c
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
decons

{-# INLINE switchR #-}
switchR :: c -> (T time body -> (time, body) -> c) -> T time body -> c
switchR :: forall c time body.
c -> (T time body -> (time, body) -> c) -> T time body -> c
switchR c
f T time body -> (time, body) -> c
g = c -> (T time body -> time -> body -> c) -> T time body -> c
forall c a b. c -> (T a b -> a -> b -> c) -> T a b -> c
Disp.switchR c
f (\T time body
xs time
t body
b -> T time body -> (time, body) -> c
g (T time body -> T time body
forall time body. T time body -> T time body
Cons T time body
xs) (time
t,body
b)) (T time body -> c)
-> (T time body -> T time body) -> T time body -> c
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
decons



fromPairList :: [(a,b)] -> T a b
fromPairList :: forall a b. [(a, b)] -> T a b
fromPairList = T a b -> T a b
forall time body. T time body -> T time body
Cons (T a b -> T a b) -> ([(a, b)] -> T a b) -> [(a, b)] -> T a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> T a b
forall a b. [(a, b)] -> T a b
Disp.fromPairList

toPairList :: T a b -> [(a,b)]
toPairList :: forall a b. T a b -> [(a, b)]
toPairList = T a b -> [(a, b)]
forall a b. T a b -> [(a, b)]
Disp.toPairList (T a b -> [(a, b)]) -> (T a b -> T a b) -> T a b -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a b -> T a b
forall time body. T time body -> T time body
decons

getBodies :: T time body -> [body]
getBodies :: forall time body. T time body -> [body]
getBodies = T time body -> [body]
forall a b. T a b -> [b]
Disp.getSeconds (T time body -> [body])
-> (T time body -> T time body) -> T time body -> [body]
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
decons

getTimes :: T time body -> [time]
getTimes :: forall time body. T time body -> [time]
getTimes = T time body -> [time]
forall a b. T a b -> [a]
Disp.getFirsts (T time body -> [time])
-> (T time body -> T time body) -> T time 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
decons

duration :: NonNeg.C time => T time body -> time
duration :: forall time body. C time => T time body -> time
duration = [time] -> time
forall a. C a => [a] -> a
NonNeg.sum ([time] -> time) -> (T time body -> [time]) -> T time body -> time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> [time]
forall time body. T time body -> [time]
getTimes



mapBody :: (body0 -> body1) -> T time body0 -> T time body1
mapBody :: forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
mapBody body0 -> body1
f = (T time body0 -> T time body1) -> T time body0 -> T time body1
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift ((body0 -> body1) -> T time body0 -> T time body1
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
Disp.mapSecond body0 -> body1
f)

mapTime :: (time0 -> time1) -> T time0 body -> T time1 body
mapTime :: forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime time0 -> time1
f = (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
lift ((time0 -> time1) -> T time0 body -> T time1 body
forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
Disp.mapFirst time0 -> time1
f)


zipWithBody ::
   (body0 -> body1 -> body2) ->
   [body0] -> T time body1 -> T time body2
zipWithBody :: forall body0 body1 body2 time.
(body0 -> body1 -> body2)
-> [body0] -> T time body1 -> T time body2
zipWithBody body0 -> body1 -> body2
f = (T time body1 -> T time body2) -> T time body1 -> T time body2
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift ((T time body1 -> T time body2) -> T time body1 -> T time body2)
-> ([body0] -> T time body1 -> T time body2)
-> [body0]
-> T time body1
-> T time body2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (body0 -> body1 -> body2)
-> [body0] -> T time body1 -> T time body2
forall b0 b1 b2 a. (b0 -> b1 -> b2) -> [b0] -> T a b1 -> T a b2
Disp.zipWithSecond body0 -> body1 -> body2
f

zipWithTime ::
   (time0 -> time1 -> time2) ->
   [time0] -> T time1 body -> T time2 body
zipWithTime :: forall time0 time1 time2 body.
(time0 -> time1 -> time2)
-> [time0] -> T time1 body -> T time2 body
zipWithTime time0 -> time1 -> time2
f = (T time1 body -> T time2 body) -> T time1 body -> T time2 body
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift ((T time1 body -> T time2 body) -> T time1 body -> T time2 body)
-> ([time0] -> T time1 body -> T time2 body)
-> [time0]
-> T time1 body
-> T time2 body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time0 -> time1 -> time2)
-> [time0] -> T time1 body -> T time2 body
forall a0 a1 a2 b. (a0 -> a1 -> a2) -> [a0] -> T a1 b -> T a2 b
Disp.zipWithFirst time0 -> time1 -> time2
f


unzip :: T time (body0, body1) -> (T time body0, T time body1)
unzip :: forall time body0 body1.
T time (body0, body1) -> (T time body0, T time body1)
unzip =
   (time
 -> (body0, body1)
 -> (T time body0, T time body1)
 -> (T time body0, T time body1))
-> (T time body0, T time body1)
-> T time (body0, body1)
-> (T time body0, T time body1)
forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair
      (\time
time (body0
body0, body1
body1) ->
         (T time body0 -> T time body0, T time body1 -> T time body1)
-> (T time body0, T time body1) -> (T time body0, T time body1)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (time -> body0 -> T time body0 -> T time body0
forall time body. time -> body -> T time body -> T time body
cons time
time body0
body0, time -> body1 -> T time body1 -> T time body1
forall time body. time -> body -> T time body -> T time body
cons time
time body1
body1))
      (T time body0
forall time body. T time body
empty, T time body1
forall time body. T time body
empty)



concatMapMonoid :: Monoid m =>
   (time -> m) -> (body -> m) ->
   T time body -> m
concatMapMonoid :: forall m time body.
Monoid m =>
(time -> m) -> (body -> m) -> T time body -> m
concatMapMonoid time -> m
f body -> m
g =
   (time -> m) -> (body -> m) -> T time body -> m
forall m time body.
Monoid m =>
(time -> m) -> (body -> m) -> T time body -> m
Disp.concatMapMonoid time -> m
f body -> m
g (T time body -> m)
-> (T time body -> T time body) -> T time body -> m
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
decons


traverse :: Applicative m =>
   (time0 -> m time1) -> (body0 -> m body1) ->
   T time0 body0 -> m (T time1 body1)
traverse :: forall (m :: * -> *) time0 time1 body0 body1.
Applicative m =>
(time0 -> m time1)
-> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
traverse time0 -> m time1
f body0 -> m body1
g = (T time0 body0 -> m (T time1 body1))
-> T time0 body0 -> m (T time1 body1)
forall (m :: * -> *) time0 body0 time1 body1.
Applicative m =>
(T time0 body0 -> m (T time1 body1))
-> T time0 body0 -> m (T time1 body1)
liftA ((time0 -> m time1)
-> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
forall (m :: * -> *) a0 a1 b0 b1.
Applicative m =>
(a0 -> m a1) -> (b0 -> m b1) -> T a0 b0 -> m (T a1 b1)
Disp.traverse time0 -> m time1
f body0 -> m body1
g)

traverse_ :: Applicative m =>
   (time -> m ()) -> (body -> m ()) ->
   T time body -> m ()
traverse_ :: forall (m :: * -> *) time body.
Applicative m =>
(time -> m ()) -> (body -> m ()) -> T time body -> m ()
traverse_ time -> m ()
f body -> m ()
g = (time -> m ()) -> (body -> m ()) -> T time body -> m ()
forall (m :: * -> *) d a b.
(Applicative m, Monoid d) =>
(a -> m d) -> (b -> m d) -> T a b -> m d
Disp.traverse_ time -> m ()
f body -> m ()
g (T time body -> m ())
-> (T time body -> T time body) -> T time body -> m ()
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
decons


traverseBody :: Applicative m =>
   (body0 -> m body1) -> T time body0 -> m (T time body1)
traverseBody :: forall (m :: * -> *) body0 body1 time.
Applicative m =>
(body0 -> m body1) -> T time body0 -> m (T time body1)
traverseBody body0 -> m body1
f = (T time body0 -> m (T time body1))
-> T time body0 -> m (T time body1)
forall (m :: * -> *) time0 body0 time1 body1.
Applicative m =>
(T time0 body0 -> m (T time1 body1))
-> T time0 body0 -> m (T time1 body1)
liftA ((body0 -> m body1) -> T time body0 -> m (T time body1)
forall (m :: * -> *) b0 b1 a.
Applicative m =>
(b0 -> m b1) -> T a b0 -> m (T a b1)
Disp.traverseSecond body0 -> m body1
f)

traverseTime :: Applicative m =>
   (time0 -> m time1) -> T time0 body -> m (T time1 body)
traverseTime :: forall (m :: * -> *) time0 time1 body.
Applicative m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
traverseTime time0 -> m time1
f = (T time0 body -> m (T time1 body))
-> T time0 body -> m (T time1 body)
forall (m :: * -> *) time0 body0 time1 body1.
Applicative m =>
(T time0 body0 -> m (T time1 body1))
-> T time0 body0 -> m (T time1 body1)
liftA ((time0 -> m time1) -> T time0 body -> m (T time1 body)
forall (m :: * -> *) a0 a1 b.
Applicative m =>
(a0 -> m a1) -> T a0 b -> m (T a1 b)
Disp.traverseFirst time0 -> m time1
f)


mapM :: Monad m =>
   (time0 -> m time1) -> (body0 -> m body1) ->
   T time0 body0 -> m (T time1 body1)
mapM :: forall (m :: * -> *) time0 time1 body0 body1.
Monad m =>
(time0 -> m time1)
-> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
mapM time0 -> m time1
f body0 -> m body1
g =
   WrappedMonad m (T time1 body1) -> m (T time1 body1)
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m (T time1 body1) -> m (T time1 body1))
-> (T time0 body0 -> WrappedMonad m (T time1 body1))
-> T time0 body0
-> m (T time1 body1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time0 -> WrappedMonad m time1)
-> (body0 -> WrappedMonad m body1)
-> T time0 body0
-> WrappedMonad m (T time1 body1)
forall (m :: * -> *) time0 time1 body0 body1.
Applicative m =>
(time0 -> m time1)
-> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
traverse (m time1 -> WrappedMonad m time1
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m time1 -> WrappedMonad m time1)
-> (time0 -> m time1) -> time0 -> WrappedMonad m time1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time0 -> m time1
f) (m body1 -> WrappedMonad m body1
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m body1 -> WrappedMonad m body1)
-> (body0 -> m body1) -> body0 -> WrappedMonad m body1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. body0 -> m body1
g)

mapM_ :: Monad m =>
   (time -> m ()) -> (body -> m ()) ->
   T time body -> m ()
mapM_ :: forall (m :: * -> *) time body.
Monad m =>
(time -> m ()) -> (body -> m ()) -> T time body -> m ()
mapM_ time -> m ()
f body -> m ()
g =
   WrappedMonad m () -> m ()
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m () -> m ())
-> (T time body -> WrappedMonad m ()) -> T time body -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time -> WrappedMonad m ())
-> (body -> WrappedMonad m ()) -> T time body -> WrappedMonad m ()
forall (m :: * -> *) time body.
Applicative m =>
(time -> m ()) -> (body -> m ()) -> T time body -> m ()
traverse_ (m () -> WrappedMonad m ()
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m () -> WrappedMonad m ())
-> (time -> m ()) -> time -> WrappedMonad m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> m ()
f) (m () -> WrappedMonad m ()
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m () -> WrappedMonad m ())
-> (body -> m ()) -> body -> WrappedMonad m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. body -> m ()
g)


mapBodyM :: Monad m =>
   (body0 -> m body1) -> T time body0 -> m (T time body1)
mapBodyM :: forall (m :: * -> *) body0 body1 time.
Monad m =>
(body0 -> m body1) -> T time body0 -> m (T time body1)
mapBodyM body0 -> m body1
f = WrappedMonad m (T time body1) -> m (T time body1)
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m (T time body1) -> m (T time body1))
-> (T time body0 -> WrappedMonad m (T time body1))
-> T time body0
-> m (T time body1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (body0 -> WrappedMonad m body1)
-> T time body0 -> WrappedMonad m (T time body1)
forall (m :: * -> *) body0 body1 time.
Applicative m =>
(body0 -> m body1) -> T time body0 -> m (T time body1)
traverseBody (m body1 -> WrappedMonad m body1
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m body1 -> WrappedMonad m body1)
-> (body0 -> m body1) -> body0 -> WrappedMonad m body1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. body0 -> m body1
f)

mapTimeM :: Monad m =>
   (time0 -> m time1) -> T time0 body -> m (T time1 body)
mapTimeM :: forall (m :: * -> *) time0 time1 body.
Monad m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
mapTimeM time0 -> m time1
f = WrappedMonad m (T time1 body) -> m (T time1 body)
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m (T time1 body) -> m (T time1 body))
-> (T time0 body -> WrappedMonad m (T time1 body))
-> T time0 body
-> m (T time1 body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time0 -> WrappedMonad m time1)
-> T time0 body -> WrappedMonad m (T time1 body)
forall (m :: * -> *) time0 time1 body.
Applicative m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
traverseTime (m time1 -> WrappedMonad m time1
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m time1 -> WrappedMonad m time1)
-> (time0 -> m time1) -> time0 -> WrappedMonad m time1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time0 -> m time1
f)




foldr :: (time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b
foldr :: forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b
foldr time -> a -> b
f body -> b -> a
g b
x = (time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b
forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> d
Disp.foldr time -> a -> b
f body -> b -> a
g b
x (T time body -> b)
-> (T time body -> T time body) -> T time body -> b
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
decons

foldrPair :: (time -> body -> a -> a) -> a -> T time body -> a
foldrPair :: forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair time -> body -> a -> a
f a
x = (time -> body -> a -> a) -> a -> T time body -> a
forall a b c. (a -> b -> c -> c) -> c -> T a b -> c
Disp.foldrPair time -> body -> a -> a
f a
x (T time body -> a)
-> (T time body -> T time body) -> T time body -> a
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
decons


{- |
Keep only events that match a predicate while preserving absolute times.
-}
filter :: (NonNeg.C time) =>
   (body -> Bool) -> T time body -> T time body
filter :: forall time body.
C time =>
(body -> Bool) -> T time body -> T time body
filter body -> Bool
p = (body -> Maybe body) -> T time body -> T time body
forall time body0 body1.
C time =>
(body0 -> Maybe body1) -> T time body0 -> T time body1
mapMaybe (\body
b -> Bool -> body -> Maybe body
forall a. Bool -> a -> Maybe a
toMaybe (body -> Bool
p body
b) body
b)
-- filter p = fst . partition p

mapMaybe :: (NonNeg.C time) =>
   (body0 -> Maybe body1) ->
   T time body0 -> T time body1
mapMaybe :: forall time body0 body1.
C time =>
(body0 -> Maybe body1) -> T time body0 -> T time body1
mapMaybe body0 -> Maybe body1
f = T time (Maybe body1) -> T time body1
forall time body. C time => T time (Maybe body) -> T time body
catMaybes (T time (Maybe body1) -> T time body1)
-> (T time body0 -> T time (Maybe body1))
-> T time body0
-> T time body1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (body0 -> Maybe body1) -> T time body0 -> T time (Maybe body1)
forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
mapBody body0 -> Maybe body1
f

{- |
Adds times in a left-associative fashion.
Use this if the time is a strict data type.
-}
catMaybes :: (NonNeg.C time) =>
   T time (Maybe body) -> T time body
catMaybes :: forall time body. C time => T time (Maybe body) -> T time body
catMaybes =
   T time body -> T time body
forall time body. T time body -> T time body
Cons (T time body -> T time body)
-> (T time (Maybe body) -> T time body)
-> T time (Maybe body)
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (T time body, time) -> T time body
forall a b. (a, b) -> a
fst ((T time body, time) -> T time body)
-> (T time (Maybe body) -> (T time body, time))
-> T time (Maybe body)
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body time -> (T time body, time)
forall a b. T a b -> (T b a, b)
Mixed.viewSecondR (T body time -> (T time body, time))
-> (T time (Maybe body) -> T body time)
-> T time (Maybe body)
-> (T time body, time)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ([time] -> time) -> T body [time] -> T body time
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
Uniform.mapSecond [time] -> time
forall a. C a => [a] -> a
NonNeg.sum (T body [time] -> T body time)
-> (T time (Maybe body) -> T body [time])
-> T time (Maybe body)
-> T body time
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T (Maybe body) time -> T body [time]
forall a b. T (Maybe a) b -> T a [b]
Uniform.catMaybesFirst (T (Maybe body) time -> T body [time])
-> (T time (Maybe body) -> T (Maybe body) time)
-> T time (Maybe body)
-> T body [time]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (T time (Maybe body) -> time -> T (Maybe body) time)
-> time -> T time (Maybe body) -> T (Maybe body) time
forall a b c. (a -> b -> c) -> b -> a -> c
flip T time (Maybe body) -> time -> T (Maybe body) time
forall b a. T b a -> b -> T a b
Mixed.snocSecond ([Char] -> time
forall a. HasCallStack => [Char] -> a
error [Char]
"catMaybes: no trailing time") (T time (Maybe body) -> T (Maybe body) time)
-> (T time (Maybe body) -> T time (Maybe body))
-> T time (Maybe body)
-> T (Maybe body) time
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time (Maybe body) -> T time (Maybe body)
forall time body. T time body -> T time body
decons

{-
The function 'partition' is somehow the inverse to 'merge'.
It is similar to 'List.partition'.
We could use the List function if the event times would be absolute,
because then the events need not to be altered on splits.
But absolute time points can't be used for infinite music
thus we take the burden of adapting the time differences
when an event is removed from the performance list and
put to the list of events of a particular instrument.
@t0@ is the time gone since the last event in the first partition,
@t1@ is the time gone since the last event in the second partition.

Note, that using 'Data.EventList.Utility.mapPair' we circumvent the following problem:
Since the recursive call to 'partition'
may end up with Bottom,
pattern matching with, say \expression{(es0,es1)},
will halt the bounding of the variables
until the most inner call to 'partition' is finished.
This never happens.
If the pair constructor is made strict,
that is we write \expression{~(es0,es1)},
then everything works.
Also avoiding pattern matching and
using 'fst' and 'snd' would help.

-}

{-
Could be implemented more easily in terms of Uniform.partition
-}
partition :: (NonNeg.C time) =>
   (body -> Bool) -> T time body -> (T time body, T time body)
partition :: forall time body.
C time =>
(body -> Bool) -> T time body -> (T time body, T time body)
partition body -> Bool
p = (body -> Bool)
-> time -> time -> T time body -> (T time body, T time body)
forall time body.
C time =>
(body -> Bool)
-> time -> time -> T time body -> (T time body, T time body)
partitionRec body -> Bool
p time
forall a. C a => a
zero time
forall a. C a => a
zero

partitionRec :: (NonNeg.C time) =>
   (body -> Bool) -> time -> time ->
       T time body -> (T time body, T time body)
partitionRec :: forall time body.
C time =>
(body -> Bool)
-> time -> time -> T time body -> (T time body, T time body)
partitionRec body -> Bool
p =
   let recourse :: t -> t -> T t body -> (T t body, T t body)
recourse t
t0 t
t1 =
          (T t body, T t body)
-> ((t, body) -> T t body -> (T t body, T t body))
-> T t body
-> (T t body, T t body)
forall c time body.
c -> ((time, body) -> T time body -> c) -> T time body -> c
switchL
             (T t body
forall time body. T time body
empty, T t body
forall time body. T time body
empty)
             (\ (t
t, body
b) T t body
es ->
                let t0' :: t
t0' = t -> t -> t
forall a. C a => a -> a -> a
add t
t0 t
t
                    t1' :: t
t1' = t -> t -> t
forall a. C a => a -> a -> a
add t
t1 t
t
                in  if body -> Bool
p body
b
                      then (T t body -> T t body)
-> (T t body, T t body) -> (T t body, T t body)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (t -> body -> T t body -> T t body
forall time body. time -> body -> T time body -> T time body
cons t
t0' body
b) (t -> t -> T t body -> (T t body, T t body)
recourse t
forall a. C a => a
zero t
t1' T t body
es)
                      else (T t body -> T t body)
-> (T t body, T t body) -> (T t body, T t body)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (t -> body -> T t body -> T t body
forall time body. time -> body -> T time body -> T time body
cons t
t1' body
b) (t -> t -> T t body -> (T t body, T t body)
recourse t
t0' t
forall a. C a => a
zero T t body
es))
   in  time -> time -> T time body -> (T time body, T time body)
forall {t}. C t => t -> t -> T t body -> (T t body, T t body)
recourse

partitionMaybe :: (NonNeg.C time) =>
   (body0 -> Maybe body1) -> T time body0 ->
   (T time body1, T time body0)
partitionMaybe :: forall time body0 body1.
C time =>
(body0 -> Maybe body1)
-> T time body0 -> (T time body1, T time body0)
partitionMaybe body0 -> Maybe body1
f =
   (T time (Maybe body1) -> T time body1,
 T time (Maybe body0) -> T time body0)
-> (T time (Maybe body1), T time (Maybe body0))
-> (T time body1, T time body0)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (T time (Maybe body1) -> T time body1
forall time body. C time => T time (Maybe body) -> T time body
catMaybes, T time (Maybe body0) -> T time body0
forall time body. C time => T time (Maybe body) -> T time body
catMaybes) ((T time (Maybe body1), T time (Maybe body0))
 -> (T time body1, T time body0))
-> (T time body0 -> (T time (Maybe body1), T time (Maybe body0)))
-> T time body0
-> (T time body1, T time body0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (time
 -> body0
 -> (T time (Maybe body1), T time (Maybe body0))
 -> (T time (Maybe body1), T time (Maybe body0)))
-> (T time (Maybe body1), T time (Maybe body0))
-> T time body0
-> (T time (Maybe body1), T time (Maybe body0))
forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair (\time
t body0
a ->
      let mb :: Maybe body1
mb = body0 -> Maybe body1
f body0
a
          a1 :: Maybe body0
a1 = Maybe body0 -> (body1 -> Maybe body0) -> Maybe body1 -> Maybe body0
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (body0 -> Maybe body0
forall a. a -> Maybe a
Just body0
a) (Maybe body0 -> body1 -> Maybe body0
forall a b. a -> b -> a
const Maybe body0
forall a. Maybe a
Nothing) Maybe body1
mb
      in  (T time (Maybe body1) -> T time (Maybe body1),
 T time (Maybe body0) -> T time (Maybe body0))
-> (T time (Maybe body1), T time (Maybe body0))
-> (T time (Maybe body1), T time (Maybe body0))
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (time -> Maybe body1 -> T time (Maybe body1) -> T time (Maybe body1)
forall time body. time -> body -> T time body -> T time body
cons time
t Maybe body1
mb, time -> Maybe body0 -> T time (Maybe body0) -> T time (Maybe body0)
forall time body. time -> body -> T time body -> T time body
cons time
t Maybe body0
a1))
      (T time (Maybe body1)
forall time body. T time body
empty, T time (Maybe body0)
forall time body. T time body
empty)

{- |
Using a classification function
we splice the event list into lists, each containing the same class.
Absolute time stamps are preserved.
-}
slice :: (Eq a, NonNeg.C time) =>
   (body -> a) -> T time body -> [(a, T time body)]
slice :: forall a time body.
(Eq a, C time) =>
(body -> a) -> T time body -> [(a, T time body)]
slice = (T time body -> Maybe body)
-> ((body -> Bool) -> T time body -> (T time body, T time body))
-> (body -> a)
-> T time body
-> [(a, T time body)]
forall a eventlist body.
Eq a =>
(eventlist -> Maybe body)
-> ((body -> Bool) -> eventlist -> (eventlist, eventlist))
-> (body -> a)
-> eventlist
-> [(a, eventlist)]
Utility.slice ((((time, body), T time body) -> body)
-> Maybe ((time, body), T time body) -> Maybe body
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((time, body) -> body
forall a b. (a, b) -> b
snd ((time, body) -> body)
-> (((time, body), T time body) -> (time, body))
-> ((time, body), T time body)
-> body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((time, body), T time body) -> (time, body)
forall a b. (a, b) -> a
fst) (Maybe ((time, body), T time body) -> Maybe body)
-> (T time body -> Maybe ((time, body), T time body))
-> T time body
-> Maybe body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> Maybe ((time, body), T time body)
forall time body. T time body -> Maybe ((time, body), T time body)
viewL) (body -> Bool) -> T time body -> (T time body, T time body)
forall time body.
C time =>
(body -> Bool) -> T time body -> (T time body, T time body)
partition


span :: (body -> Bool) -> T time body -> (T time body, T time body)
span :: forall body time.
(body -> Bool) -> T time body -> (T time body, T time body)
span body -> Bool
p = (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 a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (T time body -> T time body
forall time body. T time body -> T time body
Cons, T time body -> T time body
forall time body. T time body -> T time body
Cons) ((T time body, T time body) -> (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
. (body -> Bool) -> T time body -> (T time body, T time body)
forall b a. (b -> Bool) -> T a b -> (T a b, T a b)
Disp.spanSecond body -> Bool
p (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
. T time body -> T time body
forall time body. T time body -> T time body
decons


{- |
Group events that have equal start times
(that is zero time differences).
-}
collectCoincident :: (NonNeg.C time) => T time body -> T time [body]
collectCoincident :: forall time body. C time => T time body -> T time [body]
collectCoincident =
   (T time body -> T time [body]) -> T time body -> T time [body]
forall time body0 body1.
(T time body0 -> T time body1) -> T time body0 -> T time body1
mapTimeTail ((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 a b. (a -> b) -> a -> b
$ (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
BodyBodyPriv.lift ((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 a b. (a -> b) -> a -> b
$ (time -> Bool) -> T time body -> T time [body]
forall a b. (a -> Bool) -> T a b -> T a [b]
Uniform.filterFirst (time
forall a. C a => a
zero time -> time -> Bool
forall a. Ord a => a -> a -> Bool
<)

{- |
Reverse to collectCoincident:
Turn each @body@ into a separate event.

>   xs  ==  flatten (collectCoincident xs)
-}
flatten :: (NonNeg.C time) => T time [body] -> T time body
flatten :: forall time body. C time => T time [body] -> T time body
flatten =
   T time body -> T time body
forall time body. T time body -> T time body
Cons (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
.
   T time body
-> (time -> T time [body] -> T time body)
-> T time [body]
-> T time body
forall c a b. c -> (a -> T a b -> c) -> T a b -> c
Mixed.switchFirstL
      T time body
forall a b. T a b
Disp.empty
      (\time
time ->
         (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
unlift (time -> T time body -> T time body
forall time body. C time => time -> T time body -> T time body
delay time
time) (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
.
         (T time body, time) -> T time body
forall a b. (a, b) -> a
fst ((T time body, time) -> T time body)
-> (T time [body] -> (T time body, time))
-> T time [body]
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body time -> (T time body, time)
forall a b. T a b -> (T b a, b)
Mixed.viewSecondR (T body time -> (T time body, time))
-> (T time [body] -> T body time)
-> T time [body]
-> (T time body, time)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         ([body] -> T body time -> T body time)
-> (time -> T body time -> T body time)
-> T body time
-> T [body] time
-> T body time
forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c
Uniform.foldr
            (T time body -> T body time -> T body time
forall a b. T a b -> T b a -> T b a
Mixed.appendUniformUniform (T time body -> T body time -> T body time)
-> ([body] -> T time body) -> [body] -> T body time -> T body time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> [body] -> T time body
forall a b. a -> [b] -> T a b
Uniform.fromSecondList time
forall a. C a => a
zero)
            time -> T body time -> T body time
forall b a. b -> T a b -> T a b
Mixed.consSecond T body time
forall a b. T a b
Disp.empty (T [body] time -> T body time)
-> (T time [body] -> T [body] time) -> T time [body] -> T body time
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         ([time] -> time) -> T [body] [time] -> T [body] time
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
Uniform.mapSecond [time] -> time
forall a. C a => [a] -> a
NonNeg.sum (T [body] [time] -> T [body] time)
-> (T time [body] -> T [body] [time])
-> T time [body]
-> T [body] time
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         ([body] -> Bool) -> T time [body] -> T [body] [time]
forall b a. (b -> Bool) -> T a b -> T b [a]
Uniform.filterSecond (Bool -> Bool
not (Bool -> Bool) -> ([body] -> Bool) -> [body] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [body] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null)) (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
.
   T time [body] -> T time [body]
forall time body. T time body -> T time body
decons


{- |
Apply a function to the lists of coincident events.
-}
mapCoincident :: (NonNeg.C time) =>
   ([a] -> [b]) -> T time a -> T time b
mapCoincident :: forall time a b. C time => ([a] -> [b]) -> T time a -> T time b
mapCoincident [a] -> [b]
f = T time [b] -> T time b
forall time body. C time => T time [body] -> T time body
flatten (T time [b] -> T time b)
-> (T time a -> T time [b]) -> T time a -> T time b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [b]) -> T time [a] -> T time [b]
forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
mapBody [a] -> [b]
f (T time [a] -> T time [b])
-> (T time a -> T time [a]) -> T time a -> T time [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time a -> T time [a]
forall time body. C time => T time body -> T time [body]
collectCoincident

{- |
'List.sort' sorts a list of coinciding events,
that is all events but the first one have time difference 0.
'normalize' sorts all coinciding events in a list
thus yielding a canonical representation of a time ordered list.
-}
normalize :: (NonNeg.C time, Ord body) => T time body -> T time body
normalize :: forall time body. (C time, Ord body) => T time body -> T time body
normalize = ([body] -> [body]) -> T time body -> T time body
forall time a b. C time => ([a] -> [b]) -> T time a -> T time b
mapCoincident [body] -> [body]
forall a. Ord a => [a] -> [a]
List.sort

isNormalized :: (NonNeg.C time, Ord body) =>
   T time body -> Bool
isNormalized :: forall time body. (C time, Ord body) => T time body -> Bool
isNormalized =
   ([body] -> Bool) -> [[body]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.all [body] -> Bool
forall a. Ord a => [a] -> Bool
isAscending ([[body]] -> Bool)
-> (T time body -> [[body]]) -> T time body -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time [body] -> [[body]]
forall time body. T time body -> [body]
getBodies (T time [body] -> [[body]])
-> (T time body -> T time [body]) -> T time body -> [[body]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T time [body]
forall time body. C time => T time body -> T time [body]
collectCoincident



{- |
This function merges the events of two lists into a new event list.
Note that 'merge' compares entire events rather than just start times.
This is to ensure that it is commutative,
one of the properties we test for.
-}
merge :: (NonNeg.C time, Ord body) =>
   T time body -> T time body -> T time body
merge :: forall time body.
(C time, Ord body) =>
T time body -> T time body -> T time body
merge = (body -> body -> Bool) -> T time body -> T time body -> T time body
forall time body.
C time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
mergeBy body -> body -> Bool
forall a. Ord a => a -> a -> Bool
(<)

{- |
'mergeBy' is like 'merge' but does not simply use the methods of the 'Ord' class
but allows a custom comparison function.
If in event lists @xs@ and @ys@ there are coinciding elements @x@ and @y@,
and @cmp x y@ is 'True',
then @x@ comes before @y@ in @mergeBy cmp xs ys@.

> EventList> EventList.mergeBy (\_ _ -> True) (0 /. 'a' ./ empty) (0 /. 'b' ./ empty)
> 0 /. 'a' ./ 0 /. 'b' ./ empty
>
> EventList> EventList.mergeBy (\_ _ -> False) (0 /. 'a' ./ empty) (0 /. 'b' ./ empty)
> 0 /. 'b' ./ 0 /. 'a' ./ empty
-}

{-
Could be implemented using 'splitAt' and 'insert'.
-}
mergeBy :: (NonNeg.C time) =>
   (body -> body -> Bool) ->
   T time body -> T time body -> T time body
mergeBy :: forall time body.
C time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
mergeBy body -> body -> Bool
before =
   let recourse :: T time body -> T time body -> T time body
recourse T time body
xs0 T time body
ys0 =
          case (T time body -> Maybe ((time, body), T time body)
forall time body. T time body -> Maybe ((time, body), T time body)
viewL T time body
xs0, T time body -> Maybe ((time, body), T time body)
forall time body. T time body -> Maybe ((time, body), T time body)
viewL T time body
ys0) of
             (Maybe ((time, body), T time body)
Nothing, Maybe ((time, body), T time body)
_) -> T time body
ys0
             (Maybe ((time, body), T time body)
_, Maybe ((time, body), T time body)
Nothing) -> T time body
xs0
             (Just ((time
xt,body
xb),T time body
xs), Just ((time
yt,body
yb),T time body
ys)) ->
                let (time
mt,~(Bool
b,time
dt)) = time -> time -> (time, (Bool, time))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split time
xt time
yt
                in  (body -> T time body -> T time body)
-> (body, T time body) -> T time body
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons time
mt) ((body, T time body) -> T time body)
-> (body, T time body) -> T time body
forall a b. (a -> b) -> a -> b
$
                    if Bool
b Bool -> Bool -> Bool
&& (time
dttime -> time -> Bool
forall a. Eq a => a -> a -> Bool
/=time
forall a. C a => a
zero Bool -> Bool -> Bool
|| body -> body -> Bool
before body
xb body
yb)
                      then (body
xb, T time body -> T time body -> T time body
recourse T time body
xs (T time body -> T time body) -> T time body -> T time body
forall a b. (a -> b) -> a -> b
$ time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons time
dt body
yb T time body
ys)
                      else (body
yb, T time body -> T time body -> T time body
recourse T time body
ys (T time body -> T time body) -> T time body -> T time body
forall a b. (a -> b) -> a -> b
$ time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons time
dt body
xb T time body
xs)
   in  T time body -> T time body -> T time body
forall {time}. C time => T time body -> T time body -> T time body
recourse


{- |
'insert' inserts an event into an event list at the given time.
-}
insert :: (NonNeg.C time, Ord body) =>
   time -> body -> T time body -> T time body
insert :: forall time body.
(C time, Ord body) =>
time -> body -> T time body -> T time body
insert = (body -> body -> Bool)
-> time -> body -> T time body -> T time body
forall time body.
C time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy body -> body -> Bool
forall a. Ord a => a -> a -> Bool
(<)


insertBy :: (NonNeg.C time) =>
   (body -> body -> Bool) ->
   time -> body -> T time body -> T time body
insertBy :: forall time body.
C time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy body -> body -> Bool
before =
   let recourse :: t -> body -> T t body -> T t body
recourse t
t0 body
me0 =
          (\ ~((t
t,body
me), T t body
rest) -> t -> body -> T t body -> T t body
forall time body. time -> body -> T time body -> T time body
cons t
t body
me T t body
rest) (((t, body), T t body) -> T t body)
-> (T t body -> ((t, body), T t body)) -> T t body -> T t body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ((t, body), T t body)
-> ((t, body) -> T t body -> ((t, body), T t body))
-> T t body
-> ((t, body), T t body)
forall c time body.
c -> ((time, body) -> T time body -> c) -> T time body -> c
switchL
             ((t
t0,body
me0), T t body
forall time body. T time body
empty)
             (\(t
t1, body
me1) T t body
mevs ->
                let (t
mt,~(Bool
b,t
dt)) = t -> t -> (t, (Bool, t))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split t
t0 t
t1
                in  (body -> (t, body)) -> (body, T t body) -> ((t, body), T t body)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((,) t
mt) ((body, T t body) -> ((t, body), T t body))
-> (body, T t body) -> ((t, body), T t body)
forall a b. (a -> b) -> a -> b
$
                    if Bool
b Bool -> Bool -> Bool
&& (t
dtt -> t -> Bool
forall a. Eq a => a -> a -> Bool
/=t
forall a. C a => a
zero Bool -> Bool -> Bool
|| body -> body -> Bool
before body
me0 body
me1)
                      then (body
me0, t -> body -> T t body -> T t body
forall time body. time -> body -> T time body -> T time body
cons     t
dt body
me1 T t body
mevs)
                      else (body
me1, t -> body -> T t body -> T t body
recourse t
dt body
me0 T t body
mevs))
   in  time -> body -> T time body -> T time body
forall {t}. C t => t -> body -> T t body -> T t body
recourse


{- |
Move events towards the front of the event list.
You must make sure, that no event is moved before time zero.
This works only for finite lists.
-}
moveForward :: (Ord time, Num time) =>
   T time (time, body) -> T time body
moveForward :: forall time body.
(Ord time, Num time) =>
T time (time, body) -> T time body
moveForward =
   T time body -> T time body
forall time body. Num time => T time body -> T time body
fromAbsoluteEventList (T time body -> T time body)
-> (T time (time, body) -> T time body)
-> T time (time, body)
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time (time, body) -> T time body
forall time body.
(Ord time, Num time) =>
T time (time, body) -> T time body
AbsoluteEventList.moveForward (T time (time, body) -> T time body)
-> (T time (time, body) -> T time (time, body))
-> T time (time, body)
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   time -> T time (time, body) -> T time (time, body)
forall time body. Num time => time -> T time body -> T time body
toAbsoluteEventList time
0


{-
Like 'moveForward' but restricts the look-ahead time.
For @moveForwardRestricted maxTimeDiff xs@
all time differences (aka the moveForward offsets) in @xs@
must be at most @maxTimeDiff@.
With this restriction the function is lazy enough
for handling infinite event lists.
However the larger @maxTimeDiff@ the more memory and time is consumed.
-}
{- for implementation notes see TimeTime

This implementation requires TimeTime.duration, TimeMixed.appendBodyEnd, TimeMixed.splitAtTime
and thus we would need a lot of movement of functions between modules

moveForwardRestricted :: (NonNeg.C time) =>
   time -> T time (time, body) -> T time body
moveForwardRestricted maxTime xs =
   let (prefix,suffix) = splitAtTime maxTime xs
       prefixDur = duration prefix
       getChunk t =
          do (toEmit,toKeep) <- gets (splitAtTime t)
             put toKeep
             return (pad t toEmit)
       insertEvent (t,b) =
          insertBy (\ _ _ -> False) (maxTime - t) b
   in  evalState
          (foldr
             (\t m -> liftM2 append (getChunk t) m)
             (\b m -> modify (insertEvent b) >> m)
             (gets (pad prefixDur)) suffix)
          (moveForward (seq prefixDur prefix))
-}



append :: T time body -> T time body -> T time body
append :: forall time body. T time body -> T time body -> T time body
append T time body
xs = (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
lift (T time body -> T time body -> T time body
forall a b. T a b -> T a b -> T a b
Disp.append (T time body -> T time body -> T time body)
-> T time body -> T time body -> T time body
forall time body a. (T time body -> a) -> T time body -> a
$~* T time body
xs)

concat :: [T time body] -> T time body
concat :: forall time body. [T time body] -> T time body
concat = T time body -> T time body
forall time body. T time body -> T time body
Cons (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
. [T time body] -> T time body
forall a b. [T a b] -> T a b
Disp.concat ([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
. (T time body -> T time body) -> [T time body] -> [T time body]
forall a b. (a -> b) -> [a] -> [b]
List.map T time body -> T time body
forall time body. T time body -> T time body
decons

cycle :: T time body -> T time body
cycle :: forall time body. T time body -> T time body
cycle = (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
lift T time body -> T time body
forall a b. T a b -> T a b
Disp.cycle



decreaseStart :: (NonNeg.C time) =>
   time -> T time body -> T time body
decreaseStart :: forall time body. C time => time -> T time body -> T time body
decreaseStart time
dif =
   (time -> time) -> T time body -> T time body
forall time body. (time -> time) -> T time body -> T time body
mapTimeHead (time -> time -> time
forall a. C a => a -> a -> a
-| time
dif)

delay :: (NonNeg.C time) =>
   time -> T time body -> T time body
delay :: forall time body. C time => time -> T time body -> T time body
delay time
dif =
   (time -> time) -> T time body -> T time body
forall time body. (time -> time) -> T time body -> T time body
mapTimeHead (time -> time -> time
forall a. C a => a -> a -> a
add time
dif)



{- |
We provide 'discretize' and 'resample' for discretizing the time information.
When converting the precise relative event times
to the integer relative event times
we have to prevent accumulation of rounding errors.
We avoid this problem with a stateful conversion
which remembers each rounding error we make.
This rounding error is used to correct the next rounding.
Given the relative time and duration of an event
the function 'floorDiff' creates a 'Control.Monad.State.State'
which computes the rounded relative time.
It is corrected by previous rounding errors.

The resulting event list may have differing time differences
which were equal before discretization,
but the overall timing is uniformly close to the original.

We use 'floorDiff' rather than 'Utility.roundDiff'
in order to compute exclusively with non-negative numbers.
-}

discretize :: (NonNeg.C time, RealFrac time, NonNeg.C i, Integral i) =>
   T time body -> T i body
discretize :: forall time i body.
(C time, RealFrac time, C i, Integral i) =>
T time body -> T i body
discretize =
   (State time (T i body) -> time -> T i body)
-> time -> State time (T i body) -> T i body
forall a b c. (a -> b -> c) -> b -> a -> c
flip State time (T i body) -> time -> T i body
forall s a. State s a -> s -> a
evalState time
0.5 (State time (T i body) -> T i body)
-> (T time body -> State time (T i body))
-> T time body
-> T i body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time -> StateT time Identity i)
-> T time body -> State time (T i body)
forall (m :: * -> *) time0 time1 body.
Monad m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
mapTimeM time -> StateT time Identity i
forall t i. (RealFrac t, Integral i) => t -> State t i
Utility.floorDiff

resample :: (NonNeg.C time, RealFrac time, NonNeg.C i, Integral i) =>
   time -> T time body -> T i body
resample :: forall time i body.
(C time, RealFrac time, C i, Integral i) =>
time -> T time body -> T i body
resample time
rate =
   T time body -> T i body
forall time i body.
(C time, RealFrac time, C i, Integral i) =>
T time body -> T i body
discretize (T time body -> T i body)
-> (T time body -> T time body) -> T time body -> T i body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time -> time) -> T time body -> T time body
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime (time
ratetime -> time -> time
forall a. Num a => a -> a -> a
*)


{- |
We tried hard to compute everything with respect to relative times.
However sometimes we need absolute time values.
-}
toAbsoluteEventList :: (Num time) =>
   time -> T time body -> AbsoluteEventList.T time body
toAbsoluteEventList :: forall time body. Num time => time -> T time body -> T time body
toAbsoluteEventList = (time -> time -> time) -> time -> T time body -> T time body
forall absTime relTime body.
(absTime -> relTime -> absTime)
-> absTime -> T relTime body -> T absTime body
toAbsoluteEventListGen time -> time -> time
forall a. Num a => a -> a -> a
(+)

fromAbsoluteEventList :: (Num time) =>
   AbsoluteEventList.T time body -> T time body
fromAbsoluteEventList :: forall time body. Num time => T time body -> T time body
fromAbsoluteEventList = (time -> time -> time) -> time -> T time body -> T time body
forall absTime relTime body.
(absTime -> absTime -> relTime)
-> absTime -> T absTime body -> T relTime body
fromAbsoluteEventListGen (-) time
0

{- |
Convert from relative time stamps to absolute time stamps
using a custom accumulator function (like @(+)@).
-}
toAbsoluteEventListGen ::
   (absTime -> relTime -> absTime) ->
   absTime -> T relTime body -> AbsoluteEventList.T absTime body
toAbsoluteEventListGen :: forall absTime relTime body.
(absTime -> relTime -> absTime)
-> absTime -> T relTime body -> T absTime body
toAbsoluteEventListGen absTime -> relTime -> absTime
accum absTime
start =
   T absTime body -> T absTime body
forall time body. T time body -> T time body
AbsoluteEventPriv.Cons (T absTime body -> T absTime body)
-> (T relTime body -> T absTime body)
-> T relTime body
-> T absTime body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T absTime body -> T absTime body
forall time body. T time body -> T time body
decons (T absTime body -> T absTime body)
-> (T relTime body -> T absTime body)
-> T relTime body
-> T absTime body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (State absTime (T absTime body) -> absTime -> T absTime body)
-> absTime -> State absTime (T absTime body) -> T absTime body
forall a b c. (a -> b -> c) -> b -> a -> c
flip State absTime (T absTime body) -> absTime -> T absTime body
forall s a. State s a -> s -> a
evalState absTime
start (State absTime (T absTime body) -> T absTime body)
-> (T relTime body -> State absTime (T absTime body))
-> T relTime body
-> T absTime body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (relTime -> StateT absTime Identity absTime)
-> T relTime body -> State absTime (T absTime body)
forall (m :: * -> *) time0 time1 body.
Monad m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
mapTimeM (\relTime
dur -> (absTime -> absTime) -> StateT absTime Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((absTime -> relTime -> absTime) -> relTime -> absTime -> absTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip absTime -> relTime -> absTime
accum relTime
dur) StateT absTime Identity ()
-> StateT absTime Identity absTime
-> StateT absTime Identity absTime
forall a b.
StateT absTime Identity a
-> StateT absTime Identity b -> StateT absTime Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT absTime Identity absTime
forall (m :: * -> *) s. Monad m => StateT s m s
get)

{- |
Convert from absolute time stamps to relative time stamps
using custom subtraction (like @(-)@) and zero.
-}
fromAbsoluteEventListGen ::
   (absTime -> absTime -> relTime) ->
   absTime ->
   AbsoluteEventList.T absTime body -> T relTime body
fromAbsoluteEventListGen :: forall absTime relTime body.
(absTime -> absTime -> relTime)
-> absTime -> T absTime body -> T relTime body
fromAbsoluteEventListGen absTime -> absTime -> relTime
diff absTime
start =
   (State absTime (T relTime body) -> absTime -> T relTime body)
-> absTime -> State absTime (T relTime body) -> T relTime body
forall a b c. (a -> b -> c) -> b -> a -> c
flip State absTime (T relTime body) -> absTime -> T relTime body
forall s a. State s a -> s -> a
evalState absTime
start (State absTime (T relTime body) -> T relTime body)
-> (T absTime body -> State absTime (T relTime body))
-> T absTime body
-> T relTime body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (absTime -> StateT absTime Identity relTime)
-> T absTime body -> State absTime (T relTime body)
forall (m :: * -> *) time0 time1 body.
Monad m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
mapTimeM
      (\absTime
time -> do absTime
lastTime <- StateT absTime Identity absTime
forall (m :: * -> *) s. Monad m => StateT s m s
get; absTime -> StateT absTime Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put absTime
time; relTime -> StateT absTime Identity relTime
forall a. a -> StateT absTime Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (absTime -> absTime -> relTime
diff absTime
time absTime
lastTime)) (T absTime body -> State absTime (T relTime body))
-> (T absTime body -> T absTime body)
-> T absTime body
-> State absTime (T relTime body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T absTime body -> T absTime body
forall time body. T time body -> T time body
Cons (T absTime body -> T absTime body)
-> (T absTime body -> T absTime body)
-> T absTime body
-> T absTime body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T absTime body -> T absTime body
forall time body. T time body -> T time body
AbsoluteEventPriv.decons