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

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 = forall time body. T time body -> T time body
Cons forall a b. (a -> b) -> a -> b
$ forall a b. T a b
Disp.empty

null :: T time body -> Bool
null :: forall time body. T time body -> Bool
null = forall a b. T a b -> Bool
Disp.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall time body. T time body -> T time body
Cons forall a b. (a -> b) -> a -> b
$ 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 = forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift (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 =
   forall time body. T time body -> T time body
Cons forall a b. (a -> b) -> a -> b
$ (forall a b. T a b -> a -> b -> T a b
Disp.snoc 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 = 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 time body -> T time body
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> Maybe ((a, b), T a b)
Disp.viewL forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 time body -> 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))
Disp.viewR forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall time body. T time body -> T time body
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. T a b -> [(a, b)]
Disp.toPairList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> T time body
decons

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

getTimes :: T time body -> [time]
getTimes :: forall time body. T time body -> [time]
getTimes = forall a b. T a b -> [a]
Disp.getFirsts forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
   forall m time body.
Monoid m =>
(time -> m) -> (body -> m) -> T time body -> m
Disp.concatMapMonoid time -> m
f body -> m
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) time0 body0 time1 body1.
Applicative m =>
(T time0 body0 -> m (T time1 body1))
-> 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)
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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) time0 body0 time1 body1.
Applicative m =>
(T time0 body0 -> m (T time1 body1))
-> 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)
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 = forall (m :: * -> *) time0 body0 time1 body1.
Applicative m =>
(T time0 body0 -> m (T time1 body1))
-> 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)
Disp.traverseFirst time0 -> m time1
f)


mapM :: Monad m =>
   (time0 -> m time1) -> (body0 -> m body1) ->
   T time0 body0 -> m (T time1 body1)
mapM :: forall (m :: * -> *) time0 time1 body0 body1.
Monad m =>
(time0 -> m time1)
-> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
mapM time0 -> m time1
f body0 -> m body1
g =
   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)


{- |
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 =
   forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift
      (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 forall a. HasCallStack => [Char] -> a
error [Char]
"times out of order")
         (forall a. Ord a => [a] -> [Bool]
isAscendingLazy (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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b c. (a -> b -> c -> c) -> c -> T a b -> c
Disp.foldrPair time -> body -> a -> a
f a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall time body0 body1.
Num 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 :: (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 = forall time body. Num 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

catMaybes :: (Num time) =>
   T time (Maybe body) -> T time body
catMaybes :: forall time body. Num time => T time (Maybe body) -> T time body
catMaybes =
   forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. time -> body -> T time body -> T time body
cons) 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 =
   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 forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst else forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd) (forall time body. time -> body -> T time body -> T time body
cons time
t body
b))
      (forall time body. T time body
empty, 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 =
   forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair
      (\ time
t body0
b ->
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall time body. time -> body -> T time body -> T time body
cons time
t body0
b)) (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. time -> body -> T time body -> T time body
cons time
t) (body0 -> Maybe body1
p body0
b))
      (forall time body. T time body
empty, 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 = 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) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> Maybe ((time, body), T time body)
viewL) 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 =
   forall time body. T time body -> T time body
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall c a b. c -> (a -> T a b -> c) -> T a b -> c
Mixed.switchFirstL
      forall a b. T a b
Disp.empty
      (\ time
t0 ->
         forall a b. a -> T a b -> T a b
Mixed.consFirst time
t0 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall a b. T (Maybe a) b -> T a [b]
Uniform.catMaybesFirst 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 (forall a. a -> Maybe a
Just time
t0) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall (m :: * -> *) a0 a1 b.
Applicative m =>
(a0 -> m a1) -> T a0 b -> m (T a1 b)
Uniform.traverseFirst (\Maybe time
time -> forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \ Maybe time
oldTime ->
            (forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard (Maybe time
time forall a. Eq a => a -> a -> Bool
/= Maybe time
oldTime) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe time
time, Maybe time
time)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
Uniform.mapFirst forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   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 =
   forall time body. T time body -> T time body
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair
      (\time
t0 body
b0 T time [body]
xs ->
          forall a b. a -> T a b -> T a b
Mixed.consFirst time
t0 forall a b. (a -> b) -> a -> b
$
          forall c a b. c -> (a -> b -> T a b -> c) -> T a b -> c
Disp.switchL
             (forall b a. b -> T a b
Uniform.singleton [body
b0])
             (\time
t1 [body]
bs T time [body]
ys ->
                 if time
t0 forall a. Eq a => a -> a -> Bool
== time
t1
                   then forall b a. b -> T a b -> T a b
Mixed.consSecond (body
b0forall a. a -> [a] -> [a]
:[body]
bs) T time [body]
ys
                   else forall b a. b -> T a b -> T a b
Mixed.consSecond [body
b0] T time [body]
xs)
             T time [body]
xs)
      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 =
   forall time body. T time body -> T time body
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair
      (\time
t0 body
b0 T time [body]
xs ->
          forall c a b. c -> (a -> b -> T a b -> c) -> T a b -> c
Disp.switchL
             (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 forall a. Eq a => a -> a -> Bool
== time
t1
                   then forall a b. a -> b -> T a b -> T a b
Disp.cons time
t0 (body
b0forall a. a -> [a] -> [a]
:[body]
bs) T time [body]
ys
                   else 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)
      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 =
   forall time body a.
(time -> body -> a -> a) -> a -> T time body -> a
foldrPair
      (\time
t [body]
bs T time body
xs -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (forall time body. time -> body -> T time body -> T time body
cons time
t) T time body
xs [body]
bs)
      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 = forall time body. Ord 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. 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 = forall time a b. Ord time => ([a] -> [b]) -> T time a -> T time b
mapCoincident 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 =
   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. 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 = forall time body.
Ord time =>
(body -> body -> Bool) -> T time body -> T time body -> T time body
mergeBy 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 (forall time body. T time body -> Maybe ((time, body), T time body)
viewL T time body
xs0, 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 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 forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall time body. time -> body -> T time body -> T time body
cons (time, body)
x 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 forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall time body. time -> body -> T time body -> T time body
cons (time, body)
y 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  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 = forall time body.
Ord time =>
(body -> body -> Bool)
-> time -> body -> T time body -> T time body
insertBy 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  forall c time body.
c -> ((time, body) -> T time body -> c) -> T time body -> c
switchL
          (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall time body. time -> body -> T time body
singleton (time, body)
mev0)
          (\(time, body)
mev1 T time body
mevs ->
              if 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 forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall time body. time -> body -> T time body -> T time body
cons (time, body)
mev0 forall a b. (a -> b) -> a -> b
$ T time body
mevs1
                else forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall time body. time -> body -> T time body -> T time body
cons (time, body)
mev1 forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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 =
   forall a b. [(a, b)] -> T a b
fromPairList forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
compose2 forall a. Ord a => a -> a -> Ordering
compare forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. (a -> b) -> [a] -> [b]
List.map (\ ~(time
time,(time
timeDiff,body
body)) -> (time
time forall a. Num a => a -> a -> a
- time
timeDiff, body
body)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   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 =
   forall c time body.
c -> ((time, body) -> T time body -> c) -> T time body -> c
switchL
      forall time body. T time body
empty
      (\(time
t, body
b) T time body
xs ->
         forall time body. time -> body -> T time body -> T time body
cons
            (if time
tforall a. Ord a => a -> a -> Bool
>=time
dif
               then time
tforall a. Num a => a -> a -> a
-time
dif
               else forall a. HasCallStack => [Char] -> a
error [Char]
"decreaseStart: difference too big") body
b
            (forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime (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 = forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime 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 = forall time i body.
(RealFrac time, 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
*)