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

Maintainer  :  haskell@henning-thielemann.de
Stability   :  stable
Portability :  Haskell 98
-}
module Data.EventList.Absolute.TimeBody
   (T,
    empty, singleton, null,
    viewL, viewR, switchL, switchR, cons, snoc,
    fromPairList, toPairList,
    getTimes, getBodies, duration,
    mapBody, mapTime,
    concatMapMonoid,
    traverse, traverse_, traverseBody, traverseTime, traverseWithTime,
    mapM, mapM_, mapBodyM, mapTimeM,
    merge, mergeBy, insert, insertBy,
    moveForward,
    decreaseStart, delay, filter, partition, partitionMaybe,
    slice, foldr, foldrPair,
    mapMaybe, catMaybes,
    normalize, isNormalized,
    collectCoincident, flatten, mapCoincident,
    append, concat, cycle,
--    splitAtTime, takeTime, dropTime,
    discretize, resample,
    checkTimes,

    collectCoincidentFoldr, collectCoincidentNonLazy, -- for testing
   ) where

import Data.EventList.Absolute.TimeBodyPrivate

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

import Data.Monoid (Monoid, )

import Data.Tuple.HT (mapFst, mapSnd, )
import Data.Maybe.HT (toMaybe, )
import Data.List.HT (isAscending, isAscendingLazy, )
import Data.Function.HT (compose2, )
import Data.EventList.Utility (beforeBy, )

import qualified Control.Monad as Monad
import Control.Applicative (Applicative, WrappedMonad(WrapMonad, unwrapMonad), )

import Control.Monad.Trans.State (state, evalState)
import Control.Monad (Monad, (>>), )

import Data.Function (id, flip, (.), ($), )
import Data.Functor (fmap, )
import Data.Maybe (Maybe(Just, Nothing), maybe, )
import Data.Tuple (uncurry, fst, snd, )
import Data.Ord (Ord, compare, (<), (>=), )
import Data.Eq (Eq, (==), (/=), )
import Prelude
   (Num, Integral, RealFrac, round, subtract, (*), (-),
    Bool, error, )


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

null :: T time body -> Bool
null :: forall time body. T time body -> Bool
null = T time body -> Bool
forall a b. T a b -> Bool
Disp.null (T time body -> Bool)
-> (T time body -> T time body) -> T time body -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T time body
forall time body. T time body -> T time body
decons

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


cons :: time -> body -> T time body -> T time body
cons :: forall time body. time -> body -> T time body -> T time body
cons time
time body
body = (T time body -> T time body) -> T time body -> T time body
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift (time -> body -> T time body -> T time body
forall a b. a -> b -> T a b -> T a b
Disp.cons time
time body
body)

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


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

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


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

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

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

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




concatMapMonoid :: Monoid m =>
   (time -> m) -> (body -> m) ->
   T time body -> m
concatMapMonoid :: forall m time body.
Monoid m =>
(time -> m) -> (body -> m) -> T time body -> m
concatMapMonoid time -> m
f body -> m
g =
   (time -> m) -> (body -> m) -> T time body -> m
forall m time body.
Monoid m =>
(time -> m) -> (body -> m) -> T time body -> m
Disp.concatMapMonoid time -> m
f body -> m
g (T time body -> m)
-> (T time body -> T time body) -> T time body -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T time body
forall time body. T time body -> T time body
decons


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

traverse_ :: Applicative m =>
   (time -> m ()) -> (body -> m ()) ->
   T time body -> m ()
traverse_ :: forall (m :: * -> *) time body.
Applicative m =>
(time -> m ()) -> (body -> m ()) -> T time body -> m ()
traverse_ time -> m ()
f body -> m ()
g = (time -> m ()) -> (body -> m ()) -> T time body -> m ()
forall (m :: * -> *) d a b.
(Applicative m, Monoid d) =>
(a -> m d) -> (b -> m d) -> T a b -> m d
Disp.traverse_ time -> m ()
f body -> m ()
g (T time body -> m ())
-> (T time body -> T time body) -> T time body -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T time body
forall time body. T time body -> T time body
decons


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

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


traverseWithTime :: Applicative m =>
   (time -> body0 -> m body1) -> T time body0 -> m (T time body1)
traverseWithTime :: forall (m :: * -> *) time body0 body1.
Applicative m =>
(time -> body0 -> m body1) -> T time body0 -> m (T time body1)
traverseWithTime time -> body0 -> m body1
f =
   ([(time, body1)] -> T time body1)
-> m [(time, body1)] -> m (T time body1)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(time, body1)] -> T time body1
forall a b. [(a, b)] -> T a b
fromPairList (m [(time, body1)] -> m (T time body1))
-> (T time body0 -> m [(time, body1)])
-> T time body0
-> m (T time body1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((time, body0) -> m (time, body1))
-> [(time, body0)] -> m [(time, body1)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
Trav.traverse (\(time
t,body0
b) -> (body1 -> (time, body1)) -> m body1 -> m (time, body1)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) time
t) (time -> body0 -> m body1
f time
t body0
b)) ([(time, body0)] -> m [(time, body1)])
-> (T time body0 -> [(time, body0)])
-> T time body0
-> m [(time, body1)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time body0 -> [(time, body0)]
forall a b. T a b -> [(a, b)]
toPairList


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)


{- |
Check whether time values are in ascending order.
The list is processed lazily and
times that are smaller than there predecessors are replaced by 'undefined'.
If you would remove the 'undefined' times from the resulting list
the times may still not be ordered.
E.g. consider the time list @[0,3,1,2]@
-}
checkTimes :: (Ord time) => T time body -> T time body
checkTimes :: forall time body. Ord time => T time body -> T time body
checkTimes T time body
xs =
   (T time body -> T time body) -> T time body -> T time body
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift
      ((Bool -> time -> time) -> [Bool] -> T time body -> T time body
forall a0 a1 a2 b. (a0 -> a1 -> a2) -> [a0] -> T a1 b -> T a2 b
Disp.zipWithFirst
         (\Bool
b time
t -> if Bool
b then time
t else [Char] -> time
forall a. HasCallStack => [Char] -> a
error [Char]
"times out of order")
         ([time] -> [Bool]
forall a. Ord a => [a] -> [Bool]
isAscendingLazy (T time body -> [time]
forall time body. T time body -> [time]
getTimes T time body
xs)))
      T time body
xs


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

foldrPair :: (time -> body -> a -> a) -> a -> T time body -> a
foldrPair :: forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair time -> body -> a -> a
f a
x = (time -> body -> a -> a) -> a -> T time body -> a
forall a b c. (a -> b -> c -> c) -> c -> T a b -> c
Disp.foldrPair time -> body -> a -> a
f a
x (T time body -> a)
-> (T time body -> T time body) -> T time body -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T time body
forall time body. T time body -> T time body
decons


filter :: (Num time) =>
   (body -> Bool) -> T time body -> T time body
filter :: forall time body.
Num 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.
Num 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 :: (Num time) =>
   (body0 -> Maybe body1) ->
   T time body0 -> T time body1
mapMaybe :: forall time body0 body1.
Num 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. Num 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

catMaybes :: (Num time) =>
   T time (Maybe body) -> T time body
catMaybes :: forall time body. Num time => T time (Maybe body) -> T time body
catMaybes =
   (time -> Maybe body -> T time body -> T time body)
-> T time body -> T time (Maybe body) -> T time body
forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair ((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 ((body -> T time body -> T time body)
 -> Maybe body -> T time body -> T time body)
-> (time -> body -> T time body -> T time body)
-> time
-> Maybe body
-> T time body
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons) T time body
forall time body. T time body
empty

{-
Could be implemented more easily in terms of Uniform.partition
-}
partition ::
   (body -> Bool) -> T time body -> (T time body, T time body)
partition :: forall body time.
(body -> Bool) -> T time body -> (T time body, T time body)
partition body -> Bool
p =
   (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 time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair
      (\ time
t body
b ->
          (if body -> Bool
p body
b then (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 else (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)
mapSnd) (time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons time
t body
b))
      (T time body
forall time body. T time body
empty, T time body
forall time body. T time body
empty)

partitionMaybe ::
   (body0 -> Maybe body1) -> T time body0 -> (T time body1, T time body0)
partitionMaybe :: forall body0 body1 time.
(body0 -> Maybe body1)
-> T time body0 -> (T time body1, T time body0)
partitionMaybe body0 -> Maybe body1
p =
   (time
 -> body0
 -> (T time body1, T time body0)
 -> (T time body1, T time body0))
-> (T time body1, T time body0)
-> T time body0
-> (T time body1, T time body0)
forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair
      (\ time
t body0
b ->
          ((T time body1, T time body0) -> (T time body1, T time body0))
-> (body1
    -> (T time body1, T time body0) -> (T time body1, T time body0))
-> Maybe body1
-> (T time body1, T time body0)
-> (T time body1, T time body0)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((T time body0 -> T time body0)
-> (T time body1, T time body0) -> (T time body1, T time body0)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (time -> body0 -> T time body0 -> T time body0
forall time body. time -> body -> T time body -> T time body
cons time
t body0
b)) ((T time body1 -> T time body1)
-> (T time body1, T time body0) -> (T time body1, T time body0)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((T time body1 -> T time body1)
 -> (T time body1, T time body0) -> (T time body1, T time body0))
-> (body1 -> T time body1 -> T time body1)
-> body1
-> (T time body1, T time body0)
-> (T time body1, T time body0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> body1 -> T time body1 -> T time body1
forall time body. time -> body -> T time body -> T time body
cons time
t) (body0 -> Maybe body1
p body0
b))
      (T time body1
forall time body. T time body
empty, T time body0
forall time body. T time body
empty)

{- |
Since we need it later for MIDI generation,
we will also define a slicing into equivalence classes of events.
-}
slice :: (Eq a) =>
   (body -> a) -> T time body -> [(a, T time body)]
slice :: forall a body time.
Eq a =>
(body -> a) -> T time body -> [(a, T time body)]
slice = (T time body -> Maybe body)
-> ((body -> Bool) -> T time body -> (T time body, T time body))
-> (body -> a)
-> T time body
-> [(a, T time body)]
forall a eventlist body.
Eq a =>
(eventlist -> Maybe body)
-> ((body -> Bool) -> eventlist -> (eventlist, eventlist))
-> (body -> a)
-> eventlist
-> [(a, eventlist)]
Utility.slice ((((time, body), T time body) -> body)
-> Maybe ((time, body), T time body) -> Maybe body
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((time, body) -> body
forall a b. (a, b) -> b
snd ((time, body) -> body)
-> (((time, body), T time body) -> (time, body))
-> ((time, body), T time body)
-> body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((time, body), T time body) -> (time, body)
forall a b. (a, b) -> a
fst) (Maybe ((time, body), T time body) -> Maybe body)
-> (T time body -> Maybe ((time, body), T time body))
-> T time body
-> Maybe body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> Maybe ((time, body), T time body)
forall time body. T time body -> Maybe ((time, body), T time body)
viewL) (body -> Bool) -> T time body -> (T time body, T time body)
forall body time.
(body -> Bool) -> T time body -> (T time body, T time body)
partition


{- |
We will also sometimes need a function which groups events by equal start times.
This implementation is not so obvious since we work with time differences.
The criterion is: Two neighbouring events start at the same time
if the second one has zero time difference.
-}
collectCoincident :: Eq time => T time body -> T time [body]
collectCoincident :: forall time body. Eq time => T time body -> T time [body]
collectCoincident =
   T time [body] -> T time [body]
forall time body. T time body -> T time body
Cons (T time [body] -> T time [body])
-> (T time body -> T time [body]) -> T time body -> T time [body]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time [body]
-> (time -> T time body -> T time [body])
-> T time body
-> T time [body]
forall c a b. c -> (a -> T a b -> c) -> T a b -> c
Mixed.switchFirstL
      T time [body]
forall a b. T a b
Disp.empty
      (\ time
t0 ->
         time -> T time [body] -> T time [body]
forall a b. a -> T a b -> T a b
Mixed.consFirst time
t0 (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 (Maybe time) body -> T time [body]
forall a b. T (Maybe a) b -> T a [b]
Uniform.catMaybesFirst (T (Maybe time) body -> T time [body])
-> (T time body -> T (Maybe time) body)
-> T time body
-> T time [body]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (State (Maybe time) (T (Maybe time) body)
 -> Maybe time -> T (Maybe time) body)
-> Maybe time
-> State (Maybe time) (T (Maybe time) body)
-> T (Maybe time) body
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (Maybe time) (T (Maybe time) body)
-> Maybe time -> T (Maybe time) body
forall s a. State s a -> s -> a
evalState (time -> Maybe time
forall a. a -> Maybe a
Just time
t0) (State (Maybe time) (T (Maybe time) body) -> T (Maybe time) body)
-> (T time body -> State (Maybe time) (T (Maybe time) body))
-> T time body
-> T (Maybe time) body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (Maybe time -> StateT (Maybe time) Identity (Maybe time))
-> T (Maybe time) body -> State (Maybe time) (T (Maybe time) body)
forall (m :: * -> *) a0 a1 b.
Applicative m =>
(a0 -> m a1) -> T a0 b -> m (T a1 b)
Uniform.traverseFirst (\Maybe time
time -> (Maybe time -> (Maybe time, Maybe time))
-> StateT (Maybe time) Identity (Maybe time)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Maybe time -> (Maybe time, Maybe time))
 -> StateT (Maybe time) Identity (Maybe time))
-> (Maybe time -> (Maybe time, Maybe time))
-> StateT (Maybe time) Identity (Maybe time)
forall a b. (a -> b) -> a -> b
$ \ Maybe time
oldTime ->
            (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard (Maybe time
time Maybe time -> Maybe time -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe time
oldTime) Maybe () -> Maybe time -> Maybe time
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe time
time, Maybe time
time)) (T (Maybe time) body -> State (Maybe time) (T (Maybe time) body))
-> (T time body -> T (Maybe time) body)
-> T time body
-> State (Maybe time) (T (Maybe time) body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (time -> Maybe time) -> T time body -> T (Maybe time) body
forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
Uniform.mapFirst time -> Maybe time
forall a. a -> Maybe a
Just) (T time body -> T time [body])
-> (T time body -> T time body) -> T time body -> T time [body]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time body -> T time body
forall time body. T time body -> T time body
decons

collectCoincidentFoldr :: Eq time => T time body -> T time [body]
collectCoincidentFoldr :: forall time body. Eq time => T time body -> T time [body]
collectCoincidentFoldr =
   T time [body] -> T time [body]
forall time body. T time body -> T time body
Cons (T time [body] -> T time [body])
-> (T time body -> T time [body]) -> T time body -> T time [body]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (time -> body -> T time [body] -> T time [body])
-> T time [body] -> T time body -> T time [body]
forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair
      (\time
t0 body
b0 T time [body]
xs ->
          time -> T time [body] -> T time [body]
forall a b. a -> T a b -> T a b
Mixed.consFirst time
t0 (T time [body] -> T time [body]) -> T time [body] -> T time [body]
forall a b. (a -> b) -> a -> b
$
          T time [body]
-> (time -> [body] -> T time [body] -> T time [body])
-> T time [body]
-> T time [body]
forall c a b. c -> (a -> b -> T a b -> c) -> T a b -> c
Disp.switchL
             ([body] -> T time [body]
forall b a. b -> T a b
Uniform.singleton [body
b0])
             (\time
t1 [body]
bs T time [body]
ys ->
                 if time
t0 time -> time -> Bool
forall a. Eq a => a -> a -> Bool
== time
t1
                   then [body] -> T time [body] -> T time [body]
forall b a. b -> T a b -> T a b
Mixed.consSecond (body
b0body -> [body] -> [body]
forall a. a -> [a] -> [a]
:[body]
bs) T time [body]
ys
                   else [body] -> T time [body] -> T time [body]
forall b a. b -> T a b -> T a b
Mixed.consSecond [body
b0] T time [body]
xs)
             T time [body]
xs)
      T time [body]
forall a b. T a b
Disp.empty

{- |
Will fail on infinite lists.
-}
collectCoincidentNonLazy :: Eq time => T time body -> T time [body]
collectCoincidentNonLazy :: forall time body. Eq time => T time body -> T time [body]
collectCoincidentNonLazy =
   T time [body] -> T time [body]
forall time body. T time body -> T time body
Cons (T time [body] -> T time [body])
-> (T time body -> T time [body]) -> T time body -> T time [body]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (time -> body -> T time [body] -> T time [body])
-> T time [body] -> T time body -> T time [body]
forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair
      (\time
t0 body
b0 T time [body]
xs ->
          T time [body]
-> (time -> [body] -> T time [body] -> T time [body])
-> T time [body]
-> T time [body]
forall c a b. c -> (a -> b -> T a b -> c) -> T a b -> c
Disp.switchL
             (time -> [body] -> T time [body]
forall a b. a -> b -> T a b
Disp.singleton time
t0 [body
b0])
             (\time
t1 [body]
bs T time [body]
ys ->
                 if time
t0 time -> time -> Bool
forall a. Eq a => a -> a -> Bool
== time
t1
                   then time -> [body] -> T time [body] -> T time [body]
forall a b. a -> b -> T a b -> T a b
Disp.cons time
t0 (body
b0body -> [body] -> [body]
forall a. a -> [a] -> [a]
:[body]
bs) T time [body]
ys
                   else time -> [body] -> T time [body] -> T time [body]
forall a b. a -> b -> T a b -> T a b
Disp.cons time
t0 [body
b0] T time [body]
xs)
             T time [body]
xs)
      T time [body]
forall a b. T a b
Disp.empty


flatten :: (Ord time) => T time [body] -> T time body
flatten :: forall time body. Ord time => T time [body] -> T time body
flatten =
   (time -> [body] -> T time body -> T time body)
-> T time body -> T time [body] -> T time body
forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair
      (\time
t [body]
bs T time body
xs -> (body -> T time body -> T time body)
-> T time body -> [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 (time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons time
t) T time body
xs [body]
bs)
      T time body
forall time body. T time body
empty


{- |
Apply a function to the lists of coincident events.
-}

mapCoincident :: (Ord time) =>
   ([a] -> [b]) -> T time a -> T time b
mapCoincident :: forall time a b. Ord time => ([a] -> [b]) -> T time a -> T time b
mapCoincident [a] -> [b]
f = T time [b] -> T time b
forall time body. Ord 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. Eq time => T time body -> T time [body]
collectCoincident

{- |

'List.sort' sorts a list of coinciding events,
that is all events but the first one have time difference 0.
'normalize' sorts all coinciding events in a list
thus yielding a canonical representation of a time ordered list.
-}

normalize :: (Ord time, Num time, Ord body) => T time body -> T time body
normalize :: forall time body.
(Ord time, Num time, Ord body) =>
T time body -> T time body
normalize = ([body] -> [body]) -> T time body -> T time body
forall time a b. Ord time => ([a] -> [b]) -> T time a -> T time b
mapCoincident [body] -> [body]
forall a. Ord a => [a] -> [a]
List.sort

isNormalized :: (Ord time, Num time, Ord body) =>
   T time body -> Bool
isNormalized :: forall time body.
(Ord time, Num 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. Eq 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 :: (Ord time, Ord body) =>
   T time body -> T time body -> T time body
merge :: forall time body.
(Ord 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.
Ord time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
mergeBy body -> body -> Bool
forall a. Ord a => a -> a -> Bool
(<)

{- |
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 \secref{equivalence}.
It is also necessary to assert a unique representation
of the performance independent of the structure of the 'Music.T note'.
The same function for inserting into a time ordered list with a trailing pause.
The strictness annotation is necessary for working with infinite lists.

Here are two other functions that are already known for non-padded time lists.
-}

{-
Could be implemented using as 'splitAt' and 'insert'.
-}
mergeBy :: (Ord time) =>
   (body -> body -> Bool) ->
   T time body -> T time body -> T time body
mergeBy :: forall time body.
Ord time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
mergeBy body -> body -> Bool
before =
   let recourse :: T time body -> T time body -> T time body
recourse T time body
xs0 T time body
ys0 =
          case (T time body -> Maybe ((time, body), T time body)
forall time body. T time body -> Maybe ((time, body), T time body)
viewL T time body
xs0, T time body -> Maybe ((time, body), T time body)
forall time body. T time body -> Maybe ((time, body), T time body)
viewL T time body
ys0) of
             (Maybe ((time, body), T time body)
Nothing, Maybe ((time, body), T time body)
_) -> T time body
ys0
             (Maybe ((time, body), T time body)
_, Maybe ((time, body), T time body)
Nothing) -> T time body
xs0
             (Just ((time, body)
x,T time body
xs), Just ((time, body)
y,T time body
ys)) ->
                if (body -> body -> Bool) -> (time, body) -> (time, body) -> Bool
forall time body.
Ord time =>
(body -> body -> Bool) -> (time, body) -> (time, body) -> Bool
beforeBy body -> body -> Bool
before (time, body)
x (time, body)
y
                  then (time -> body -> T time body -> T time body)
-> (time, body) -> T time body -> T time body
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons (time, body)
x (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
xs T time body
ys0
                  else (time -> body -> T time body -> T time body)
-> (time, body) -> T time body -> T time body
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons (time, body)
y (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
ys T time body
xs0
   in  T time body -> T time body -> T time body
forall {time}.
Ord time =>
T time body -> T time body -> T time body
recourse

{- |
The final critical function is @insert@,
which inserts an event
into an already time-ordered sequence of events.
For instance it is used in MidiFiles to insert a @NoteOff@ event
into a list of @NoteOn@ and @NoteOff@ events.
-}

insert :: (Ord time, Ord body) =>
   time -> body -> T time body -> T time body
insert :: forall time body.
(Ord 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.
Ord time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy body -> body -> Bool
forall a. Ord a => a -> a -> Bool
(<)


insertBy :: (Ord time) =>
   (body -> body -> Bool) ->
   time -> body -> T time body -> T time body
insertBy :: forall time body.
Ord time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy body -> body -> Bool
before time
t0 body
me0 T time body
mevs1 =
   let mev0 :: (time, body)
mev0 = (time
t0, body
me0)
   in  T time body
-> ((time, body) -> T time body -> T time body)
-> T time body
-> T time body
forall c time body.
c -> ((time, body) -> T time body -> c) -> T time body -> c
switchL
          ((time -> body -> T time body) -> (time, body) -> T time body
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry time -> body -> T time body
forall time body. time -> body -> T time body
singleton (time, body)
mev0)
          (\(time, body)
mev1 T time body
mevs ->
              if (body -> body -> Bool) -> (time, body) -> (time, body) -> Bool
forall time body.
Ord time =>
(body -> body -> Bool) -> (time, body) -> (time, body) -> Bool
beforeBy body -> body -> Bool
before (time, body)
mev0 (time, body)
mev1
                then (time -> body -> T time body -> T time body)
-> (time, body) -> T time body -> T time body
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons (time, body)
mev0 (T time body -> T time body) -> T time body -> T time body
forall a b. (a -> b) -> a -> b
$ T time body
mevs1
                else (time -> body -> T time body -> T time body)
-> (time, body) -> T time body -> T time body
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons (time, body)
mev1 (T time body -> T time body) -> T time body -> T time body
forall a b. (a -> b) -> a -> b
$ (time -> body -> T time body -> T time body)
-> (time, body) -> T time body -> T time body
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((body -> body -> Bool)
-> time -> body -> T time body -> T time body
forall time body.
Ord time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy body -> body -> Bool
before) (time, body)
mev0 T time body
mevs)
          T time body
mevs1


{- |
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 =
   [(time, body)] -> T time body
forall a b. [(a, b)] -> T a b
fromPairList ([(time, body)] -> T time body)
-> (T time (time, body) -> [(time, body)])
-> T time (time, body)
-> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((time, body) -> (time, body) -> Ordering)
-> [(time, body)] -> [(time, body)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy ((time -> time -> Ordering)
-> ((time, body) -> time)
-> (time, body)
-> (time, body)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
compose2 time -> time -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (time, body) -> time
forall a b. (a, b) -> a
fst) ([(time, body)] -> [(time, body)])
-> (T time (time, body) -> [(time, body)])
-> T time (time, body)
-> [(time, body)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((time, (time, body)) -> (time, body))
-> [(time, (time, body))] -> [(time, body)]
forall a b. (a -> b) -> [a] -> [b]
List.map (\ ~(time
time,(time
timeDiff,body
body)) -> (time
time time -> time -> time
forall a. Num a => a -> a -> a
- time
timeDiff, body
body)) ([(time, (time, body))] -> [(time, body)])
-> (T time (time, body) -> [(time, (time, body))])
-> T time (time, body)
-> [(time, body)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T time (time, body) -> [(time, (time, body))]
forall a b. T a b -> [(a, b)]
toPairList




{-
splitAtTime :: (Ord time, Num time) =>
   time -> T time body -> (Uniform.T body time, T time body)
splitAtTime t0 =
   maybe
      (Uniform.singleton 0, empty)
      (\(t1,xs) ->
          if t0<=t1
            then (Uniform.singleton t0, consTime (t1-t0) xs)
            else
               (\(b,ys) -> mapFst (Uniform.cons t1 b) (splitAtTime (t0-t1) ys))
               (viewBodyL xs)) .
   viewTimeL

takeTime :: (Ord time, Num time) =>
   time -> T time body -> Uniform.T body time
takeTime t = fst . splitAtTime t

dropTime :: (Ord time, Num time) =>
   time -> T time body -> T time body
dropTime t = snd . splitAtTime t
-}


decreaseStart :: (Ord time, Num time) =>
   time -> T time body -> T time body
decreaseStart :: forall time body.
(Ord time, Num time) =>
time -> T time body -> T time body
decreaseStart time
dif =
   T time body
-> ((time, body) -> T time body -> T time body)
-> T time body
-> T time body
forall c time body.
c -> ((time, body) -> T time body -> c) -> T time body -> c
switchL
      T time body
forall time body. T time body
empty
      (\(time
t, body
b) T time body
xs ->
         time -> body -> T time body -> T time body
forall time body. time -> body -> T time body -> T time body
cons
            (if time
ttime -> time -> Bool
forall a. Ord a => a -> a -> Bool
>=time
dif
               then time
ttime -> time -> time
forall a. Num a => a -> a -> a
-time
dif
               else [Char] -> time
forall a. HasCallStack => [Char] -> a
error [Char]
"decreaseStart: difference too big") body
b
            ((time -> time) -> T time body -> T time body
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime (time -> time -> time
forall a. Num a => a -> a -> a
subtract time
dif) T time body
xs))


{- |

Here are some functions for discretizing the time information.
When converting the precise relative event times
to the integer relative event times
we have to prevent accumulation of rounding errors.
We avoid this problem with a stateful conversion
which remembers each rounding error we make.
This rounding error is used to correct the next rounding.
Given the relative time and duration of a note
the function @discretizeEventM@ creates a @State@
which computes the rounded relative time.
It is corrected by previous rounding errors.

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

-}

discretize :: (RealFrac time, Integral i) =>
   T time body -> T i body
discretize :: forall time i body.
(RealFrac time, Integral i) =>
T time body -> T i body
discretize = (time -> i) -> T time body -> T i body
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime time -> i
forall b. Integral b => time -> b
forall a b. (RealFrac a, Integral b) => a -> b
round

resample :: (RealFrac time, Integral i) =>
   time -> T time body -> T i body
resample :: forall time i body.
(RealFrac time, Integral i) =>
time -> T time body -> T i body
resample time
rate = T time body -> T i body
forall time i body.
(RealFrac time, 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
*)