{- |
Copyright : (c) Henning Thielemann 2007-2010
Maintainer : haskell@henning-thielemann.de
Stability : stable
Portability : Haskell 98
Event lists starting with a time difference and ending with a body.
The time is stored in differences between the events.
Thus there is no increase of time information for long,
or even infinite, streams of events.
Further on, the time difference is stored
in the latter of two neighbouring events.
This is necessary for real-time computing
where it is not known whether and when the next event happens.
-}moduleData.EventList.Relative.TimeBody(T,empty,singleton,null,viewL,viewR,switchL,switchR,cons,snoc,fromPairList,toPairList,getTimes,getBodies,duration,mapBody,mapTime,zipWithBody,zipWithTime,concatMapMonoid,traverse,traverse_,traverseBody,traverseTime,mapM,mapM_,mapBodyM,mapTimeM,foldr,foldrPair,merge,mergeBy,insert,insertBy,moveForward,decreaseStart,delay,filter,partition,partitionMaybe,slice,span,mapMaybe,catMaybes,normalize,isNormalized,collectCoincident,flatten,mapCoincident,append,concat,cycle,discretize,resample,toAbsoluteEventList,fromAbsoluteEventList,)whereimportData.EventList.Relative.TimeBodyPrivateimportqualifiedData.EventList.Relative.BodyBodyPrivateasBodyBodyPrivimportqualifiedData.EventList.Absolute.TimeBodyPrivateasAbsoluteEventPrivimportqualifiedData.EventList.Absolute.TimeBodyasAbsoluteEventListimportqualifiedData.AlternatingList.List.DisparateasDispimportqualifiedData.AlternatingList.List.UniformasUniformimportqualifiedData.AlternatingList.List.MixedasMixedimportqualifiedData.ListasListimportqualifiedData.EventList.UtilityasUtilityimportControl.Applicative(Applicative,WrappedMonad(WrapMonad,unwrapMonad),)importData.Monoid(Monoid,)importqualifiedNumeric.NonNegative.ClassasNonNegimportData.Tuple.HT(mapFst,mapSnd,mapPair,)importData.Maybe.HT(toMaybe,)importData.List.HT(isAscending,)importData.EventList.Utility(floorDiff,beforeBy,)importControl.Monad.Trans.State(evalState,modify,get,put,)importPreludehiding(mapM,mapM_,null,foldr,filter,concat,cycle,span,)empty::Ttimebodyempty=ConsDisp.emptynull::Ttimebody->Boolnull=Disp.null.deconssingleton::time->body->Ttimebodysingletontimebody=Cons$Disp.singletontimebodycons::time->body->Ttimebody->Ttimebodyconstimebody=lift(Disp.constimebody)snoc::Ttimebody->time->body->Ttimebodysnocxstimebody=Cons$(Disp.snoc$~*xs)timebodyviewL::Ttimebody->Maybe((time,body),Ttimebody)viewL=fmap(mapSndCons).Disp.viewL.deconsviewR::Ttimebody->Maybe(Ttimebody,(time,body))viewR=fmap(mapFstCons).Disp.viewR.decons{-# INLINE switchL #-}switchL::c->((time,body)->Ttimebody->c)->Ttimebody->cswitchLfg=Disp.switchLf(\tb->g(t,b).Cons).decons{-# INLINE switchR #-}switchR::c->(Ttimebody->(time,body)->c)->Ttimebody->cswitchRfg=Disp.switchRf(\xstb->g(Consxs)(t,b)).deconsfromPairList::[(a,b)]->TabfromPairList=Cons.Disp.fromPairListtoPairList::Tab->[(a,b)]toPairList=Disp.toPairList.deconsgetBodies::Ttimebody->[body]getBodies=Disp.getSeconds.deconsgetTimes::Ttimebody->[time]getTimes=Disp.getFirsts.deconsduration::Numtime=>Ttimebody->timeduration=sum.getTimesmapBody::(body0->body1)->Ttimebody0->Ttimebody1mapBodyf=lift(Disp.mapSecondf)mapTime::(time0->time1)->Ttime0body->Ttime1bodymapTimef=lift(Disp.mapFirstf)zipWithBody::(body0->body1->body2)->[body0]->Ttimebody1->Ttimebody2zipWithBodyf=lift.Disp.zipWithSecondfzipWithTime::(time0->time1->time2)->[time0]->Ttime1body->Ttime2bodyzipWithTimef=lift.Disp.zipWithFirstfconcatMapMonoid::Monoidm=>(time->m)->(body->m)->Ttimebody->mconcatMapMonoidfg=Disp.concatMapMonoidfg.deconstraverse::Applicativem=>(time0->mtime1)->(body0->mbody1)->Ttime0body0->m(Ttime1body1)traversefg=liftA(Disp.traversefg)traverse_::Applicativem=>(time->m())->(body->m())->Ttimebody->m()traverse_fg=Disp.traverse_fg.deconstraverseBody::Applicativem=>(body0->mbody1)->Ttimebody0->m(Ttimebody1)traverseBodyf=liftA(Disp.traverseSecondf)traverseTime::Applicativem=>(time0->mtime1)->Ttime0body->m(Ttime1body)traverseTimef=liftA(Disp.traverseFirstf)mapM::Monadm=>(time0->mtime1)->(body0->mbody1)->Ttime0body0->m(Ttime1body1)mapMfg=unwrapMonad.traverse(WrapMonad.f)(WrapMonad.g)mapM_::Monadm=>(time->m())->(body->m())->Ttimebody->m()mapM_fg=unwrapMonad.traverse_(WrapMonad.f)(WrapMonad.g)mapBodyM::Monadm=>(body0->mbody1)->Ttimebody0->m(Ttimebody1)mapBodyMf=unwrapMonad.traverseBody(WrapMonad.f)mapTimeM::Monadm=>(time0->mtime1)->Ttime0body->m(Ttime1body)mapTimeMf=unwrapMonad.traverseTime(WrapMonad.f)foldr::(time->a->b)->(body->b->a)->b->Ttimebody->bfoldrfgx=Disp.foldrfgx.deconsfoldrPair::(time->body->a->a)->a->Ttimebody->afoldrPairfx=Disp.foldrPairfx.decons{- |
Keep only events that match a predicate while preserving absolute times.
-}filter::(Numtime)=>(body->Bool)->Ttimebody->Ttimebodyfilterp=mapMaybe(\b->toMaybe(pb)b)-- filter p = fst . partition pmapMaybe::(Numtime)=>(body0->Maybebody1)->Ttimebody0->Ttimebody1mapMaybef=catMaybes.mapBodyf{- |
Adds times in a left-associative fashion.
Use this if the time is a strict data type.
-}catMaybes::(Numtime)=>Ttime(Maybebody)->TtimebodycatMaybes=Cons.fst.Mixed.viewSecondR.Uniform.mapSecondsum.Uniform.catMaybesFirst.flipMixed.snocSecond(error"catMaybes: no trailing time").decons{-
The function 'partition' is somehow the inverse to 'merge'.
It is similar to 'List.partition'.
We could use the List function if the event times would be absolute,
because then the events need not to be altered on splits.
But absolute time points can't be used for infinite music
thus we take the burden of adapting the time differences
when an event is removed from the performance list and
put to the list of events of a particular instrument.
@t0@ is the time gone since the last event in the first partition,
@t1@ is the time gone since the last event in the second partition.
Note, that using 'Data.EventList.Utility.mapPair' we circumvent the following problem:
Since the recursive call to 'partition'
may end up with Bottom,
pattern matching with, say \expression{(es0,es1)},
will halt the bounding of the variables
until the most inner call to 'partition' is finished.
This never happens.
If the pair constructor is made strict,
that is we write \expression{~(es0,es1)},
then everything works.
Also avoiding pattern matching and
using 'fst' and 'snd' would help.
-}{-
Could be implemented more easily in terms of Uniform.partition
-}partition::(Numtime)=>(body->Bool)->Ttimebody->(Ttimebody,Ttimebody)partitionp=partitionRecp00partitionRec::(Numtime)=>(body->Bool)->time->time->Ttimebody->(Ttimebody,Ttimebody)partitionRecp=letrecourset0t1=switchL(empty,empty)(\(t,b)es->lett0'=t0+tt1'=t1+tinifpbthenmapFst(const0'b)(recourse0t1'es)elsemapSnd(const1'b)(recourset0'0es))inrecoursepartitionMaybe::(Numtime)=>(body0->Maybebody1)->Ttimebody0->(Ttimebody1,Ttimebody0)partitionMaybef=mapPair(catMaybes,catMaybes).foldrPair(\ta->letmb=faa1=maybe(Justa)(constNothing)mbinmapPair(constmb,consta1))(empty,empty){- |
Using a classification function
we splice the event list into lists, each containing the same class.
Absolute time stamps are preserved.
-}slice::(Eqa,Numtime)=>(body->a)->Ttimebody->[(a,Ttimebody)]slice=Utility.slice(fmap(snd.fst).viewL)partitionspan::(body->Bool)->Ttimebody->(Ttimebody,Ttimebody)spanp=mapPair(Cons,Cons).Disp.spanSecondp.decons{- |
Group events that have equal start times
(that is zero time differences).
-}collectCoincident::(NonNeg.Ctime)=>Ttimebody->Ttime[body]collectCoincident=mapTimeTail$BodyBodyPriv.lift$Uniform.filterFirst(0<){- |
Reverse to collectCoincident:
Turn each @body@ into a separate event.
> xs == flatten (collectCoincident xs)
-}flatten::(NonNeg.Ctime)=>Ttime[body]->Ttimebodyflatten=Cons.Mixed.switchFirstLDisp.empty(\time->unlift(delaytime).fst.Mixed.viewSecondR.Uniform.foldr(Mixed.appendUniformUniform.Uniform.fromSecondList0)Mixed.consSecondDisp.empty.Uniform.mapSecondsum.Uniform.filterSecond(not.List.null)).decons{- |
Apply a function to the lists of coincident events.
-}mapCoincident::(NonNeg.Ctime)=>([a]->[b])->Ttimea->TtimebmapCoincidentf=flatten.mapBodyf.collectCoincident{- |
'List.sort' sorts a list of coinciding events,
that is all events but the first one have time difference 0.
'normalize' sorts all coinciding events in a list
thus yielding a canonical representation of a time ordered list.
-}normalize::(NonNeg.Ctime,Ordbody)=>Ttimebody->Ttimebodynormalize=mapCoincidentList.sortisNormalized::(NonNeg.Ctime,Ordbody)=>Ttimebody->BoolisNormalized=allisAscending.getBodies.collectCoincident{- |
This function merges the events of two lists into a new event list.
Note that 'merge' compares entire events rather than just start times.
This is to ensure that it is commutative,
one of the properties we test for.
-}merge::(NonNeg.Ctime,Ordbody)=>Ttimebody->Ttimebody->Ttimebodymerge=mergeBy(<){- |
'mergeBy' is like 'merge' but does not simply use the methods of the 'Ord' class
but allows a custom comparison function.
-}{-
Could be implemented using 'splitAt' and 'insert'.
-}mergeBy::(NonNeg.Ctime)=>(body->body->Bool)->Ttimebody->Ttimebody->TtimebodymergeBybeforexs0ys0=case(viewLxs0,viewLys0)of(Nothing,_)->ys0(_,Nothing)->xs0(Just(x@(xt,xb),xs),Just(y@(yt,yb),ys))->ifbeforeBybeforexythenuncurryconsx$mergeBybeforexs$cons(yt-xt)ybyselseuncurryconsy$mergeBybeforeys$cons(xt-yt)xbxs{- |
'insert' inserts an event into an event list at the given time.
-}insert::(NonNeg.Ctime,Ordbody)=>time->body->Ttimebody->Ttimebodyinsertt0me0=switchL(singletont0me0)(\mev1@(t1,me1)mevs->letmev0=(t0,me0)inifmev0<mev1thenuncurryconsmev0$cons(t1-t0)me1mevselseuncurryconsmev1$insert(t0-t1)me0mevs)insertBy::(NonNeg.Ctime)=>(body->body->Bool)->time->body->Ttimebody->TtimebodyinsertBybefore=letrecourset0me0=switchL(singletont0me0)(\mev1@(t1,me1)mevs->ifbeforeBybefore(t0,me0)mev1thenconst0me0$cons(t1-t0)me1mevselseconst1me1$recourse(t0-t1)me0mevs)inrecourse{- |
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::(NonNeg.Ctime)=>Ttime(time,body)->TtimebodymoveForward=fromAbsoluteEventList.AbsoluteEventList.moveForward.toAbsoluteEventList0{-
Like 'moveForward' but restricts the look-ahead time.
For @moveForwardRestricted maxTimeDiff xs@
all time differences (aka the moveForward offsets) in @xs@
must be at most @maxTimeDiff@.
With this restriction the function is lazy enough
for handling infinite event lists.
However the larger @maxTimeDiff@ the more memory and time is consumed.
-}{- for implementation notes see TimeTime
This implementation requires TimeTime.duration, TimeMixed.appendBodyEnd, TimeMixed.splitAtTime
and thus we would need a lot of movement of functions between modules
moveForwardRestricted :: (NonNeg.C time) =>
time -> T time (time, body) -> T time body
moveForwardRestricted maxTime xs =
let (prefix,suffix) = splitAtTime maxTime xs
prefixDur = duration prefix
getChunk t =
do (toEmit,toKeep) <- gets (splitAtTime t)
put toKeep
return (pad t toEmit)
insertEvent (t,b) =
insertBy (\ _ _ -> False) (maxTime - t) b
in evalState
(foldr
(\t m -> liftM2 append (getChunk t) m)
(\b m -> modify (insertEvent b) >> m)
(gets (pad prefixDur)) suffix)
(moveForward (seq prefixDur prefix))
-}append::Ttimebody->Ttimebody->Ttimebodyappendxs=lift(Disp.append$~*xs)concat::[Ttimebody]->Ttimebodyconcat=Cons.Disp.concat.mapdeconscycle::Ttimebody->Ttimebodycycle=liftDisp.cycledecreaseStart::(NonNeg.Ctime)=>time->Ttimebody->TtimebodydecreaseStartdif=mapTimeHead(subtractdif)delay::(NonNeg.Ctime)=>time->Ttimebody->Ttimebodydelaydif=mapTimeHead(dif+){- |
We provide 'discretize' and 'resample' for discretizing the time information.
When converting the precise relative event times
to the integer relative event times
we have to prevent accumulation of rounding errors.
We avoid this problem with a stateful conversion
which remembers each rounding error we make.
This rounding error is used to correct the next rounding.
Given the relative time and duration of an event
the function 'floorDiff' creates a 'Control.Monad.State.State'
which computes the rounded relative time.
It is corrected by previous rounding errors.
The resulting event list may have differing time differences
which were equal before discretization,
but the overall timing is uniformly close to the original.
We use 'floorDiff' rather than 'Utility.roundDiff'
in order to compute exclusively with non-negative numbers.
-}discretize::(NonNeg.Ctime,RealFractime,NonNeg.Ci,Integrali)=>Ttimebody->Tibodydiscretize=flipevalState0.5.mapTimeMfloorDiffresample::(NonNeg.Ctime,RealFractime,NonNeg.Ci,Integrali)=>time->Ttimebody->Tibodyresamplerate=discretize.mapTime(rate*){- |
We tried hard to compute everything with respect to relative times.
However sometimes we need absolute time values.
-}toAbsoluteEventList::(Numtime)=>time->Ttimebody->AbsoluteEventList.TtimebodytoAbsoluteEventListstart=AbsoluteEventPriv.Cons.decons.flipevalStatestart.mapTimeM(\dur->modify(dur+)>>get)fromAbsoluteEventList::(Numtime)=>AbsoluteEventList.Ttimebody->TtimebodyfromAbsoluteEventList=flipevalState0.mapTimeM(\time->dolastTime<-get;puttime;return(time-lastTime)).Cons.AbsoluteEventPriv.decons