{- |
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 time difference.
-}
module Data.EventList.Relative.TimeTime
   (T,
    mapBody, mapTime,
    zipWithBody, zipWithTime, unzip,
    concatMapMonoid,
    traverse, traverse_, traverseBody, traverseTime,
    mapM, mapM_, mapBodyM, mapTimeM,
    getTimes, getBodies, duration,
    merge, mergeBy, insert, {- insertBy, -} pad,
    moveForward, moveForwardRestricted, moveBackward, arrange, arrangeBy,
    moveForwardRestrictedBy,
    moveForwardRestrictedByQueue, moveForwardRestrictedByStrict,
    decreaseStart, delay,
    filter, partition, partitionMaybe, partitionMaybeR, slice,
    foldr, foldl,
    pause, isPause, cons, snoc, viewL, viewR, switchL, switchR,
    mapMaybe, catMaybes, catMaybesR,
    append, concat, concatNaive, cycle, cycleNaive, reverse,
    splitAtTime, takeTime, dropTime,
    forceTimeHead,
    discretize, resample,
    collectCoincident, flatten, mapCoincident,
    normalize, isNormalized,
    toAbsoluteEventList, fromAbsoluteEventList,
   ) where

import Data.EventList.Relative.TimeTimePrivate as TimeTimePriv

import qualified Data.EventList.Relative.BodyTimePrivate as BodyTimePriv
import qualified Data.EventList.Relative.TimeBody as TimeBodyList

import qualified Data.EventList.Absolute.TimeTimePrivate as AbsoluteEventPriv
import qualified Data.EventList.Absolute.TimeTime 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 Data.Monoid (Monoid, mempty, mconcat, )

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 Data.EventList.Utility (floorDiff, )
import Control.Monad.Trans.State (evalState, modify, get, gets, put, )

import Control.Monad (Monad, return, liftM2, (>>), )
import Control.Applicative (Applicative, WrappedMonad(WrapMonad, unwrapMonad), )

import Data.Function ((.), ($), id, flip, )
import Data.Functor (fmap, )
import Data.Maybe (Maybe(Just, Nothing), maybe, )
import Data.Tuple (fst, snd, )
import Data.Ord (Ord, (<), )
import Data.Eq (Eq, (==), )
import Data.Bool (Bool(False, True), not, (&&), )
import Prelude (Num, Integral, RealFrac, (*), (+), (-), seq, )



pause :: time -> T time body
pause :: forall time body. time -> T time body
pause = T body time -> T time body
forall time body. T body time -> T time body
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
. time -> T body time
forall b a. b -> T a b
Uniform.singleton

isPause :: T time body -> Bool
isPause :: forall time body. T time body -> Bool
isPause = T body time -> Bool
forall a b. T a b -> Bool
Uniform.isSingleton (T body time -> Bool)
-> (T time body -> T body time) -> T time body -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T body time
forall time body. T time body -> T body time
decons



getBodies :: T time body -> [body]
getBodies :: forall time body. T time body -> [body]
getBodies = T body time -> [body]
forall a b. T a b -> [a]
Uniform.getFirsts (T body time -> [body])
-> (T time body -> T body time) -> T time body -> [body]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T body time
forall time body. T time body -> T body time
decons

getTimes :: T time body -> [time]
getTimes :: forall time body. T time body -> [time]
getTimes = T body time -> [time]
forall a b. T a b -> [b]
Uniform.getSeconds (T body time -> [time])
-> (T time body -> T body time) -> T time body -> [time]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T body time
forall time body. T time body -> T body time
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



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

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


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

{-# INLINE switchL #-}
switchL :: (time -> a) -> ((time, body) -> T time body -> a) -> T time body -> a
switchL :: forall time a body.
(time -> a)
-> ((time, body) -> T time body -> a) -> T time body -> a
switchL time -> a
f (time, body) -> T time body -> a
g =
   (time -> a)
-> (time -> body -> T body time -> a) -> T body time -> a
forall b c a. (b -> c) -> (b -> a -> T a b -> c) -> T a b -> c
Mixed.switchL time -> a
f (\time
t body
b -> (time, body) -> T time body -> a
g (time
t,body
b) (T time body -> a)
-> (T body time -> T time body) -> T body time -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body time -> T time body
forall time body. T body time -> T time body
Cons) (T body time -> a)
-> (T time body -> T body time) -> T time body -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time body -> T body time
forall time body. T time body -> T body time
decons

viewR :: T time body -> (Maybe (T time body, body), time)
viewR :: forall time body. T time body -> (Maybe (T time body, body), time)
viewR =
   (Maybe (T body time, body) -> Maybe (T time body, body))
-> (Maybe (T body time, body), time)
-> (Maybe (T time body, body), time)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (((T body time, body) -> (T time body, body))
-> Maybe (T body time, body) -> Maybe (T time body, body)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T body time -> T time body)
-> (T body time, body) -> (T time body, body)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst T body time -> T time body
forall time body. T body time -> T time body
Cons)) ((Maybe (T body time, body), time)
 -> (Maybe (T time body, body), time))
-> (T time body -> (Maybe (T body time, body), time))
-> T time body
-> (Maybe (T time body, body), time)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body time -> (Maybe (T body time, body), time)
forall a b. T a b -> (Maybe (T a b, a), b)
Mixed.viewR (T body time -> (Maybe (T body time, body), time))
-> (T time body -> T body time)
-> T time body
-> (Maybe (T body time, body), time)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T body time
forall time body. T time body -> T body time
decons

{-# INLINE switchR #-}
switchR :: (time -> a) -> (T time body -> body -> time -> a) -> T time body -> a
switchR :: forall time a body.
(time -> a)
-> (T time body -> body -> time -> a) -> T time body -> a
switchR time -> a
f T time body -> body -> time -> a
g =
   (time -> a)
-> (T body time -> body -> time -> a) -> T body time -> a
forall b c a. (b -> c) -> (T a b -> a -> b -> c) -> T a b -> c
Mixed.switchR time -> a
f (T time body -> body -> time -> a
g (T time body -> body -> time -> a)
-> (T body time -> T time body) -> T body time -> body -> time -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body time -> T time body
forall time body. T body time -> T time body
Cons) (T body time -> a)
-> (T time body -> T body time) -> T time body -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time body -> T body time
forall time body. T time body -> T body time
decons


mapBody :: (body0 -> body1) -> T time body0 -> T time body1
mapBody :: forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
mapBody = (T body0 time -> T body1 time) -> T time body0 -> T time body1
forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift ((T body0 time -> T body1 time) -> T time body0 -> T time body1)
-> ((body0 -> body1) -> T body0 time -> T body1 time)
-> (body0 -> body1)
-> T time body0
-> T time body1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (body0 -> body1) -> T body0 time -> T body1 time
forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
Uniform.mapFirst

mapTime :: (time0 -> time1) -> T time0 body -> T time1 body
mapTime :: forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime = (T body time0 -> T body time1) -> T time0 body -> T time1 body
forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift ((T body time0 -> T body time1) -> T time0 body -> T time1 body)
-> ((time0 -> time1) -> T body time0 -> T body time1)
-> (time0 -> time1)
-> T time0 body
-> T time1 body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time0 -> time1) -> T body time0 -> T body time1
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
Uniform.mapSecond


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 body1 time -> T body2 time) -> T time body1 -> T time body2
forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift ((T body1 time -> T body2 time) -> T time body1 -> T time body2)
-> ([body0] -> T body1 time -> T body2 time)
-> [body0]
-> T time body1
-> T time body2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (body0 -> body1 -> body2)
-> [body0] -> T body1 time -> T body2 time
forall a0 a1 a2 b. (a0 -> a1 -> a2) -> [a0] -> T a1 b -> T a2 b
Uniform.zipWithFirst body0 -> body1 -> body2
f

zipWithTime ::
   (time0 -> time1 -> time2) ->
   (time0, [time0]) -> T time1 body -> T time2 body
zipWithTime :: forall time0 time1 time2 body.
(time0 -> time1 -> time2)
-> (time0, [time0]) -> T time1 body -> T time2 body
zipWithTime time0 -> time1 -> time2
f = (T body time1 -> T body time2) -> T time1 body -> T time2 body
forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift ((T body time1 -> T body time2) -> T time1 body -> T time2 body)
-> ((time0, [time0]) -> T body time1 -> T body time2)
-> (time0, [time0])
-> T time1 body
-> T time2 body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time0 -> time1 -> time2)
-> (time0, [time0]) -> T body time1 -> T body time2
forall b0 b1 b2 a.
(b0 -> b1 -> b2) -> (b0, [b0]) -> T a b1 -> T a b2
Uniform.zipWithSecond 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
 -> (T time body0, T time body1) -> (T time body0, T time body1))
-> ((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 a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      (\time
time ->
         (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 -> T time body0 -> T time body0
forall time body. time -> T time body -> T time body
consTime time
time, time -> T time body1 -> T time body1
forall time body. time -> T time body -> T time body
consTime 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 (body0 -> T time body0 -> T time body0
forall body time. body -> T time body -> T time body
consBody body0
body0, body1 -> T time body1 -> T time body1
forall body time. body -> T time body -> T time body
consBody body1
body1))
      (T time body0
forall a. Monoid a => a
mempty, T time body1
forall a. Monoid a => a
mempty)


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 = (body -> m) -> (time -> m) -> T body time -> m
forall m time body.
Monoid m =>
(time -> m) -> (body -> m) -> T time body -> m
Uniform.concatMapMonoid body -> m
g time -> m
f (T body time -> m)
-> (T time body -> T body time) -> T time body -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T body time
forall time body. T time body -> T body time
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 body0 time0 -> m (T body1 time1))
-> T time0 body0 -> m (T time1 body1)
forall (m :: * -> *) body0 time0 body1 time1.
Applicative m =>
(T body0 time0 -> m (T body1 time1))
-> T time0 body0 -> m (T time1 body1)
liftA ((body0 -> m body1)
-> (time0 -> m time1) -> T body0 time0 -> m (T body1 time1)
forall (m :: * -> *) a0 a1 b0 b1.
Applicative m =>
(a0 -> m a1) -> (b0 -> m b1) -> T a0 b0 -> m (T a1 b1)
Uniform.traverse body0 -> m body1
g time0 -> m time1
f)

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 = (body -> m ()) -> (time -> m ()) -> T body time -> m ()
forall (m :: * -> *) d a b.
(Applicative m, Monoid d) =>
(a -> m d) -> (b -> m d) -> T a b -> m d
Uniform.traverse_ body -> m ()
g time -> m ()
f (T body time -> m ())
-> (T time body -> T body time) -> T time body -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T body time
forall time body. T time body -> T body time
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 body0 time -> m (T body1 time))
-> T time body0 -> m (T time body1)
forall (m :: * -> *) body0 time0 body1 time1.
Applicative m =>
(T body0 time0 -> m (T body1 time1))
-> T time0 body0 -> m (T time1 body1)
liftA ((body0 -> m body1) -> T body0 time -> m (T body1 time)
forall (m :: * -> *) a0 a1 b.
Applicative m =>
(a0 -> m a1) -> T a0 b -> m (T a1 b)
Uniform.traverseFirst 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 body time0 -> m (T body time1))
-> T time0 body -> m (T time1 body)
forall (m :: * -> *) body0 time0 body1 time1.
Applicative m =>
(T body0 time0 -> m (T body1 time1))
-> T time0 body0 -> m (T time1 body1)
liftA ((time0 -> m time1) -> T body time0 -> m (T body time1)
forall (m :: * -> *) b0 b1 a.
Applicative m =>
(b0 -> m b1) -> T a b0 -> m (T a b1)
Uniform.traverseSecond 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)



{- |
Sort coincident elements.
-}
normalize :: (Ord body, NonNeg.C time) =>
   T time body -> T time body
normalize :: forall body time. (Ord body, C time) => 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


{- |
The first important function is 'merge'
which merges the events of two lists into a new time order list.
-}

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
(<)

{-
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 =
          let (time
xt,T time body
xs) = T time body -> (time, T time body)
forall time body. T time body -> (time, T time body)
viewTimeL T time body
xs0
              (time
yt,T time body
ys) = T time body -> (time, T time body)
forall time body. T time body -> (time, T time body)
viewTimeL T time body
ys0
              (time
mt,~(Bool
bef,time
dt)) = time -> time -> (time, (Bool, time))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split time
xt time
yt
          in  time -> T time body -> T time body
forall time body. C time => time -> T time body -> T time body
delay time
mt (T time body -> T time body) -> T time body -> T time body
forall a b. (a -> b) -> a -> b
$
              if time
dt time -> time -> Bool
forall a. Eq a => a -> a -> Bool
== time
forall a. C a => a
zero
                then
                   case (T time body -> Maybe (body, T time body)
forall time body. T time body -> Maybe (body, T time body)
viewBodyL T time body
xs, T time body -> Maybe (body, T time body)
forall time body. T time body -> Maybe (body, T time body)
viewBodyL T time body
ys) of
                      (Maybe (body, T time body)
Nothing, Maybe (body, T time body)
_) -> time -> T time body -> T time body
forall time body. time -> T time body -> T time body
consTime time
forall a. C a => a
zero T time body
ys
                      (Maybe (body, T time body)
_, Maybe (body, T time body)
Nothing) -> time -> T time body -> T time body
forall time body. time -> T time body -> T time body
consTime time
forall a. C a => a
zero T time body
xs
                      (Just (body
b0,T time body
xs1), Just (body
b1,T time body
ys1)) ->
                         {-
                         do not insert both b0 and b1 immediately,
                         because the later one of b0 and b1 may be pushed even further,
                         thus recourse with 'mergeBy' on xs or ys
                         -}
                         if body -> body -> Bool
before body
b0 body
b1
                           then time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons time
forall a. C a => a
zero body
b0 (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
recourse T time body
xs1 (time -> T time body -> T time body
forall time body. time -> T time body -> T time body
consTime time
forall a. C a => a
zero T time body
ys)
                           else time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons time
forall a. C a => a
zero body
b1 (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
recourse (time -> T time body -> T time body
forall time body. time -> T time body -> T time body
consTime time
forall a. C a => a
zero T time body
xs) T time body
ys1
                else
                  if Bool
bef
                    then
                       let ys1 :: T time body
ys1 = time -> T time body -> T time body
forall time body. time -> T time body -> T time body
consTime time
dt T time body
ys
                       in  ((body -> T time body -> T time body)
 -> T time body -> T time body)
-> T time body
-> (body -> T time body -> T time body)
-> T time body
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T time body
-> (body -> T time body -> T time body)
-> T time body
-> T time body
forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
switchBodyL T time body
ys1) T time body
xs ((body -> T time body -> T time body) -> T time body)
-> (body -> T time body -> T time body) -> T time body
forall a b. (a -> b) -> a -> b
$ \ body
b T time body
xs1 ->
                              time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons time
forall a. C a => a
zero body
b (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
recourse T time body
xs1 T time body
ys1
                    else
                       let xs1 :: T time body
xs1 = time -> T time body -> T time body
forall time body. time -> T time body -> T time body
consTime time
dt T time body
xs
                       in  ((body -> T time body -> T time body)
 -> T time body -> T time body)
-> T time body
-> (body -> T time body -> T time body)
-> T time body
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T time body
-> (body -> T time body -> T time body)
-> T time body
-> T time body
forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
switchBodyL T time body
xs1) T time body
ys ((body -> T time body -> T time body) -> T time body)
-> (body -> T time body -> T time body) -> T time body
forall a b. (a -> b) -> a -> b
$ \ body
b T time body
ys1 ->
                              time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons time
forall a. C a => a
zero body
b (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
recourse T time body
xs1 T time body
ys1
   in  T time body -> T time body -> T time body
forall {time}. C time => T time body -> T time body -> T time body
recourse


{- |
Note that 'merge' compares entire events rather than just start
times.  This is to ensure that it is commutative, a desirable
condition for some of the proofs used in Haskore/section equivalence.
It is also necessary to assert a unique representation
of the event list independent of the structure of the event type.
The same function for inserting into a time ordered list with a trailing pause.
-}
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
(<)

{-
Ordering of bodies at the same time
could be simplified using collectCoincident.
-}
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 time
t0 body
me0 =
   let recurseTime :: t -> T t body -> T t body
recurseTime t
t =
          (t -> T t body -> T t body) -> T t body -> T t body
forall time body a. (time -> T time body -> a) -> T time body -> a
switchTimeL ((t -> T t body -> T t body) -> T t body -> T t body)
-> (t -> T t body -> T t body) -> T t body -> T t body
forall a b. (a -> b) -> a -> b
$ \ t
t1 T t body
xs0 ->
             let (t
mt,~(Bool
b,t
dt)) = t -> t -> (t, (Bool, t))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split t
t1 t
t
             in  t -> T t body -> T t body
forall time body. C time => time -> T time body -> T time body
delay t
mt (T t body -> T t body) -> T t body -> T t body
forall a b. (a -> b) -> a -> b
$
                 if Bool -> Bool
not Bool
b
                   then t -> body -> T t body -> T t body
forall time body. time -> body -> T time body -> T time body
cons t
forall a. C a => a
zero body
me0 (T t body -> T t body) -> T t body -> T t body
forall a b. (a -> b) -> a -> b
$ t -> T t body -> T t body
forall time body. time -> T time body -> T time body
consTime t
dt T t body
xs0
                   else
                     T t body -> (body -> T t body -> T t body) -> T t body -> T t body
forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
switchBodyL
                        (t -> body -> T t body -> T t body
forall time body. time -> body -> T time body -> T time body
cons t
dt body
me0 (T t body -> T t body) -> T t body -> T t body
forall a b. (a -> b) -> a -> b
$ t -> T t body
forall time body. time -> T time body
pause t
forall a. C a => a
zero)
                        (\ body
me1 T t body
xs -> t -> T t body -> T t body
forall time body. time -> T time body -> T time body
consTime t
forall a. C a => a
zero (T t body -> T t body) -> T t body -> T t body
forall a b. (a -> b) -> a -> b
$
                           if 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 -> T t body -> T t body
forall body time. body -> T time body -> T time body
consBody body
me0 (t -> body -> T t body -> T t body
forall time body. time -> body -> T time body -> T time body
cons t
forall a. C a => a
zero body
me1 T t body
xs)
                             else body -> T t body -> T t body
forall body time. body -> T time body -> T time body
consBody body
me1 (t -> T t body -> T t body
recurseTime t
dt T t body
xs))
                        T t body
xs0
   in   time -> T time body -> T time body
forall {t}. C t => t -> T t body -> T t body
recurseTime time
t0


{-
Ensure that the list has a minimum length
by extending the last pause accordingly.
-}
pad :: (NonNeg.C time) =>
   time -> T time body -> T time body
pad :: forall time body. C time => time -> T time body -> T time body
pad time
time = (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
False) (time -> T time body
forall time body. time -> T time body
pause time
time)


{- |
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

moveBackward :: (NonNeg.C time) =>
   T time (time, body) -> T time body
moveBackward :: forall time body. C time => T time (time, body) -> T time body
moveBackward =
   T time (Maybe body) -> T time body
forall time body. C time => T time (Maybe body) -> T time body
catMaybes (T time (Maybe body) -> T time body)
-> (T time (time, body) -> T time (Maybe body))
-> T time (time, body)
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (time -> T time (Maybe body) -> T time (Maybe body))
-> ((time, body) -> T time (Maybe body) -> T time (Maybe body))
-> T time (Maybe body)
-> T time (time, body)
-> T time (Maybe body)
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      (\time
t -> time -> Maybe body -> T time (Maybe body) -> T time (Maybe body)
forall time body. time -> body -> T time body -> T time body
cons time
t Maybe body
forall a. Maybe a
Nothing)
      (\(time
t,body
b) -> (Maybe body -> Maybe body -> Bool)
-> time -> Maybe body -> T time (Maybe body) -> T time (Maybe body)
forall time body.
C time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy ((body -> body -> Bool) -> Maybe body -> Maybe body -> Bool
forall body.
(body -> body -> Bool) -> Maybe body -> Maybe body -> Bool
ltMaybe (\body
_ body
_ -> Bool
True)) time
t (body -> Maybe body
forall a. a -> Maybe a
Just body
b))
      (time -> T time (Maybe body)
forall time body. time -> T time body
pause time
forall a. C a => a
zero)

{- |
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.
-}
{-
Implementation notes:
We keep a (non-optimized) priority queue as the state of a state monad.
In a pause we emit all events that occur in this duration.
-}
moveForwardRestricted :: (Ord body, NonNeg.C time) =>
   time -> T time (time, body) -> T time body
moveForwardRestricted :: forall body time.
(Ord body, C time) =>
time -> T time (time, body) -> T time body
moveForwardRestricted time
maxTime =
   time -> T time body -> T time body
forall time body. C time => time -> T time body -> T time body
decreaseStart time
maxTime (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. C time => T time (time, body) -> T time body
moveBackward (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, body) -> (time, body))
-> T time (time, body) -> T time (time, body)
forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
mapBody ((time -> time) -> (time, body) -> (time, body)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (time
maxTimetime -> time -> time
forall a. C a => a -> a -> a
-|)) (T time (time, body) -> T time (time, body))
-> (T time (time, body) -> T time (time, body))
-> T time (time, body)
-> T time (time, body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   time -> T time (time, body) -> T time (time, body)
forall time body. C time => time -> T time body -> T time body
pad time
maxTime
{-
   moveForwardRestrictedBy
      (\_ _ -> True)
      -- (<)
-}

ltMaybe :: (body -> body -> Bool) -> (Maybe body -> Maybe body -> Bool)
ltMaybe :: forall body.
(body -> body -> Bool) -> Maybe body -> Maybe body -> Bool
ltMaybe body -> body -> Bool
cmp Maybe body
mx Maybe body
my =
   case (Maybe body
mx,Maybe body
my) of
      (Maybe body
Nothing, Maybe body
_) -> Bool
True
      (Maybe body
_, Maybe body
Nothing) -> Bool
False
      (Just body
x, Just body
y) -> body -> body -> Bool
cmp body
x body
y


-- | currently only for testing
moveForwardRestrictedBy :: (NonNeg.C time) =>
   (body -> body -> Bool) ->
   time -> T time (time, body) -> T time body
moveForwardRestrictedBy :: forall time body.
C time =>
(body -> body -> Bool)
-> time -> T time (time, body) -> T time body
moveForwardRestrictedBy body -> body -> Bool
cmp time
maxTime =
   time -> T time body -> T time body
forall time body. C time => time -> T time body -> T time body
decreaseStart time
maxTime (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 (Maybe body) -> T time body
forall time body. C time => T time (Maybe body) -> T time body
catMaybes (T time (Maybe body) -> T time body)
-> (T time (time, body) -> T time (Maybe body))
-> T time (time, body)
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (time -> T time (Maybe body) -> T time (Maybe body))
-> ((time, body) -> T time (Maybe body) -> T time (Maybe body))
-> T time (Maybe body)
-> T time (time, body)
-> T time (Maybe body)
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      (\time
t -> time -> Maybe body -> T time (Maybe body) -> T time (Maybe body)
forall time body. time -> body -> T time body -> T time body
cons time
t Maybe body
forall a. Maybe a
Nothing)
      (\(time
t,body
b) -> (Maybe body -> Maybe body -> Bool)
-> time -> Maybe body -> T time (Maybe body) -> T time (Maybe body)
forall time body.
C time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy ((body -> body -> Bool) -> Maybe body -> Maybe body -> Bool
forall body.
(body -> body -> Bool) -> Maybe body -> Maybe body -> Bool
ltMaybe body -> body -> Bool
cmp) (time
maxTimetime -> time -> time
forall a. C a => a -> a -> a
-|time
t) (body -> Maybe body
forall a. a -> Maybe a
Just body
b))
      (time -> T time (Maybe body)
forall time body. time -> T time body
pause time
maxTime)

-- | currently only for testing
moveForwardRestrictedByStrict :: (NonNeg.C time) =>
   (body -> body -> Bool) ->
   time -> T time (time, body) -> T time body
moveForwardRestrictedByStrict :: forall time body.
C time =>
(body -> body -> Bool)
-> time -> T time (time, body) -> T time body
moveForwardRestrictedByStrict body -> body -> Bool
cmp time
maxTime =
   time -> T time body -> T time body
forall time body. C time => time -> T time body -> T time body
decreaseStart time
maxTime (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
.
   (time -> T time body -> T time body)
-> ((time, body) -> T time body -> T time body)
-> T time body
-> T time (time, body)
-> T time body
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      time -> T time body -> T time body
forall time body. C time => time -> T time body -> T time body
delay
      (\(time
t,body
b) -> (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
cmp (time
maxTimetime -> time -> time
forall a. C a => a -> a -> a
-|time
t) body
b)
      (time -> T time body
forall time body. time -> T time body
pause time
maxTime)

-- | currently only for testing
moveForwardRestrictedByQueue :: (NonNeg.C time, Num time) =>
   (body -> body -> Bool) ->
   time -> T time (time, body) -> T time body
moveForwardRestrictedByQueue :: forall time body.
(C time, Num time) =>
(body -> body -> Bool)
-> time -> T time (time, body) -> T time body
moveForwardRestrictedByQueue body -> body -> Bool
cmp time
maxTime T time (time, body)
xs =
   let (T time (time, body)
prefix,T time (time, body)
suffix) = time
-> T time (time, body)
-> (T time (time, body), T time (time, body))
forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAtTime time
maxTime T time (time, body)
xs
       prefixDur :: time
prefixDur = T time (time, body) -> time
forall time body. C time => T time body -> time
duration T time (time, body)
prefix {- maxTime would work in most cases, too -}
       getChunk :: time -> StateT (T time body) m (T time body)
getChunk time
t =
          do (T time body
toEmit,T time body
toKeep) <- (T time body -> (T time body, T time body))
-> StateT (T time body) m (T time body, T time body)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (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)
             T time body -> StateT (T time body) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put T time body
toKeep
             T time body -> StateT (T time body) m (T time body)
forall a. a -> StateT (T time body) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (time -> T time body -> T time body
forall time body. C time => time -> T time body -> T time body
pad time
t T time body
toEmit)
       insertEvent :: (time, body) -> T time body -> T time body
insertEvent (time
t,body
b) =
          (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
cmp (time
maxTime time -> time -> time
forall a. Num a => a -> a -> a
- time
t) body
b
   in  State (T time body) (T time body) -> T time body -> T time body
forall s a. State s a -> s -> a
evalState
          ((time
 -> State (T time body) (T time body)
 -> State (T time body) (T time body))
-> ((time, body)
    -> State (T time body) (T time body)
    -> State (T time body) (T time body))
-> State (T time body) (T time body)
-> T time (time, body)
-> State (T time body) (T time body)
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
             (\time
t State (T time body) (T time body)
m -> (T time body -> T time body -> T time body)
-> State (T time body) (T time body)
-> State (T time body) (T time body)
-> State (T time body) (T time body)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 T time body -> T time body -> T time body
forall time body.
C time =>
T time body -> T time body -> T time body
append (time -> State (T time body) (T time body)
forall {m :: * -> *} {time} {body}.
(Monad m, C time) =>
time -> StateT (T time body) m (T time body)
getChunk time
t) State (T time body) (T time body)
m)
             (\(time, body)
b State (T time body) (T time body)
m -> (T time body -> T time body) -> StateT (T time body) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((time, body) -> T time body -> T time body
insertEvent (time, body)
b) StateT (T time body) Identity ()
-> State (T time body) (T time body)
-> State (T time body) (T time body)
forall a b.
StateT (T time body) Identity a
-> StateT (T time body) Identity b
-> StateT (T time body) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State (T time body) (T time body)
m)
             ((T time body -> T time body) -> State (T time body) (T time body)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (time -> T time body -> T time body
forall time body. C time => time -> T time body -> T time body
pad time
prefixDur)) T time (time, body)
suffix)
          (T time (time, body) -> T time body
forall time body.
(Ord time, Num time) =>
T time (time, body) -> T time body
moveForward (time -> T time (time, body) -> T time (time, body)
forall a b. a -> b -> b
seq time
prefixDur T time (time, body)
prefix))
             {- this way 'prefixDur' will be computed early
                and 'prefix' need not to be stored until the end of the list -}


{- |
Merge several event lists respecting the start time of the outer event list.
-}
arrange :: (Ord body, NonNeg.C time) =>
   T time (T time body) -> T time body
arrange :: forall body time.
(Ord body, C time) =>
T time (T time body) -> T time body
arrange = (body -> body -> Bool) -> T time (T time body) -> T time body
forall time body.
C time =>
(body -> body -> Bool) -> T time (T time body) -> T time body
arrangeBy (\body
_ body
_ -> Bool
True)

arrangeBy :: (NonNeg.C time) =>
   (body -> body -> Bool) ->
   T time (T time body) -> T time body
arrangeBy :: forall time body.
C time =>
(body -> body -> Bool) -> T time (T time body) -> T time body
arrangeBy body -> body -> Bool
cmp =
   T time (Maybe body) -> T time body
forall time body. C time => T time (Maybe body) -> T time body
catMaybes (T time (Maybe body) -> T time body)
-> (T time (T time body) -> T time (Maybe body))
-> T time (T time body)
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (time -> T time (Maybe body) -> T time (Maybe body))
-> (T time body -> T time (Maybe body) -> T time (Maybe body))
-> T time (Maybe body)
-> T time (T time body)
-> T time (Maybe body)
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      (\time
t -> time -> Maybe body -> T time (Maybe body) -> T time (Maybe body)
forall time body. time -> body -> T time body -> T time body
cons time
t Maybe body
forall a. Maybe a
Nothing)
      (\T time body
xs -> (Maybe body -> Maybe body -> Bool)
-> T time (Maybe body)
-> T time (Maybe body)
-> T time (Maybe body)
forall time body.
C time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
mergeBy ((body -> body -> Bool) -> Maybe body -> Maybe body -> Bool
forall body.
(body -> body -> Bool) -> Maybe body -> Maybe body -> Bool
ltMaybe body -> body -> Bool
cmp) ((body -> Maybe body) -> T time body -> T time (Maybe body)
forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
mapBody body -> Maybe body
forall a. a -> Maybe a
Just T time body
xs))
      (time -> T time (Maybe body)
forall time body. time -> T time body
pause time
forall a. C a => a
zero)


concat :: (NonNeg.C time) =>
   [T time body] -> T time body
concat :: forall time body. C time => [T time body] -> T time body
concat = [T time body] -> T time body
forall a. Monoid a => [a] -> a
mconcat

{- |
'concat' and 'concatNaive' are essentially the same.
'concat' must use 'foldr' in order to work on infinite lists,
however if there are many empty lists,
summing of their durations will be done from right to left,
which is inefficient.
Thus we detect subsequent empty lists and merge them from left to right.
-}
concatNaive :: (NonNeg.C time) =>
   [T time body] -> T time body
concatNaive :: forall time body. C time => [T time body] -> T time body
concatNaive = (T time body -> T time body -> T time body)
-> T time body -> [T time body] -> T time body
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr T time body -> T time body -> T time body
forall time body.
C time =>
T time body -> T time body -> T time body
append (time -> T time body
forall time body. time -> T time body
pause time
forall a. C a => a
zero)


{- |
Uses sharing.
-}
cycle :: (NonNeg.C time) =>
   T time body -> T time body
cycle :: forall time body. C time => T time body -> T time body
cycle =
   (time -> T time body -> T time body) -> T time body -> T time body
forall time body a. (time -> T time body -> a) -> T time body -> a
switchTimeL
   (\time
t0 T time body
xs ->
       time -> T time body -> T time body
forall time body. time -> T time body -> T time body
consTime time
t0 (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
forall time body. T time body -> T time body
BodyTimePriv.cycle (T time body -> T time body) -> T time body -> T time body
forall a b. (a -> b) -> a -> b
$
       (time -> time) -> T time body -> T time body
forall time body. (time -> time) -> T time body -> T time body
BodyTimePriv.mapTimeLast (time -> time -> time
forall a. C a => a -> a -> a
add time
t0) T time body
xs)


cycleNaive :: (NonNeg.C time) =>
   T time body -> T time body
cycleNaive :: forall time body. C time => T time body -> T time body
cycleNaive = [T time body] -> T time body
forall time body. C time => [T time body] -> T time body
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]
forall a. a -> [a]
List.repeat



{- |
If there is an event at the cutting time,
this event is returned in the suffix part.
That is
@splitAtTime t0 (t0 ./ x /. t1 ./ empty) ==
    (pause t0, 0 ./ x /. t1 ./ empty)@
-}
{-
It could also be implemented by inserting a marker element
and then splitting at this element.
I hope that the current manual recursion routine is the most efficient solution.
-}
splitAtTime :: (NonNeg.C time) =>
   time -> T time body -> (T time body, T time body)
splitAtTime :: forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAtTime time
t0 =
   (time -> T time body -> (T time body, T time body))
-> T time body -> (T time body, T time body)
forall time body a. (time -> T time body -> a) -> T time body -> a
switchTimeL
   (\time
t1 T time body
xs ->
      let (time
mt,~(Bool
bef,time
dt)) = time -> time -> (time, (Bool, time))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split time
t0 time
t1
      in  {-
          The handling of the second pair member looks a bit cumbersome,
          but it is necessary to prepend the time once
          in order to prevent a memory leak.
          -}
          (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 (time -> T time body -> T time body
forall time body. time -> T time body -> T time body
consTime time
mt, T time body -> T time body
forall time body. C time => T time body -> T time body
forceTimeHead) ((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
$
          if Bool
bef
            then (T time body
forall a. Monoid a => a
mempty, time -> T time body -> T time body
forall time body. time -> T time body -> T time body
consTime time
dt T time body
xs)
            else (T time body, T time body)
-> (body -> T time body -> (T time body, T time body))
-> T time body
-> (T time body, T time body)
forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
switchBodyL
                    (T time body
forall a. Monoid a => a
mempty, time -> T time body
forall time body. time -> T time body
pause time
forall a. C a => a
zero)
                    (\ body
b -> (T time body -> T time body)
-> (T time body, T time body) -> (T time body, T time body)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (body -> T time body -> T time body
forall body time. body -> T time body -> T time body
consBody body
b) ((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
. 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
dt)
                    T time body
xs)

takeTime :: (NonNeg.C time) =>
   time -> T time body -> 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 -> T time body -> T time body
-- dropTime t = snd . splitAtTime t
dropTime :: forall time body. C time => time -> T time body -> T time body
dropTime time
t0 =
   (time -> T time body -> T time body) -> T time body -> T time body
forall time body a. (time -> T time body -> a) -> T time body -> a
switchTimeL
   (\time
t1 T time body
xs ->
      let (Bool
bef,time
dt) = (time, (Bool, time)) -> (Bool, time)
forall a b. (a, b) -> b
snd ((time, (Bool, time)) -> (Bool, time))
-> (time, (Bool, 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
t0 time
t1
      in  T time body -> T time body
forall time body. C time => T time body -> T time body
forceTimeHead (T time body -> T time body) -> T time body -> T time body
forall a b. (a -> b) -> a -> b
$
          if Bool
bef
            then time -> T time body -> T time body
forall time body. time -> T time body -> T time body
consTime time
dt T time body
xs
            else T time body
-> (body -> T time body -> T time body)
-> T time body
-> T time body
forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
switchBodyL
                    (time -> T time body
forall time body. time -> T time body
pause time
forall a. C a => a
zero)
                    (\ body
_b -> time -> T time body -> T time body
forall time body. C time => time -> T time body -> T time body
dropTime time
dt)
                    T time body
xs)

{-
Surprisingly this has a space leak,
see test dropTimeLazyInfinite.

dropTime :: (NonNeg.C time) =>
   time -> T time body -> T time body
dropTime t0 =
   switchTimeL
   (\t1 xs ->
      let (bef,dt) = snd $ NonNeg.split t0 t1
      in  if bef
            then consTime dt xs
            else switchBodyL
                    (pause zero)
                    (\ _b -> dropTime dt)
                    xs)
-}


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)


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
mapTimeInit T time body -> T time [body]
forall time body. C time => T time body -> T time [body]
TimeBodyList.collectCoincident



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


{- |
Analogously to the 'concat' \/ 'concatNaive' pair
we have to versions of 'filter',
where the clever implementation sums up pauses
from the beginning to the end.
-}

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)

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 = ([time] -> time) -> T [time] body -> T time body
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime [time] -> time
forall a. C a => [a] -> a
NonNeg.sum (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 (Maybe body) time -> T body [time])
-> T time (Maybe body) -> T [time] body
forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift T (Maybe body) time -> T body [time]
forall a b. T (Maybe a) b -> T a [b]
Uniform.catMaybesFirst

{- |
Adds times in a right-associative fashion.
Use this if the time is a data type like lazy Peano numbers
or "Numeric.NonNegative.Chunky".
-}
catMaybesR :: (NonNeg.C time) =>
   T time (Maybe body) -> T time body
catMaybesR :: forall time body. C time => T time (Maybe body) -> T time body
catMaybesR =
   (time -> T time body -> T time body)
-> (Maybe body -> T time body -> T time body)
-> T time body
-> T time (Maybe body)
-> T time body
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      ((time -> time) -> T time body -> T time body
forall time body. (time -> time) -> T time body -> T time body
mapTimeHead ((time -> time) -> T time body -> T time body)
-> (time -> time -> time) -> time -> T time body -> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> time -> time
forall a. C a => a -> a -> a
add)
      ((T time body -> T time body)
-> (body -> T time body -> T time body)
-> Maybe body
-> T time body
-> T time body
forall b a. b -> (a -> b) -> Maybe a -> b
maybe T time body -> T time body
forall a. a -> a
id (time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons time
forall a. C a => a
zero))
      (time -> T time body
forall time body. time -> T time body
pause time
forall a. C a => a
zero)

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 =
   (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 (([time] -> time) -> T [time] body -> T time body
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime [time] -> time
forall a. C a => [a] -> a
NonNeg.sum, ([time] -> time) -> T [time] body -> T time body
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime [time] -> time
forall a. C a => [a] -> a
NonNeg.sum) ((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
.
   (T body [time] -> T [time] body, T body [time] -> T [time] body)
-> (T body [time], T body [time]) -> (T [time] body, T [time] body)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (T body [time] -> T [time] body
forall time body. T body time -> T time body
Cons, T body [time] -> T [time] body
forall time body. T body time -> T time body
Cons) ((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
.
   (body -> Bool) -> T body time -> (T body [time], T body [time])
forall a b. (a -> Bool) -> T a b -> (T a [b], T a [b])
Uniform.partitionFirst body -> Bool
p (T body time -> (T body [time], T body [time]))
-> (T time body -> T body time)
-> T time body
-> (T body [time], T body [time])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time body -> T body time
forall time body. T time body -> T body time
decons

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 body1 [time] -> T time body1, T body0 [time] -> T time body0)
-> (T body1 [time], T body0 [time]) -> (T time body1, T time body0)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (([time] -> time) -> T [time] body1 -> T time body1
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime [time] -> time
forall a. C a => [a] -> a
NonNeg.sum (T [time] body1 -> T time body1)
-> (T body1 [time] -> T [time] body1)
-> T body1 [time]
-> T time body1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body1 [time] -> T [time] body1
forall time body. T body time -> T time body
Cons, ([time] -> time) -> T [time] body0 -> T time body0
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime [time] -> time
forall a. C a => [a] -> a
NonNeg.sum (T [time] body0 -> T time body0)
-> (T body0 [time] -> T [time] body0)
-> T body0 [time]
-> T time body0
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body0 [time] -> T [time] body0
forall time body. T body time -> T time body
Cons) ((T body1 [time], T body0 [time]) -> (T time body1, T time body0))
-> (T time body0 -> (T body1 [time], T body0 [time]))
-> T time body0
-> (T time body1, T time body0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (body0 -> Maybe body1)
-> T body0 time -> (T body1 [time], T body0 [time])
forall a0 a1 b. (a0 -> Maybe a1) -> T a0 b -> (T a1 [b], T a0 [b])
Uniform.partitionMaybeFirst body0 -> Maybe body1
f (T body0 time -> (T body1 [time], T body0 [time]))
-> (T time body0 -> T body0 time)
-> T time body0
-> (T body1 [time], T body0 [time])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time body0 -> T body0 time
forall time body. T time body -> T body time
decons

{- |
Cf. 'catMaybesR'
-}
partitionMaybeR :: (NonNeg.C time) =>
   (body0 -> Maybe body1) -> T time body0 ->
   (T time body1, T time body0)
partitionMaybeR :: forall time body0 body1.
C time =>
(body0 -> Maybe body1)
-> T time body0 -> (T time body1, T time body0)
partitionMaybeR body0 -> Maybe body1
f =
   (T [time] body1 -> T time body1, T [time] body0 -> T time body0)
-> (T [time] body1, T [time] body0) -> (T time body1, T time body0)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair
      (([time] -> time) -> T [time] body1 -> T time body1
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime ((time -> time -> time) -> time -> [time] -> time
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr time -> time -> time
forall a. C a => a -> a -> a
add time
forall a. C a => a
zero),
       ([time] -> time) -> T [time] body0 -> T time body0
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime ((time -> time -> time) -> time -> [time] -> time
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr time -> time -> time
forall a. C a => a -> a -> a
add time
forall a. C a => a
zero)) ((T [time] body1, T [time] body0) -> (T time body1, T time body0))
-> (T time body0 -> (T [time] body1, T [time] body0))
-> T time body0
-> (T time body1, T time body0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (T body1 [time] -> T [time] body1,
 T body0 [time] -> T [time] body0)
-> (T body1 [time], T body0 [time])
-> (T [time] body1, T [time] body0)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (T body1 [time] -> T [time] body1
forall time body. T body time -> T time body
Cons, T body0 [time] -> T [time] body0
forall time body. T body time -> T time body
Cons) ((T body1 [time], T body0 [time])
 -> (T [time] body1, T [time] body0))
-> (T time body0 -> (T body1 [time], T body0 [time]))
-> T time body0
-> (T [time] body1, T [time] body0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (body0 -> Maybe body1)
-> T body0 time -> (T body1 [time], T body0 [time])
forall a0 a1 b. (a0 -> Maybe a1) -> T a0 b -> (T a1 [b], T a0 [b])
Uniform.partitionMaybeFirst body0 -> Maybe body1
f (T body0 time -> (T body1 [time], T body0 [time]))
-> (T time body0 -> T body0 time)
-> T time body0
-> (T body1 [time], T body0 [time])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time body0 -> T body0 time
forall time body. T time body -> T body time
decons

{- |
Since we need it later for MIDI generation,
we will also define a slicing into equivalence classes of events.
-}
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 (((body, T time body) -> body)
-> Maybe (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 (body, T time body) -> body
forall a b. (a, b) -> a
fst (Maybe (body, T time body) -> Maybe body)
-> (T time body -> Maybe (body, T time body))
-> T time body
-> Maybe body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> Maybe (body, T time body)
forall time body. T time body -> Maybe (body, T time body)
viewBodyL (T time body -> Maybe (body, T time body))
-> (T time body -> T time body)
-> T time body
-> Maybe (body, T time body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time, T time body) -> T time body
forall a b. (a, b) -> b
snd ((time, T time body) -> T time body)
-> (T time body -> (time, 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 time body. T time body -> (time, T time body)
viewTimeL) (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


foldl :: (a -> time -> b) -> (b -> body -> a) -> a -> T time body -> b
foldl :: forall a time b body.
(a -> time -> b) -> (b -> body -> a) -> a -> T time body -> b
foldl a -> time -> b
f b -> body -> a
g a
x = (b -> body -> a) -> (a -> time -> b) -> a -> T body time -> b
forall c a d b. (c -> a -> d) -> (d -> b -> c) -> d -> T a b -> c
Uniform.foldl b -> body -> a
g a -> time -> b
f a
x (T body time -> b)
-> (T time body -> T body time) -> T time body -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T body time
forall time body. T time body -> T body time
decons

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


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
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
*)


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
start =
   T body time -> T time body
forall time body. T body time -> T time body
AbsoluteEventPriv.Cons (T body time -> T time body)
-> (T time body -> T body time) -> T time body -> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T body time
forall time body. T time body -> T body time
decons (T time body -> T body time)
-> (T time body -> T time body) -> T time body -> T body time
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (State time (T time body) -> time -> T time body)
-> time -> State time (T time body) -> T time body
forall a b c. (a -> b -> c) -> b -> a -> c
flip State time (T time body) -> time -> T time body
forall s a. State s a -> s -> a
evalState time
start (State time (T time body) -> T time body)
-> (T time body -> State time (T time body))
-> T time body
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (time -> StateT time Identity time)
-> T time body -> State time (T time body)
forall (m :: * -> *) time0 time1 body.
Monad m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
mapTimeM (\time
dur -> (time -> time) -> StateT time Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (time
durtime -> time -> time
forall a. Num a => a -> a -> a
+) StateT time Identity ()
-> StateT time Identity time -> StateT time Identity time
forall a b.
StateT time Identity a
-> StateT time Identity b -> StateT time Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT time Identity time
forall (m :: * -> *) s. Monad m => StateT s m s
get)

fromAbsoluteEventList :: (Num time) =>
   AbsoluteEventList.T time body -> T time body
fromAbsoluteEventList :: forall time body. Num time => T time body -> T time body
fromAbsoluteEventList =
   (State time (T time body) -> time -> T time body)
-> time -> State time (T time body) -> T time body
forall a b c. (a -> b -> c) -> b -> a -> c
flip State time (T time body) -> time -> T time body
forall s a. State s a -> s -> a
evalState time
0 (State time (T time body) -> T time body)
-> (T time body -> State time (T time body))
-> T time body
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (time -> StateT time Identity time)
-> T time body -> State time (T time body)
forall (m :: * -> *) time0 time1 body.
Monad m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
mapTimeM
      (\time
time -> do time
lastTime <- StateT time Identity time
forall (m :: * -> *) s. Monad m => StateT s m s
get; time -> StateT time Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put time
time; time -> StateT time Identity time
forall a. a -> StateT time Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (time
timetime -> time -> time
forall a. Num a => a -> a -> a
-time
lastTime)) (T time body -> State time (T time body))
-> (T time body -> T time body)
-> T time body
-> State time (T time body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T body time -> T time body
forall time body. T body time -> T time body
Cons (T body time -> T time body)
-> (T time body -> T body time) -> T time body -> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T body time
forall time body. T time body -> T body time
AbsoluteEventPriv.decons