packages feed

event-list 0.0.6 → 0.0.7

raw patch · 11 files changed

+515/−82 lines, 11 filesdep ~QuickCheckdep ~mtldep ~non-negativePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, mtl, non-negative

API changes (from Hackage documentation)

+ Data.EventList.Absolute.TimeBody: moveForward :: (Ord time, Num time) => T time (time, body) -> T time body
+ Data.EventList.Absolute.TimeTime: moveForward :: (Ord time, Num time) => T time (time, body) -> T time body
+ Data.EventList.Relative.BodyTime: cons :: body -> time -> T time body -> T time body
+ Data.EventList.Relative.BodyTime: fromPairList :: [(body, time)] -> T time body
+ Data.EventList.Relative.BodyTime: snoc :: T time body -> body -> time -> T time body
+ Data.EventList.Relative.BodyTime: toPairList :: T time body -> [(body, time)]
+ Data.EventList.Relative.BodyTime: viewL :: T time body -> Maybe ((body, time), T time body)
+ Data.EventList.Relative.BodyTime: viewR :: T time body -> Maybe (T time body, (body, time))
+ Data.EventList.Relative.TimeBody: moveForward :: (C time) => T time (time, body) -> T time body
+ Data.EventList.Relative.TimeTime: arrange :: (Ord body, C time) => T time (T time body) -> T time body
+ Data.EventList.Relative.TimeTime: arrangeBy :: (C time) => (body -> body -> Bool) -> T time (T time body) -> T time body
+ Data.EventList.Relative.TimeTime: moveBackward :: (C time) => T time (time, body) -> T time body
+ Data.EventList.Relative.TimeTime: moveForward :: (C time) => T time (time, body) -> T time body
+ Data.EventList.Relative.TimeTime: moveForwardRestricted :: (Ord body, C time) => time -> T time (time, body) -> T time body
+ Data.EventList.Relative.TimeTime: moveForwardRestrictedBy :: (C time) => (body -> body -> Bool) -> time -> T time (time, body) -> T time body
+ Data.EventList.Relative.TimeTime: moveForwardRestrictedByQueue :: (C time) => (body -> body -> Bool) -> time -> T time (time, body) -> T time body
+ Data.EventList.Relative.TimeTime: moveForwardRestrictedByStrict :: (C time) => (body -> body -> Bool) -> time -> T time (time, body) -> T time body
+ Data.EventList.Relative.TimeTime: pad :: (C time) => time -> T time body -> T time body

Files

event-list.cabal view
@@ -1,5 +1,5 @@ Name:             event-list-Version:          0.0.6+Version:          0.0.7 License:          GPL License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -23,12 +23,18 @@ Flag splitBase   description: Choose the new smaller, split-up base package. +Flag buildTests+  description: Build test executables+  default:     False+ Library+  Build-Depends: non-negative>=0.0 && <0.1+  Build-Depends: mtl >=1 && <2, QuickCheck >=1 && <2   If flag(splitBase)-    Build-Depends: base >= 2, non-negative==0.0.1, mtl, QuickCheck, random+    Build-Depends: base >= 2, random     -- random is needed for the Test   Else-    Build-Depends: base >= 1.0 && < 2, non-negative==0.0.1, mtl, QuickCheck+    Build-Depends: base >= 1.0 && < 2     -- From the Monad Template Library we only need the State monad.     -- If your compiler does not support functional dependencies,     -- it would be easy to replace that by mapAccumL.@@ -60,6 +66,9 @@     Data.AlternatingList.List.Mixed  Executable       test+  If !flag(buildTests)+    Buildable:         False+   If flag(splitBase)     Hs-source-dirs:   src, src-2   Else
− src-1/Test/Instances.hs
@@ -1,17 +0,0 @@-module Test.Instances where--import Test.QuickCheck (Arbitrary(..))--import Control.Monad (liftM)-import Data.Char (chr)---instance Arbitrary Char where-   arbitrary = liftM (chr . (32+) . flip mod 96) arbitrary-   coarbitrary = undefined--instance Arbitrary a => Arbitrary (Maybe a) where-   arbitrary =-      arbitrary >>=-         \b -> if b then fmap Just arbitrary else return Nothing-   coarbitrary = undefined
src/Data/AlternatingList/List/Disparate.hs view
@@ -53,7 +53,7 @@ format :: (Show a, Show b) =>    String -> String -> Int -> T a b -> ShowS format first second p xs =-   showParen (p>5) $+   showParen (p>=5) $    flip (foldr       (\a -> showsPrec 5 a . showString first)       (\b -> showsPrec 5 b . showString second))
src/Data/AlternatingList/List/Uniform.hs view
@@ -62,7 +62,7 @@ format :: (Show a, Show b) =>    String -> String -> Int -> T a b -> ShowS format first second p xs =-   showParen (p>5) $+   showParen (p>=5) $    flip (foldr       (\a -> showsPrec 5 a . showString first)       (\b -> showsPrec 5 b . showString second))
src/Data/EventList/Absolute/TimeBody.hs view
@@ -14,6 +14,7 @@     mapBody, mapTime,     mapM, mapM_, mapBodyM, mapTimeM,     merge, mergeBy, insert, insertBy,+    moveForward,     decreaseStart, delay, filter, partition, slice, foldr, foldrPair,     mapMaybe, catMaybes,     normalize, isNormalized,@@ -325,6 +326,21 @@                 then uncurry cons mev0 $ mevs1                 else uncurry cons mev1 $ uncurry (insertBy before) mev0 mevs) $        viewL 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 =+   fromPairList .+   List.sortBy (Utility.composeDouble compare fst) .+   List.map (\ ~(time,(timeDiff,body)) -> (time - timeDiff, body)) .+   toPairList+   append :: (Ord time, Num time) =>
src/Data/EventList/Absolute/TimeTime.hs view
@@ -15,6 +15,7 @@     mapM, mapM_, mapBodyM, mapTimeM,     getTimes, getBodies, duration,     merge, mergeBy, insert, insertBy,+    moveForward,     decreaseStart, delay, filter, partition, slice, foldr,     mapMaybe, catMaybes,     normalize, isNormalized,@@ -225,6 +226,18 @@                     then uncurry cons mev0 $ mevs1                     else uncurry cons mev1 $ uncurry (insertBy before) mev0 mevs)           mxs++++{- |+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 =+   mapTimeInit TimeBodyList.moveForward   
src/Data/EventList/Relative/BodyTime.hs view
@@ -10,13 +10,18 @@  -} module Data.EventList.Relative.BodyTime-   (T, mapM, empty, ) where+   (T, mapM, empty,+    fromPairList, toPairList,+    cons, snoc, viewL, viewR,+   ) where  import Data.EventList.Relative.BodyTimePrivate  import qualified Data.AlternatingList.List.Disparate as Disp -- import qualified Data.AlternatingList.List.Uniform as Uniform +import Data.EventList.Utility (mapFst, mapSnd, )+ import Prelude hiding    (mapM) @@ -28,5 +33,27 @@    liftM (Disp.mapM bodyAction timeAction)  +fromPairList :: [(body, time)] -> T time body+fromPairList = Cons . Disp.fromPairList++toPairList :: T time body -> [(body, time)]+toPairList = Disp.toPairList . decons++ empty :: T time body empty = Cons Disp.empty+++cons :: body -> time -> T time body -> T time body+cons body time = lift (Disp.cons body time)++snoc :: T time body -> body -> time -> T time body+snoc xs body time =+   Cons $ (Disp.snoc $*~ xs) body time+++viewL :: T time body -> Maybe ((body, time), T time body)+viewL = fmap (mapSnd Cons) . Disp.viewL . decons++viewR :: T time body -> Maybe (T time body, (body, time))+viewR = fmap (mapFst Cons) . Disp.viewR . decons
src/Data/EventList/Relative/TimeBody.hs view
@@ -28,6 +28,7 @@     mapM, mapM_, mapBodyM, mapTimeM,     foldr, foldrPair,     merge, mergeBy, insert, insertBy,+    moveForward,     decreaseStart, delay, filter, partition, slice, span,     mapMaybe, catMaybes,     normalize, isNormalized,@@ -139,7 +140,29 @@   {- |+Keep only events that match a predicate while preserving absolute times.+-}+filter :: (Num time) =>+   (body -> Bool) -> T time body -> T time body+filter p = mapMaybe (\b -> toMaybe (p b) b)+-- filter p = fst . partition p +mapMaybe :: (Num time) =>+   (body0 -> Maybe body1) ->+   T time body0 -> T time body1+mapMaybe f = catMaybes . mapBody f++catMaybes :: (Num time) =>+   T time (Maybe body) -> T time body+catMaybes =+   Cons .+   fst . Mixed.viewSecondR .+   Uniform.mapSecond sum .+   Uniform.catMaybesFirst .+   flip Mixed.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,@@ -166,26 +189,6 @@  -} -filter :: (Num time) =>-   (body -> Bool) -> T time body -> T time body-filter p = mapMaybe (\b -> toMaybe (p b) b)--- filter p = fst . partition p--mapMaybe :: (Num time) =>-   (body0 -> Maybe body1) ->-   T time body0 -> T time body1-mapMaybe f = catMaybes . mapBody f--catMaybes :: (Num time) =>-   T time (Maybe body) -> T time body-catMaybes =-   Cons .-   fst . Mixed.viewSecondR .-   Uniform.mapSecond sum .-   Uniform.catMaybesFirst .-   flip Mixed.snocSecond (error "catMaybes: no trailing time") .-   decons- {- Could be implemented more easily in terms of Uniform.partition -}@@ -210,8 +213,9 @@    in  recurse  {- |-Since we need it later for MIDI generation,-we will also define a slicing into equivalence classes of events.+Using a classification function+we splice the event list into lists, each containing the same class.+Absolute time stamps are preserved. -} slice :: (Eq a, Num time) =>    (body -> a) -> T time body -> [(a, T time body)]@@ -223,15 +227,19 @@   {- |-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.+Group events that have equal start times+(that is zero time differences). -} collectCoincident :: (NonNeg.C time) => T time body -> T time [body] collectCoincident =    mapTimeTail $ BodyBodyPriv.lift $ Uniform.filterFirst (0<) +{- |+Reverse to collectCoincident:+Turn each @body@ into a separate event.++>   xs  ==  flatten (collectCoincident xs)+-} flatten :: (NonNeg.C time) => T time [body] -> T time body flatten =    Cons .@@ -252,20 +260,16 @@ {- | Apply a function to the lists of coincident events. -}- mapCoincident :: (NonNeg.C time) =>    ([a] -> [b]) -> T time a -> T time b mapCoincident f = flatten . mapBody f . 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.C time, Ord body) => T time body -> T time body normalize = mapCoincident List.sort @@ -277,28 +281,22 @@   {- |-The first important function is 'merge'-which merges the events of two lists into a new time order list.+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.C time, Ord body) =>    T time body -> T time body -> T time body merge = mergeBy (<)  {- |-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.+'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 as 'splitAt' and 'insert'.+Could be implemented using 'splitAt' and 'insert'. -} mergeBy :: (NonNeg.C time) =>    (body -> body -> Bool) ->@@ -312,15 +310,9 @@            then uncurry cons x $ mergeBy before xs $ cons (yt-xt) yb ys            else uncurry cons y $ mergeBy before ys $ cons (xt-yt) xb xs - {- |-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' inserts an event into an event list at the given time. -}- insert :: (NonNeg.C time, Ord body) =>    time -> body -> T time body -> T time body insert t0 me0 =@@ -346,6 +338,54 @@             then cons t0 me0 $ cons   (t1-t0) me1 mevs             else cons t1 me1 $ insert (t0-t1) me0 mevs)     . viewL+++{- |+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.C time) =>+   T time (time, body) -> T time body+moveForward =+   fromAbsoluteEventList .+   AbsoluteEventList.moveForward .+   toAbsoluteEventList 0+++{-+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 :: T time body -> T time body -> T time body
src/Data/EventList/Relative/TimeTime.hs view
@@ -12,7 +12,10 @@     mapBody, mapTime,     mapM, mapM_, mapBodyM, mapTimeM,     getTimes, getBodies, duration,-    merge, mergeBy, insert,+    merge, mergeBy, insert, {- insertBy, -} pad,+    moveForward, moveForwardRestricted, moveBackward, arrange, arrangeBy,+    moveForwardRestrictedBy,+    moveForwardRestrictedByQueue, moveForwardRestrictedByStrict,     decreaseStart, delay, filter, partition, slice, foldr,     pause, isPause, cons, snoc, viewL, viewR,     mapMaybe, catMaybes,@@ -43,7 +46,7 @@ import qualified Numeric.NonNegative.Class as NonNeg import Data.EventList.Utility (floorDiff, mapPair, mapFst, mapSnd, toMaybe, isMonotonic) import qualified Control.Monad.State as Monad-import Control.Monad.State (evalState, modify, get, put)+import Control.Monad.State (evalState, modify, get, gets, put, liftM2, )  import Prelude hiding    (null, foldr, map, filter, concat, cycle, sequence, sequence_, mapM, mapM_)@@ -218,6 +221,136 @@                       else consBody me1 (recurseTime (t-t1) xs))             . viewBodyL    in   recurseTime 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 time = mergeBy (\ _ _ -> False) (pause 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 :: (NonNeg.C time) =>+   T time (time, body) -> T time body+moveForward =+   fromAbsoluteEventList .+   AbsoluteEventList.moveForward .+   toAbsoluteEventList 0++moveBackward :: (NonNeg.C time) =>+   T time (time, body) -> T time body+moveBackward =+   catMaybes .+   foldr+      (\t -> cons t Nothing)+      (\(t,b) -> insertBy (ltMaybe (\_ _ -> True)) t (Just b))+      (pause 0)++{- |+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 maxTime =+   decreaseStart maxTime .+   moveBackward .+   mapBody (mapFst (maxTime-)) .+   pad maxTime+{-+   moveForwardRestrictedBy+      (\_ _ -> True)+      -- (<)+-}++ltMaybe :: (body -> body -> Bool) -> (Maybe body -> Maybe body -> Bool)+ltMaybe cmp mx my =+   case (mx,my) of+      (Nothing, _) -> True+      (_, Nothing) -> False+      (Just x, Just y) -> cmp x y+++-- | currently only for testing+moveForwardRestrictedBy :: (NonNeg.C time) =>+   (body -> body -> Bool) ->+   time -> T time (time, body) -> T time body+moveForwardRestrictedBy cmp maxTime =+   decreaseStart maxTime .+   catMaybes .+   foldr+      (\t -> cons t Nothing)+      (\(t,b) -> insertBy (ltMaybe cmp) (maxTime-t) (Just b))+      (pause maxTime)++-- | currently only for testing+moveForwardRestrictedByStrict :: (NonNeg.C time) =>+   (body -> body -> Bool) ->+   time -> T time (time, body) -> T time body+moveForwardRestrictedByStrict cmp maxTime =+   decreaseStart maxTime .+   foldr+      delay+      (\(t,b) -> insertBy cmp (maxTime-t) b)+      (pause maxTime)++-- | currently only for testing+moveForwardRestrictedByQueue :: (NonNeg.C time) =>+   (body -> body -> Bool) ->+   time -> T time (time, body) -> T time body+moveForwardRestrictedByQueue cmp maxTime xs =+   let (prefix,suffix) = splitAtTime maxTime xs+       prefixDur = duration prefix {- maxTime would work in most cases, too -}+       getChunk t =+          do (toEmit,toKeep) <- gets (splitAtTime t)+             put toKeep+             return (pad t toEmit)+       insertEvent (t,b) =+          insertBy cmp (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))+             {- 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 = arrangeBy (\_ _ -> False)++arrangeBy :: (NonNeg.C time) =>+   (body -> body -> Bool) ->+   T time (T time body) -> T time body+arrangeBy cmp =+   catMaybes .+   foldr+      (\t -> cons t Nothing)+      (\xs -> mergeBy (ltMaybe cmp) (mapBody Just xs))+      (pause 0)+  append :: (NonNeg.C time) =>    T time body -> T time body -> T time body
src/Test/Data/EventList/Relative/BodyEnd.hs view
@@ -25,9 +25,9 @@ import Numeric.NonNegative.Class ((-|)) import Data.EventList.Relative.TimeBody (isNormalized) -import Data.EventList.Utility (mapPair)+import Data.EventList.Utility (mapPair, mapFst, ) import System.Random (Random, randomR, mkStdGen)-import Control.Monad.State (State(State), evalState)+import Control.Monad.State (State(State), evalState, gets, modify, ) import Control.Monad (liftM2) import Data.Maybe (isJust) import qualified Data.List as List@@ -514,6 +514,63 @@   +moveForwardIdentity :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time body -> Bool+moveForwardIdentity evs =+   evs ==+   TimeBodyList.moveForward (TimeBodyList.mapBody ((,) 0) evs)++moveForwardAdditive :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time ((time,time),body) -> Bool+moveForwardAdditive evs =+   TimeBodyList.normalize (moveForwardLimited (moveForwardLimited+      (TimeBodyList.mapBody (\((t0,t1),b) -> (t0,(t1,b))) evs))) ==+   TimeBodyList.normalize (moveForwardLimited+      (TimeBodyList.mapBody (mapFst (uncurry (+))) evs))++moveForwardCommutative :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time ((time,time),body) -> Bool+moveForwardCommutative evs =+   TimeBodyList.normalize (moveForwardLimited (moveForwardLimited+      (TimeBodyList.mapBody (\((t0,t1),b) -> (t0,(t1,b))) evs))) ==+   TimeBodyList.normalize (moveForwardLimited (moveForwardLimited+      (TimeBodyList.mapBody (\((t0,t1),b) -> (t1,(t0,b))) evs)))++{-+moveForwardRestricted :: (NonNeg.C time, Ord body) =>+   time -> TimeBodyList.T time (time,body) -> Bool+moveForwardRestricted maxTime evs0 =+   let evs =+          TimeBodyList.mapBody (mapFst (min maxTime)) $+          restrictMoveTimes (TimeBodyList.normalize evs0)+   in  TimeBodyList.moveForward evs  ==+       TimeBodyList.moveForwardRestricted maxTime evs++moveForwardRestrictedInfinity :: (NonNeg.C time, Eq body) =>+   time -> NonEmptyList time (time,body) -> Bool+moveForwardRestrictedInfinity maxTime =+   checkInfinite .+   TimeBodyList.moveForwardRestricted maxTime .+   TimeBodyList.mapBody (mapFst (min maxTime)) .+   restrictMoveTimes .+   makeUncollapsedInfiniteEventList+-}+++moveForwardLimited :: (NonNeg.C time) =>+   TimeBodyList.T time (time,body) -> TimeBodyList.T time body+moveForwardLimited = TimeBodyList.moveForward . restrictMoveTimes++restrictMoveTimes :: (NonNeg.C time) =>+   TimeBodyList.T time (time,body) -> TimeBodyList.T time (time,body)+restrictMoveTimes =+   flip evalState 0 .+   TimeBodyList.mapM+      (\t -> modify (t+) >> return t)+      (\(t,b) -> gets (\tm -> (min t tm, b)))+++ spanSatisfy :: (NonNeg.C time, Eq body) =>    (body -> Bool) -> TimeBodyList.T time body -> Bool spanSatisfy p =@@ -882,6 +939,19 @@      test (insertSplitAtTime :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :    ("insertInfinite",      test (insertInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :++   ("moveForwardIdentity",+     test (moveForwardIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("moveForwardAdditive",+     test (moveForwardAdditive :: TimeBodyList.T TimeDiff ((TimeDiff,TimeDiff),Char) -> Bool)) :+   ("moveForwardCommutative",+     test (moveForwardCommutative :: TimeBodyList.T TimeDiff ((TimeDiff,TimeDiff),Char) -> Bool)) :+{-+   ("moveForwardRestricted",+     test (moveForwardRestricted :: TimeDiff -> TimeBodyList.T TimeDiff (TimeDiff,Char) -> Bool)) :+   ("moveForwardRestrictedInfinity",+     test (moveForwardRestrictedInfinity :: TimeDiff -> NonEmptyList TimeDiff (TimeDiff,Char) -> Bool)) :+-}     ("spanSatisfy",      test (\c -> spanSatisfy (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :
src/Test/Data/EventList/Relative/TimeEnd.hs view
@@ -17,6 +17,9 @@ import qualified Data.EventList.Relative.BodyTime as BodyTimeList import qualified Data.AlternatingList.List.Mixed as Mixed +import qualified Data.EventList.Relative.TimeTimePrivate as TimeTimePriv+import qualified Data.EventList.Absolute.TimeTime as AbsTimeTimeList+ import Data.EventList.Relative.MixedTime ((/.), (./), empty)  import Data.EventList.Relative.TimeTimePrivate (($~~), lift)@@ -25,9 +28,10 @@ import Numeric.NonNegative.Class ((-|)) import Data.EventList.Relative.TimeTime (isNormalized) -import System.Random (Random, randomR, mkStdGen)-import Control.Monad.State (State(State), evalState)-import Control.Monad (liftM2)+import System.Random (Random, randomR, mkStdGen, )+import Control.Monad.State (State(State), evalState, gets, modify, )+import Control.Monad (liftM2, )+import Data.EventList.Utility (mapFst, ) import qualified Data.List as List import qualified Data.Char as Char @@ -541,8 +545,8 @@                (TimeTimeList.mapBody Left xs)                (TimeTimeList.mapBody Right ys)        dur = TimeTimeList.duration zs-       longXs = TimeTimeList.merge (TimeTimeList.pause dur) xs-       longYs = TimeTimeList.merge (TimeTimeList.pause dur) ys+       longXs = TimeTimeList.pad dur xs+       longYs = TimeTimeList.pad dur ys    in  longXs  ==  TimeTimeList.mapMaybe (either Just (const Nothing)) zs        &&        longYs  ==  TimeTimeList.mapMaybe (either (const Nothing) Just) zs@@ -603,6 +607,117 @@   +moveForwardIdentity :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> Bool+moveForwardIdentity evs =+   evs ==+   TimeTimeList.moveForward (TimeTimeList.mapBody ((,) 0) evs)++moveForwardAdditive :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time ((time,time),body) -> Bool+moveForwardAdditive evs =+   TimeTimeList.normalize (moveForwardLimited (moveForwardLimited+      (TimeTimeList.mapBody (\((t0,t1),b) -> (t0,(t1,b))) evs))) ==+   TimeTimeList.normalize (moveForwardLimited+      (TimeTimeList.mapBody (mapFst (uncurry (+))) evs))++moveForwardCommutative :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time ((time,time),body) -> Bool+moveForwardCommutative evs =+   TimeTimeList.normalize (moveForwardLimited (moveForwardLimited+      (TimeTimeList.mapBody (\((t0,t1),b) -> (t0,(t1,b))) evs))) ==+   TimeTimeList.normalize (moveForwardLimited (moveForwardLimited+      (TimeTimeList.mapBody (\((t0,t1),b) -> (t1,(t0,b))) evs)))++moveForwardRestricted :: (NonNeg.C time, Ord body) =>+   time -> TimeTimeList.T time (time,body) -> Bool+moveForwardRestricted maxTime evs0 =+   let evs =+          TimeTimeList.mapBody (mapFst (min maxTime)) $+          restrictMoveTimes (TimeTimeList.normalize evs0)+       mevs = TimeTimeList.moveForward evs+   in      mevs  ==  TimeTimeList.moveForwardRestrictedBy (\_ _ -> True) maxTime evs+       &&  mevs  ==  TimeTimeList.moveForwardRestrictedByStrict (\_ _ -> True) maxTime evs+       &&  mevs  ==  TimeTimeList.moveForwardRestrictedByQueue (\_ _ -> False) maxTime evs++moveForwardRestrictedInfinity :: (NonNeg.C time, Ord body) =>+   time -> NonEmptyList time (time,body) -> Bool+moveForwardRestrictedInfinity maxTime =+   checkInfinite .+   TimeTimeList.moveForwardRestricted maxTime .+   TimeTimeList.mapBody (mapFst (min maxTime)) .+   restrictMoveTimes .+   makeUncollapsedInfiniteEventList++++moveForwardLimited :: (NonNeg.C time) =>+   TimeTimeList.T time (time,body) -> TimeTimeList.T time body+moveForwardLimited = TimeTimeList.moveForward . restrictMoveTimes++restrictMoveTimes :: (NonNeg.C time) =>+   TimeTimeList.T time (time,body) -> TimeTimeList.T time (time,body)+restrictMoveTimes =+   flip evalState 0 .+   TimeTimeList.mapM+      (\t -> modify (t+) >> return t)+      (\(t,b) -> gets (\tm -> (min t tm, b)))+++arrangeSingletons :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> Bool+arrangeSingletons evs =+   evs ==+   TimeTimeList.arrange+      (TimeTimeList.mapBody+          (\x -> TimeTimeList.cons 0 x (TimeTimeList.pause 0)) evs)++arrangeDelay :: (NonNeg.C time, Ord body) =>+   time -> NonEmptyList time body -> Bool+arrangeDelay delay evs0 =+   let evs = makeNonEmptyEventList evs0+   in  TimeTimeList.delay delay evs ==+       TimeTimeList.arrange+          (TimeTimeList.mapBody+              (\x -> TimeTimeList.cons delay x (TimeTimeList.pause 0)) $+           TimeTimePriv.mapTimeLast (delay+) evs)++arrangeSimple :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time (TimeTimeList.T time body) ->+   Bool+arrangeSimple evs =+   TimeTimeList.normalize (TimeTimeList.arrange evs) ==+   -- implementation not lazy enough for regular use+   TimeTimeList.foldr+      (TimeTimeList.delay)+      (TimeTimeList.merge)+      (TimeTimeList.pause 0)+      (TimeTimeList.mapBody TimeTimeList.normalize evs)++arrangeAbsolute :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time (TimeTimeList.T time body) ->+   Bool+arrangeAbsolute evs =+   TimeTimeList.normalize (TimeTimeList.arrange evs) ==+   AbsTimeTimeList.foldr+      (\t (xs,ys) ->+          TimeTimeList.merge+             (TimeTimeList.delay t (TimeTimeList.normalize xs)) ys)+      (,)+      (TimeTimeList.pause 0, TimeTimeList.pause 0)+      (TimeTimeList.toAbsoluteEventList 0 evs)++arrangeInfinity :: (NonNeg.C time, Ord body) =>+   NonEmptyList time (NonEmptyList time body) -> Bool+arrangeInfinity =+   checkInfinite .+   TimeTimeList.arrange .+   TimeTimeList.mapBody makeUncollapsedInfiniteEventList .+   makeUncollapsedInfiniteEventList++++ coincidentFlatten :: (NonNeg.C time, Eq body) =>    TimeTimeList.T time body -> Bool coincidentFlatten xs =@@ -968,6 +1083,33 @@      test (insertSplitAtTime :: TimeDiff -> Char -> TimeTimeList.T TimeDiff Char -> Bool)) :    ("insertInfinite",      test (insertInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :++   ("moveForwardIdentity",+     test (moveForwardIdentity :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("moveForwardAdditive",+     test (moveForwardAdditive :: TimeTimeList.T TimeDiff ((TimeDiff,TimeDiff),Char) -> Bool)) :+   ("moveForwardCommutative",+     test (moveForwardCommutative :: TimeTimeList.T TimeDiff ((TimeDiff,TimeDiff),Char) -> Bool)) :+   ("moveForwardRestricted",+     test (moveForwardRestricted :: TimeDiff -> TimeTimeList.T TimeDiff (TimeDiff,Char) -> Bool)) :+   ("moveForwardRestrictedInfinity",+     test (moveForwardRestrictedInfinity :: TimeDiff -> NonEmptyList TimeDiff (TimeDiff,Char) -> Bool)) :++   ("arrangeSingletons",+     test (arrangeSingletons ::+        TimeTimeList.T TimeDiff Char -> Bool)) :+   ("arrangeDelay",+     test (arrangeDelay ::+        TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+   ("arrangeSimple",+     test (arrangeSimple ::+        TimeTimeList.T TimeDiff (TimeTimeList.T TimeDiff Char) -> Bool)) :+   ("arrangeAbsolute",+     test (arrangeAbsolute ::+        TimeTimeList.T TimeDiff (TimeTimeList.T TimeDiff Char) -> Bool)) :+   ("arrangeInfinity",+     test (arrangeInfinity ::+        NonEmptyList TimeDiff (NonEmptyList TimeDiff Char) -> Bool)) :     ("coincidentFlatten",      test (coincidentFlatten :: TimeTimeList.T TimeDiff Char -> Bool)) :