{- |
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 = forall time body. T body time -> T time body
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> T a b
Uniform.singleton

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



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

getTimes :: T time body -> [time]
getTimes :: forall time body. T time body -> [time]
getTimes = forall a b. T a b -> [b]
Uniform.getSeconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. C a => [a] -> a
NonNeg.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift (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 =
   forall time body. T body time -> T time body
Cons forall a b. (a -> b) -> a -> b
$ (forall a b. T a b -> a -> b -> T a b
Uniform.snoc 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 =
   forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd forall time body. T body time -> T time body
Cons)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. T a b -> (b, Maybe (a, T a b))
Mixed.viewL forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   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 =
   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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T body time -> T time body
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   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 =
   forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall time body. T body time -> T time body
Cons)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> (Maybe (T a b, a), b)
Mixed.viewR forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
   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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T body time -> T time body
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   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 = forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
   forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      (\time
time ->
         forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall time body. time -> T time body -> T time body
consTime time
time, forall time body. time -> T time body -> T time body
consTime time
time))
      (\(body0
body0, body1
body1) ->
         forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall body time. body -> T time body -> T time body
consBody body0
body0, forall body time. body -> T time body -> T time body
consBody body1
body1))
      (forall a. Monoid a => a
mempty, 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 = forall m time body.
Monoid m =>
(time -> m) -> (body -> m) -> T time body -> m
Uniform.concatMapMonoid body -> m
g time -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) body0 time0 body1 time1.
Applicative m =>
(T body0 time0 -> m (T body1 time1))
-> T time0 body0 -> m (T time1 body1)
liftA (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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) body0 time0 body1 time1.
Applicative m =>
(T body0 time0 -> m (T body1 time1))
-> T time0 body0 -> m (T time1 body1)
liftA (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 = forall (m :: * -> *) body0 time0 body1 time1.
Applicative m =>
(T body0 time0 -> m (T body1 time1))
-> T time0 body0 -> m (T time1 body1)
liftA (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 =
   forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) time0 time1 body0 body1.
Applicative m =>
(time0 -> m time1)
-> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
traverse (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. time0 -> m time1
f) (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad 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 =
   forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) time body.
Applicative m =>
(time -> m ()) -> (body -> m ()) -> T time body -> m ()
traverse_ (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> m ()
f) (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad 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 = forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) body0 body1 time.
Applicative m =>
(body0 -> m body1) -> T time body0 -> m (T time body1)
traverseBody (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad 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 = forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) time0 time1 body.
Applicative m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
traverseTime (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad 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 = forall time a b. C time => ([a] -> [b]) -> T time a -> T time b
mapCoincident 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 =
   forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.all forall a. Ord a => [a] -> Bool
isAscending forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> [body]
getBodies forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall time body.
C time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
mergeBy 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) = forall time body. T time body -> (time, T time body)
viewTimeL T time body
xs0
              (time
yt,T time body
ys) = forall time body. T time body -> (time, T time body)
viewTimeL T time body
ys0
              (time
mt,~(Bool
bef,time
dt)) = forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split time
xt time
yt
          in  forall time body. C time => time -> T time body -> T time body
delay time
mt forall a b. (a -> b) -> a -> b
$
              if time
dt forall a. Eq a => a -> a -> Bool
== forall a. C a => a
zero
                then
                   case (forall time body. T time body -> Maybe (body, T time body)
viewBodyL T time body
xs, 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)
_) -> forall time body. time -> T time body -> T time body
consTime forall a. C a => a
zero T time body
ys
                      (Maybe (body, T time body)
_, Maybe (body, T time body)
Nothing) -> forall time body. time -> T time body -> T time body
consTime 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 forall time body. time -> body -> T time body -> T time body
cons forall a. C a => a
zero body
b0 forall a b. (a -> b) -> a -> b
$
                                T time body -> T time body -> T time body
recourse T time body
xs1 (forall time body. time -> T time body -> T time body
consTime forall a. C a => a
zero T time body
ys)
                           else forall time body. time -> body -> T time body -> T time body
cons forall a. C a => a
zero body
b1 forall a b. (a -> b) -> a -> b
$
                                T time body -> T time body -> T time body
recourse (forall time body. time -> T time body -> T time body
consTime 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 = forall time body. time -> T time body -> T time body
consTime time
dt T time body
ys
                       in  forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
switchBodyL T time body
ys1) T time body
xs forall a b. (a -> b) -> a -> b
$ \ body
b T time body
xs1 ->
                              forall time body. time -> body -> T time body -> T time body
cons forall a. C a => a
zero body
b 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 = forall time body. time -> T time body -> T time body
consTime time
dt T time body
xs
                       in  forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
switchBodyL T time body
xs1) T time body
ys forall a b. (a -> b) -> a -> b
$ \ body
b T time body
ys1 ->
                              forall time body. time -> body -> T time body -> T time body
cons forall a. C a => a
zero body
b 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  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 = forall time body.
C time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy 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 =
          forall time body a. (time -> T time body -> a) -> T time body -> a
switchTimeL forall a b. (a -> b) -> a -> b
$ \ t
t1 T t body
xs0 ->
             let (t
mt,~(Bool
b,t
dt)) = forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split t
t1 t
t
             in  forall time body. C time => time -> T time body -> T time body
delay t
mt forall a b. (a -> b) -> a -> b
$
                 if Bool -> Bool
not Bool
b
                   then forall time body. time -> body -> T time body -> T time body
cons forall a. C a => a
zero body
me0 forall a b. (a -> b) -> a -> b
$ forall time body. time -> T time body -> T time body
consTime t
dt T t body
xs0
                   else
                     forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
switchBodyL
                        (forall time body. time -> body -> T time body -> T time body
cons t
dt body
me0 forall a b. (a -> b) -> a -> b
$ forall time body. time -> T time body
pause forall a. C a => a
zero)
                        (\ body
me1 T t body
xs -> forall time body. time -> T time body -> T time body
consTime forall a. C a => a
zero forall a b. (a -> b) -> a -> b
$
                           if t
dtforall a. Eq a => a -> a -> Bool
==forall a. C a => a
zero Bool -> Bool -> Bool
&& body -> body -> Bool
before body
me0 body
me1
                             then forall body time. body -> T time body -> T time body
consBody body
me0 (forall time body. time -> body -> T time body -> T time body
cons forall a. C a => a
zero body
me1 T t body
xs)
                             else 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   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 = forall time body.
C time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
mergeBy (\ body
_ body
_ -> Bool
False) (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 =
   forall time body. Num time => T time body -> T time body
fromAbsoluteEventList forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time body.
(Ord time, Num time) =>
T time (time, body) -> T time body
AbsoluteEventList.moveForward forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   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 =
   forall time body. C time => T time (Maybe body) -> T time body
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      (\time
t -> forall time body. time -> body -> T time body -> T time body
cons time
t forall a. Maybe a
Nothing)
      (\(time
t,body
b) -> forall time body.
C time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy (forall body.
(body -> body -> Bool) -> Maybe body -> Maybe body -> Bool
ltMaybe (\body
_ body
_ -> Bool
True)) time
t (forall a. a -> Maybe a
Just body
b))
      (forall time body. time -> T time body
pause 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 =
   forall time body. C time => time -> T time body -> T time body
decreaseStart time
maxTime forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time body. C time => T time (time, body) -> T time body
moveBackward forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
mapBody (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (time
maxTimeforall a. C a => a -> a -> a
-|)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   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 =
   forall time body. C time => time -> T time body -> T time body
decreaseStart time
maxTime forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time body. C time => T time (Maybe body) -> T time body
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      (\time
t -> forall time body. time -> body -> T time body -> T time body
cons time
t forall a. Maybe a
Nothing)
      (\(time
t,body
b) -> forall time body.
C time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy (forall body.
(body -> body -> Bool) -> Maybe body -> Maybe body -> Bool
ltMaybe body -> body -> Bool
cmp) (time
maxTimeforall a. C a => a -> a -> a
-|time
t) (forall a. a -> Maybe a
Just body
b))
      (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 =
   forall time body. C time => time -> T time body -> T time body
decreaseStart time
maxTime forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      forall time body. C time => time -> T time body -> T time body
delay
      (\(time
t,body
b) -> forall time body.
C time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy body -> body -> Bool
cmp (time
maxTimeforall a. C a => a -> a -> a
-|time
t) body
b)
      (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) = 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 = 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) <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAtTime time
t)
             forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put T time body
toKeep
             forall (m :: * -> *) a. Monad m => a -> m a
return (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) =
          forall time body.
C time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy body -> body -> Bool
cmp (time
maxTime forall a. Num a => a -> a -> a
- time
t) body
b
   in  forall s a. State s a -> s -> a
evalState
          (forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
             (\time
t StateT (T time body) Identity (T time body)
m -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall time body.
C time =>
T time body -> T time body -> T time body
append (forall {m :: * -> *} {time} {body}.
(Monad m, C time) =>
time -> StateT (T time body) m (T time body)
getChunk time
t) StateT (T time body) Identity (T time body)
m)
             (\(time, body)
b StateT (T time body) Identity (T time body)
m -> forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((time, body) -> T time body -> T time body
insertEvent (time, body)
b) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT (T time body) Identity (T time body)
m)
             (forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (forall time body. C time => time -> T time body -> T time body
pad time
prefixDur)) T time (time, body)
suffix)
          (forall time body.
(Ord time, Num time) =>
T time (time, body) -> T time body
moveForward (seq :: 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 = 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 =
   forall time body. C time => T time (Maybe body) -> T time body
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      (\time
t -> forall time body. time -> body -> T time body -> T time body
cons time
t forall a. Maybe a
Nothing)
      (\T time body
xs -> forall time body.
C time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
mergeBy (forall body.
(body -> body -> Bool) -> Maybe body -> Maybe body -> Bool
ltMaybe body -> body -> Bool
cmp) (forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
mapBody forall a. a -> Maybe a
Just T time body
xs))
      (forall time body. time -> T time body
pause 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 = 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr forall time body.
C time =>
T time body -> T time body -> T time body
append (forall time body. time -> T time body
pause 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 =
   forall time body a. (time -> T time body -> a) -> T time body -> a
switchTimeL
   (\time
t0 T time body
xs ->
       forall time body. time -> T time body -> T time body
consTime time
t0 forall a b. (a -> b) -> a -> b
$
       forall time body. T time body -> T time body
BodyTimePriv.cycle forall a b. (a -> b) -> a -> b
$
       forall time body. (time -> time) -> T time body -> T time body
BodyTimePriv.mapTimeLast (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 = forall time body. C time => [T time body] -> T time body
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
   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)) = 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.
          -}
          forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall time body. time -> T time body -> T time body
consTime time
mt, forall time body. C time => T time body -> T time body
forceTimeHead) forall a b. (a -> b) -> a -> b
$
          if Bool
bef
            then (forall a. Monoid a => a
mempty, forall time body. time -> T time body -> T time body
consTime time
dt T time body
xs)
            else forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
switchBodyL
                    (forall a. Monoid a => a
mempty, forall time body. time -> T time body
pause forall a. C a => a
zero)
                    (\ body
b -> forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall body time. body -> T time body -> T time body
consBody body
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAtTime time
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 = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body.
C time =>
time -> T time body -> (T time body, T time body)
splitAtTime time
t

dropTime :: (NonNeg.C time) =>
   time -> 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 =
   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) = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split time
t0 time
t1
      in  forall time body. C time => T time body -> T time body
forceTimeHead forall a b. (a -> b) -> a -> b
$
          if Bool
bef
            then forall time body. time -> T time body -> T time body
consTime time
dt T time body
xs
            else forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
switchBodyL
                    (forall time body. time -> T time body
pause forall a. C a => a
zero)
                    (\ body
_b -> 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 =
   forall time body. (time -> time) -> T time body -> T time body
mapTimeHead (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 =
   forall time body0 body1.
(T time body0 -> T time body1) -> T time body0 -> T time body1
mapTimeInit 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 =
   forall time body. C time => T time [body] -> T time body
flatten forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
mapBody [a] -> [b]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall time body0 body1.
C time =>
(body0 -> Maybe body1) -> T time body0 -> T time body1
mapMaybe (\body
b -> 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 = forall time body. C time => T time (Maybe body) -> T time body
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime forall a. C a => [a] -> a
NonNeg.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift 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 =
   forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
foldr
      (forall time body. (time -> time) -> T time body -> T time body
mapTimeHead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => a -> a -> a
add)
      (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall time body. time -> body -> T time body -> T time body
cons forall a. C a => a
zero))
      (forall time body. time -> T time body
pause 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 =
   forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime forall a. C a => [a] -> a
NonNeg.sum, forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime forall a. C a => [a] -> a
NonNeg.sum) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall time body. T body time -> T time body
Cons, forall time body. T body time -> T time body
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. (a -> Bool) -> T a b -> (T a [b], T a [b])
Uniform.partitionFirst body -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   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 =
   forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime forall a. C a => [a] -> a
NonNeg.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T body time -> T time body
Cons, forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime forall a. C a => [a] -> a
NonNeg.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T body time -> T time body
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a0 a1 b. (a0 -> Maybe a1) -> T a0 b -> (T a1 [b], T a0 [b])
Uniform.partitionMaybeFirst body0 -> Maybe body1
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   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 =
   forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair
      (forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr forall a. C a => a -> a -> a
add forall a. C a => a
zero),
       forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr forall a. C a => a -> a -> a
add forall a. C a => a
zero)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall time body. T body time -> T time body
Cons, forall time body. T body time -> T time body
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a0 a1 b. (a0 -> Maybe a1) -> T a0 b -> (T a1 [b], T a0 [b])
Uniform.partitionMaybeFirst body0 -> Maybe body1
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   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 = forall a eventlist body.
Eq a =>
(eventlist -> Maybe body)
-> ((body -> Bool) -> eventlist -> (eventlist, eventlist))
-> (body -> a)
-> eventlist
-> [(a, eventlist)]
Utility.slice (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> Maybe (body, T time body)
viewBodyL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> (time, T time body)
viewTimeL) 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall body0 time0 body1 time1.
(T body0 time0 -> T body1 time1) -> T time0 body0 -> T time1 body1
lift 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 =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState time
0.5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) time0 time1 body.
Monad m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
mapTimeM 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 =
   forall time i body.
(C time, RealFrac time, C i, Integral i) =>
T time body -> T i body
discretize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime (time
rateforall 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 =
   forall time body. T body time -> T time body
AbsoluteEventPriv.Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> T body time
decons forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState time
start forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (m :: * -> *) time0 time1 body.
Monad m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
mapTimeM (\time
dur -> forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (time
durforall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState time
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (m :: * -> *) time0 time1 body.
Monad m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
mapTimeM
      (\time
time -> do time
lastTime <- forall (m :: * -> *) s. Monad m => StateT s m s
get; forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put time
time; forall (m :: * -> *) a. Monad m => a -> m a
return (time
timeforall a. Num a => a -> a -> a
-time
lastTime)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time body. T body time -> T time body
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> T body time
AbsoluteEventPriv.decons