event-list 0.0.11.1 → 0.1

raw patch · 14 files changed

+606/−312 lines, 14 filesdep ~non-negativePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: non-negative

API changes (from Hackage documentation)

Files

• event-list.cabal +3/−3
• src/Data/AlternatingList/List/Mixed.hs +6/−0
• src/Data/AlternatingList/List/Uniform.hs +11/−1
• src/Data/EventList/Absolute/TimeBodyPrivate.hs +4/−0
• src/Data/EventList/Relative/TimeBody.hs +56/−47
• src/Data/EventList/Relative/TimeMixed.hs +14/−9
• src/Data/EventList/Relative/TimeTime.hs +134/−98
• src/Data/EventList/Relative/TimeTimePrivate.hs +49/−9
• src/Data/EventList/Utility.hs +1/−1
• src/Test/Data/EventList/Absolute/BodyEnd.hs +29/−23
• src/Test/Data/EventList/Absolute/TimeEnd.hs +34/−22
• src/Test/Data/EventList/Relative/BodyEnd.hs +63/−32
• src/Test/Data/EventList/Relative/TimeEnd.hs +191/−60
• src/Test/Main.hs +11/−7

@@ -1,5 +1,5 @@ Name:             event-list-Version:          0.0.11.1+Version:          0.1 License:          GPL License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -26,7 +26,7 @@ Source-Repository this   type:     darcs   location: http://code.haskell.org/~thielema/event-list/-  tag:      0.0.11.1+  tag:      0.1  Flag splitBase   description: Choose the new smaller, split-up base package.@@ -37,7 +37,7 @@  Library   Build-Depends:-    non-negative >=0.0 && <0.1,+    non-negative >=0.1 && <0.2,     transformers >=0.1 && <0.3,     utility-ht >=0.0.3 && <0.1,     QuickCheck >=1.1 && <3

@@ -117,6 +117,12 @@ {-# INLINE switchSecondL #-} switchSecondL :: (b -> Disp.T a b -> c) -> Uniform.T a b -> c switchSecondL f (Uniform.Cons b xs) = f b xs+{-+The lazy pattern match leads to a space leak in synthesizer-alsa:testArrangeSpaceLeak+I would like to reproduce this in a small test,+but I did not achieve this so far.+-}+-- switchSecondL f ~(Uniform.Cons b xs) = f b xs   {-# INLINE switchR #-}

@@ -19,7 +19,8 @@     getFirsts, getSeconds, length, genericLength,     fromFirstList, fromSecondList, fromEitherList,     singleton, isSingleton,-    cons, snoc, reverse, mapSecondHead,+    cons, snoc, reverse,+    mapSecondHead, forceSecondHead,     foldr, foldl,     format,     filterFirst, partitionFirst, partitionMaybeFirst,@@ -201,10 +202,19 @@ mapSecondHead :: (b -> b) -> T a b -> T a b mapSecondHead f ~(Cons b xs) = Cons (f b) xs +forceSecondHead :: T a b -> T a b+forceSecondHead = mapSecondHead id  + foldr :: (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c foldr f g d (Cons b xs) = g b $ Disp.foldr f g d xs+{-+The lazy pattern match leads to a space leak in synthesizer-alsa:testArrangeSpaceLeak+I would like to reproduce this in a small test,+but I did not achieve this so far.+-}+-- foldr f g d ~(Cons b xs) = g b $ Disp.foldr f g d xs  foldl :: (c -> a -> d) -> (d -> b -> c) -> d -> T a b -> c foldl f g d0 xs =

@@ -92,6 +92,10 @@ duration :: Num time => T time body -> time duration = switchR 0 (const fst) +{-+Is it necessary to exclude negative delays?+Even negative time stamps should not hurt absolutely timestamped lists.+-} delay :: (Ord time, Num time) =>    time -> T time body -> T time body delay dif =

@@ -25,7 +25,7 @@     fromPairList, toPairList,     getTimes, getBodies, duration,     mapBody, mapTime,-    zipWithBody, zipWithTime,+    zipWithBody, zipWithTime, unzip,     concatMapMonoid,     traverse, traverse_, traverseBody, traverseTime,     mapM, mapM_, mapBodyM, mapTimeM,@@ -58,13 +58,14 @@ import Data.Monoid (Monoid, )  import qualified Numeric.NonNegative.Class as NonNeg+import Numeric.NonNegative.Class ((-|), zero, add, ) import Data.Tuple.HT (mapFst, mapSnd, mapPair, ) import Data.Maybe.HT (toMaybe, ) import Data.List.HT (isAscending, )-import Data.EventList.Utility (floorDiff, beforeBy, ) import Control.Monad.Trans.State (evalState, modify, get, put, ) -import Prelude hiding (mapM, mapM_, null, foldr, filter, concat, cycle, span, )+import Prelude hiding+          (mapM, mapM_, unzip, null, foldr, filter, concat, cycle, span, )   @@ -115,8 +116,8 @@ getTimes :: T time body -> [time] getTimes = Disp.getFirsts . decons -duration :: Num time => T time body -> time-duration = sum . getTimes+duration :: NonNeg.C time => T time body -> time+duration = NonNeg.sum . getTimes   @@ -138,7 +139,15 @@ zipWithTime f = lift . Disp.zipWithFirst f  +unzip :: T time (body0, body1) -> (T time body0, T time body1)+unzip =+   foldrPair+      (\time (body0, body1) ->+         mapPair (cons time body0, cons time body1))+      (empty, empty) ++ concatMapMonoid :: Monoid m =>    (time -> m) -> (body -> m) ->    T time body -> m@@ -200,12 +209,12 @@ {- | Keep only events that match a predicate while preserving absolute times. -}-filter :: (Num time) =>+filter :: (NonNeg.C 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) =>+mapMaybe :: (NonNeg.C time) =>    (body0 -> Maybe body1) ->    T time body0 -> T time body1 mapMaybe f = catMaybes . mapBody f@@ -214,12 +223,12 @@ Adds times in a left-associative fashion. Use this if the time is a strict data type. -}-catMaybes :: (Num time) =>+catMaybes :: (NonNeg.C time) =>    T time (Maybe body) -> T time body catMaybes =    Cons .    fst . Mixed.viewSecondR .-   Uniform.mapSecond sum .+   Uniform.mapSecond NonNeg.sum .    Uniform.catMaybesFirst .    flip Mixed.snocSecond (error "catMaybes: no trailing time") .    decons@@ -254,11 +263,11 @@ {- Could be implemented more easily in terms of Uniform.partition -}-partition :: (Num time) =>+partition :: (NonNeg.C time) =>    (body -> Bool) -> T time body -> (T time body, T time body)-partition p = partitionRec p 0 0+partition p = partitionRec p zero zero -partitionRec :: (Num time) =>+partitionRec :: (NonNeg.C time) =>    (body -> Bool) -> time -> time ->        T time body -> (T time body, T time body) partitionRec p =@@ -266,14 +275,14 @@           switchL              (empty, empty)              (\ (t, b) es ->-                let t0' = t0 + t-                    t1' = t1 + t+                let t0' = add t0 t+                    t1' = add t1 t                 in  if p b-                      then mapFst (cons t0' b) (recourse 0 t1' es)-                      else mapSnd (cons t1' b) (recourse t0' 0 es))+                      then mapFst (cons t0' b) (recourse zero t1' es)+                      else mapSnd (cons t1' b) (recourse t0' zero es))    in  recourse -partitionMaybe :: (Num time) =>+partitionMaybe :: (NonNeg.C time) =>    (body0 -> Maybe body1) -> T time body0 ->    (T time body1, T time body0) partitionMaybe f =@@ -289,7 +298,7 @@ we splice the event list into lists, each containing the same class. Absolute time stamps are preserved. -}-slice :: (Eq a, Num time) =>+slice :: (Eq a, NonNeg.C time) =>    (body -> a) -> T time body -> [(a, T time body)] slice = Utility.slice (fmap (snd . fst) . viewL) partition @@ -304,7 +313,7 @@ -} collectCoincident :: (NonNeg.C time) => T time body -> T time [body] collectCoincident =-   mapTimeTail $ BodyBodyPriv.lift $ Uniform.filterFirst (0<)+   mapTimeTail $ BodyBodyPriv.lift $ Uniform.filterFirst (zero <)  {- | Reverse to collectCoincident:@@ -321,9 +330,9 @@          unlift (delay time) .          fst . Mixed.viewSecondR .          Uniform.foldr-            (Mixed.appendUniformUniform . Uniform.fromSecondList 0)+            (Mixed.appendUniformUniform . Uniform.fromSecondList zero)             Mixed.consSecond Disp.empty .-         Uniform.mapSecond sum .+         Uniform.mapSecond NonNeg.sum .          Uniform.filterSecond (not . List.null)) .    decons @@ -372,29 +381,26 @@ mergeBy :: (NonNeg.C time) =>    (body -> body -> Bool) ->    T time body -> T time body -> T time body-mergeBy before xs0 ys0 =-   case (viewL xs0, viewL ys0) of-      (Nothing, _) -> ys0-      (_, Nothing) -> xs0-      (Just (x@(xt,xb),xs), Just (y@(yt,yb),ys)) ->-         if beforeBy before x y-           then uncurry cons x $ mergeBy before xs $ cons (yt-xt) yb ys-           else uncurry cons y $ mergeBy before ys $ cons (xt-yt) xb xs+mergeBy before =+   let recourse xs0 ys0 =+          case (viewL xs0, viewL ys0) of+             (Nothing, _) -> ys0+             (_, Nothing) -> xs0+             (Just ((xt,xb),xs), Just ((yt,yb),ys)) ->+                let (mt,~(b,dt)) = NonNeg.split xt yt+                in  uncurry (cons mt) $+                    if b && (dt/=zero || before xb yb)+                      then (xb, recourse xs $ cons dt yb ys)+                      else (yb, recourse ys $ cons dt xb xs)+   in  recourse + {- | '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 =-   switchL-      (singleton t0 me0)-      (\ mev1@(t1, me1) mevs ->-          let mev0 = (t0, me0)-          in  if mev0 < mev1-                then uncurry cons mev0 $ cons   (t1-t0) me1 mevs-                else uncurry cons mev1 $ insert (t0-t1) me0 mevs)-+insert = insertBy (<)   insertBy :: (NonNeg.C time) =>@@ -402,12 +408,15 @@    time -> body -> T time body -> T time body insertBy before =    let recourse t0 me0 =+          (\ ~((t,me), rest) -> cons t me rest) .           switchL-             (singleton t0 me0)-             (\ mev1@(t1, me1) mevs ->-                 if beforeBy before (t0, me0) mev1-                   then cons t0 me0 $ cons     (t1-t0) me1 mevs-                   else cons t1 me1 $ recourse (t0-t1) me0 mevs)+             ((t0,me0), empty)+             (\(t1, me1) mevs ->+                let (mt,~(b,dt)) = NonNeg.split t0 t1+                in  mapFst ((,) mt) $+                    if b && (dt/=zero || before me0 me1)+                      then (me0, cons     dt me1 mevs)+                      else (me1, recourse dt me0 mevs))    in  recourse  @@ -416,7 +425,7 @@ You must make sure, that no event is moved before time zero. This works only for finite lists. -}-moveForward :: (NonNeg.C time) =>+moveForward :: (Ord time, Num time) =>    T time (time, body) -> T time body moveForward =    fromAbsoluteEventList .@@ -473,12 +482,12 @@ decreaseStart :: (NonNeg.C time) =>    time -> T time body -> T time body decreaseStart dif =-   mapTimeHead (subtract dif)+   mapTimeHead (-| dif)  delay :: (NonNeg.C time) =>    time -> T time body -> T time body delay dif =-   mapTimeHead (dif+)+   mapTimeHead (add dif)   @@ -506,7 +515,7 @@ discretize :: (NonNeg.C time, RealFrac time, NonNeg.C i, Integral i) =>    T time body -> T i body discretize =-   flip evalState 0.5 . mapTimeM floorDiff+   flip evalState 0.5 . mapTimeM Utility.floorDiff  resample :: (NonNeg.C time, RealFrac time, NonNeg.C i, Integral i) =>    time -> T time body -> T i body

@@ -94,22 +94,27 @@    time -> Disp.T time body ->    (Uniform.T body time, Disp.T time body) splitAtTimeAux t0 =+   mapFst Uniform.forceSecondHead .    Mixed.switchFirstL-      (Uniform.singleton 0, Disp.empty)+      (Mixed.consSecond NonNeg.zero Disp.empty, Disp.empty)       (\t1 xs ->-          if t0<=t1-            then (Uniform.singleton t0, Mixed.consFirst (t1-t0) xs)-            else-               Mixed.switchSecondL-                  (\b ys -> mapFst (Uniform.cons t1 b) (splitAtTimeAux (t0-t1) ys))-                  xs)+         let (mt,~(before,dt)) = NonNeg.split t0 t1+         in  mapFst (Mixed.consSecond mt) $+             if before+               then (Disp.empty, Mixed.consFirst dt xs)+               else+                  Mixed.switchSecondL+                     (\b ys ->+                        mapFst (Mixed.consFirst b) $+                        splitAtTimeAux dt ys)+                     xs)  splitAtTime :: (NonNeg.C time) =>    time -> TimeBodyList.T time body ->    (TimeTimeList.T time body, TimeBodyList.T time body)-splitAtTime t0 =+splitAtTime t =    mapPair (TimeTimePriv.Cons, TimeBodyPriv.Cons) .-   splitAtTimeAux t0 .+   splitAtTimeAux t .    TimeBodyPriv.decons  takeTime :: (NonNeg.C time) =>

@@ -10,7 +10,7 @@ module Data.EventList.Relative.TimeTime    (T,     mapBody, mapTime,-    zipWithBody, zipWithTime,+    zipWithBody, zipWithTime, unzip,     concatMapMonoid,     traverse, traverse_, traverseBody, traverseTime,     mapM, mapM_, mapBodyM, mapTimeM,@@ -26,6 +26,7 @@     mapMaybe, catMaybes, catMaybesR,     append, concat, concatNaive, cycle, cycleNaive, reverse,     splitAtTime, takeTime, dropTime,+    forceTimeHead,     discretize, resample,     collectCoincident, flatten, mapCoincident,     normalize, isNormalized,@@ -47,9 +48,10 @@ import qualified Data.List as List import qualified Data.EventList.Utility as Utility -import Data.Monoid (Monoid, mconcat, mappend, )+import Data.Monoid (Monoid, mempty, mconcat, )  import qualified Numeric.NonNegative.Class as NonNeg+import Numeric.NonNegative.Class ((-|), zero, add, ) import Data.Tuple.HT (mapFst, mapSnd, mapPair, ) import Data.Maybe.HT (toMaybe, ) import Data.List.HT (isAscending, )@@ -61,7 +63,7 @@  import Prelude hiding    (null, foldr, foldl, map, filter, concat, cycle, reverse,-    sequence, sequence_, mapM, mapM_)+    sequence, sequence_, mapM, mapM_, unzip, )   @@ -79,8 +81,8 @@ getTimes :: T time body -> [time] getTimes = Uniform.getSeconds . decons -duration :: Num time => T time body -> time-duration = sum . getTimes+duration :: NonNeg.C time => T time body -> time+duration = NonNeg.sum . getTimes   @@ -132,6 +134,14 @@    (time0, [time0]) -> T time1 body -> T time2 body zipWithTime f = lift . Uniform.zipWithSecond f +unzip :: T time (body0, body1) -> (T time body0, T time body1)+unzip =+   foldr+      (\time ->+         mapPair (consTime time, consTime time))+      (\(body0, body1) ->+         mapPair (consBody body0, consBody body1))+      (mempty, mempty)   concatMapMonoid :: Monoid m =>@@ -210,51 +220,49 @@ mergeBy :: (NonNeg.C time) =>    (body -> body -> Bool) ->    T time body -> T time body -> T time body-mergeBy before xs0 ys0 =-   let (xt,xs) = viewTimeL xs0-       (yt,ys) = viewTimeL ys0-   in  case compare xt yt of-          LT -> mergeFirstBy before xs0 ys0-          GT -> mergeFirstBy before ys0 xs0-          EQ ->-             consTime xt $-             case (viewBodyL xs, viewBodyL ys) of-                (Nothing, _) -> ys-                (_, Nothing) -> xs-                (Just (b0,xs1), Just (b1,ys1)) ->-                   {- do not insert both b0 and b1 immediately,-                      because the later one of b0 and b1 may be pushed even further,-                      thus recourse with 'mergeBy' on xs or ys -}-                   if before b0 b1-                     then consBody b0 $ mergeBy before xs1 $ consTime 0 ys-                     else consBody b1 $ mergeBy before ys1 $ consTime 0 xs--{- | merge two time ordered lists provided that e0 is earlier than e1 -}-mergeFirstBy :: (NonNeg.C time) =>-   (body -> body -> Bool) ->-   T time body -> T time body -> T time body-mergeFirstBy before xs0 ys0 =-   let (xt,xs) = viewTimeL xs0-       (yt,ys) = viewTimeL ys0-   in  switchBodyL-          ys0-          (\ b xs1 ->-              consTime xt $ consBody b $ mergeBy before xs1 $ consTime (yt-xt) ys)-          xs+mergeBy before =+   let recourse xs0 ys0 =+          let (xt,xs) = viewTimeL xs0+              (yt,ys) = viewTimeL ys0+              (mt,~(bef,dt)) = NonNeg.split xt yt+          in  delay mt $+              if dt == zero+                then+                   case (viewBodyL xs, viewBodyL ys) of+                      (Nothing, _) -> consTime zero ys+                      (_, Nothing) -> consTime zero xs+                      (Just (b0,xs1), Just (b1,ys1)) ->+                         {-+                         do not insert both b0 and b1 immediately,+                         because the later one of b0 and b1 may be pushed even further,+                         thus recourse with 'mergeBy' on xs or ys+                         -}+                         if before b0 b1+                           then cons zero b0 $+                                recourse xs1 (consTime zero ys)+                           else cons zero b1 $+                                recourse (consTime zero xs) ys1+                else+                  if bef+                    then+                       let ys1 = consTime dt ys+                       in  flip (switchBodyL ys1) xs $ \ b xs1 ->+                              cons zero b $ recourse xs1 ys1+                    else+                       let xs1 = consTime dt xs+                       in  flip (switchBodyL xs1) ys $ \ b ys1 ->+                              cons zero b $ recourse xs1 ys1+   in  recourse   {- | Note that 'merge' compares entire events rather than just start times.  This is to ensure that it is commutative, a desirable-condition for some of the proofs used in \secref{equivalence}.+condition for some of the proofs used in Haskore/section equivalence. It is also necessary to assert a unique representation-of the performance independent of the structure of the 'Music.T note'.+of the event list independent of the structure of the event type. The same function for inserting into a time ordered list with a trailing pause.-The strictness annotation is necessary for working with infinite lists.--Here are two other functions that are already known for non-padded time lists. -}- insert :: (NonNeg.C time, Ord body) =>    time -> body -> T time body -> T time body insert = insertBy (<)@@ -268,18 +276,19 @@    time -> body -> T time body -> T time body insertBy before t0 me0 =    let recurseTime t =-          switchTimeL (\ t1 xs ->-             if t<t1-               then cons t me0 (consTime (t1-t) xs)-               else recurseBody t1 t xs)-       recurseBody t1 t =-          switchBodyL-             (cons t me0 $ pause 0)-             (\ me1 xs ->-                 consTime t1 $-                    if t==t1 && before me0 me1-                      then consBody me0 (cons 0 me1 xs)-                      else consBody me1 (recurseTime (t-t1) xs))+          switchTimeL $ \ t1 xs0 ->+             let (mt,~(b,dt)) = NonNeg.split t1 t+             in  delay mt $+                 if not b+                   then cons zero me0 $ consTime dt xs0+                   else+                     switchBodyL+                        (cons dt me0 $ pause zero)+                        (\ me1 xs -> consTime zero $+                           if dt==zero && before me0 me1+                             then consBody me0 (cons zero me1 xs)+                             else consBody me1 (recurseTime dt xs))+                        xs0    in   recurseTime t0  @@ -297,7 +306,7 @@ You must make sure, that no event is moved before time zero. This works only for finite lists. -}-moveForward :: (NonNeg.C time) =>+moveForward :: (Ord time, Num time) =>    T time (time, body) -> T time body moveForward =    fromAbsoluteEventList .@@ -311,7 +320,7 @@    foldr       (\t -> cons t Nothing)       (\(t,b) -> insertBy (ltMaybe (\_ _ -> True)) t (Just b))-      (pause 0)+      (pause zero)  {- | Like 'moveForward' but restricts the look-ahead time.@@ -332,7 +341,7 @@ moveForwardRestricted maxTime =    decreaseStart maxTime .    moveBackward .-   mapBody (mapFst (maxTime-)) .+   mapBody (mapFst (maxTime-|)) .    pad maxTime {-    moveForwardRestrictedBy@@ -357,7 +366,7 @@    catMaybes .    foldr       (\t -> cons t Nothing)-      (\(t,b) -> insertBy (ltMaybe cmp) (maxTime-t) (Just b))+      (\(t,b) -> insertBy (ltMaybe cmp) (maxTime-|t) (Just b))       (pause maxTime)  -- | currently only for testing@@ -368,11 +377,11 @@    decreaseStart maxTime .    foldr       delay-      (\(t,b) -> insertBy cmp (maxTime-t) b)+      (\(t,b) -> insertBy cmp (maxTime-|t) b)       (pause maxTime)  -- | currently only for testing-moveForwardRestrictedByQueue :: (NonNeg.C time) =>+moveForwardRestrictedByQueue :: (NonNeg.C time, Num time) =>    (body -> body -> Bool) ->    time -> T time (time, body) -> T time body moveForwardRestrictedByQueue cmp maxTime xs =@@ -399,7 +408,7 @@ -} arrange :: (Ord body, NonNeg.C time) =>    T time (T time body) -> T time body-arrange = arrangeBy (\_ _ -> False)+arrange = arrangeBy (\_ _ -> True)  arrangeBy :: (NonNeg.C time) =>    (body -> body -> Bool) ->@@ -409,16 +418,9 @@    foldr       (\t -> cons t Nothing)       (\xs -> mergeBy (ltMaybe cmp) (mapBody Just xs))-      (pause 0)+      (pause zero)  -{--not lazy enough for @append (2 /. 'a' ./ 4 /. 'b' ./ 2 /. undefined) undefined@--}-append :: (NonNeg.C time) =>-   T time body -> T time body -> T time body-append = mappend- concat :: (NonNeg.C time) =>    [T time body] -> T time body concat = mconcat@@ -433,7 +435,7 @@ -} concatNaive :: (NonNeg.C time) =>    [T time body] -> T time body-concatNaive = List.foldr append (pause 0)+concatNaive = List.foldr append (pause zero)   {- |@@ -446,7 +448,7 @@    (\t0 xs ->        consTime t0 $        BodyTimePriv.cycle $-       BodyTimePriv.mapTimeLast (+t0) xs)+       BodyTimePriv.mapTimeLast (add t0) xs)   cycleNaive :: (NonNeg.C time) =>@@ -472,13 +474,19 @@ splitAtTime t0 =    switchTimeL    (\t1 xs ->-        if t0<=t1-          then (pause t0, consTime (t1-t0) xs)-          else-             switchBodyL-                (pause t1, pause 0)-                (\ b -> mapFst (cons t1 b) . splitAtTime (t0-t1))-                xs)+      let (mt,~(bef,dt)) = NonNeg.split t0 t1+      in  {-+          The handling of the second pair member looks a bit cumbersome,+          but it is necessary to prepend the time once+          in order to prevent a memory leak.+          -}+          mapPair (consTime mt, forceTimeHead) $+          if bef+            then (mempty, consTime dt xs)+            else switchBodyL+                    (mempty, pause zero)+                    (\ b -> mapFst (consBody b) . splitAtTime dt)+                    xs)  takeTime :: (NonNeg.C time) =>    time -> T time body -> T time body@@ -486,13 +494,42 @@  dropTime :: (NonNeg.C time) =>    time -> T time body -> T time body-dropTime t = snd . splitAtTime t+-- dropTime t = snd . splitAtTime t+dropTime t0 =+   switchTimeL+   (\t1 xs ->+      let (bef,dt) = snd $ NonNeg.split t0 t1+      in  forceTimeHead $+          if bef+            then consTime dt xs+            else switchBodyL+                    (pause zero)+                    (\ _b -> dropTime dt)+                    xs) +{-+Surprisingly this has a space leak,+see test dropTimeLazyInfinite. +dropTime :: (NonNeg.C time) =>+   time -> T time body -> T time body+dropTime t0 =+   switchTimeL+   (\t1 xs ->+      let (bef,dt) = snd $ NonNeg.split t0 t1+      in  if bef+            then consTime dt xs+            else switchBodyL+                    (pause zero)+                    (\ _b -> dropTime dt)+                    xs)+-}++ decreaseStart :: (NonNeg.C time) =>    time -> T time body -> T time body decreaseStart dif =-   mapTimeHead (subtract dif)+   mapTimeHead (-| dif)   collectCoincident :: (NonNeg.C time) => T time body -> T time [body]@@ -514,12 +551,12 @@ from the beginning to the end. -} -filter :: (Num time) =>+filter :: (NonNeg.C time) =>    (body -> Bool) ->    T time body -> T time body filter p = mapMaybe (\b -> toMaybe (p b) b) -mapMaybe :: (Num time) =>+mapMaybe :: (NonNeg.C time) =>    (body0 -> Maybe body1) ->    T time body0 -> T time body1 mapMaybe f = catMaybes . mapBody f@@ -528,48 +565,50 @@ Adds times in a left-associative fashion. Use this if the time is a strict data type. -}-catMaybes :: (Num time) =>+catMaybes :: (NonNeg.C time) =>    T time (Maybe body) -> T time body-catMaybes = mapTime sum . lift Uniform.catMaybesFirst+catMaybes = mapTime NonNeg.sum . lift Uniform.catMaybesFirst  {- | Adds times in a right-associative fashion. Use this if the time is a data type like lazy Peano numbers or "Numeric.NonNegative.Chunky". -}-catMaybesR :: (Num time) =>+catMaybesR :: (NonNeg.C time) =>    T time (Maybe body) -> T time body catMaybesR =    foldr-      (mapTimeHead . (+))-      (maybe id (cons 0))-      (pause 0)+      (mapTimeHead . add)+      (maybe id (cons zero))+      (pause zero) -partition :: (Num time) =>+partition :: (NonNeg.C time) =>    (body -> Bool) ->    T time body -> (T time body, T time body) partition p =-   mapPair (mapTime sum, mapTime sum) .+   mapPair (mapTime NonNeg.sum, mapTime NonNeg.sum) .    mapPair (Cons, Cons) .    Uniform.partitionFirst p .    decons -partitionMaybe :: (Num time) =>+partitionMaybe :: (NonNeg.C time) =>    (body0 -> Maybe body1) -> T time body0 ->    (T time body1, T time body0) partitionMaybe f =-   mapPair (mapTime sum . Cons, mapTime sum . Cons) .+   mapPair (mapTime NonNeg.sum . Cons, mapTime NonNeg.sum . Cons) .    Uniform.partitionMaybeFirst f .    decons  {- | Cf. 'catMaybesR' -}-partitionMaybeR :: (Num time) =>+partitionMaybeR :: (NonNeg.C time) =>    (body0 -> Maybe body1) -> T time body0 ->    (T time body1, T time body0) partitionMaybeR f =-   mapPair (mapTime (List.foldr (+) 0), mapTime (List.foldr (+) 0)) .+   mapPair+      (mapTime (List.foldr add zero),+       mapTime (List.foldr add zero)) .    mapPair (Cons, Cons) .    Uniform.partitionMaybeFirst f .    decons@@ -578,13 +617,10 @@ Since we need it later for MIDI generation, we will also define a slicing into equivalence classes of events. -}-slice :: (Eq a, Num time) =>+slice :: (Eq a, NonNeg.C time) =>    (body -> a) -> T time body -> [(a, T time body)] slice = Utility.slice (fmap fst . viewBodyL . snd . viewTimeL) partition --foldr :: (time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b-foldr f g x = Uniform.foldr g f x . decons  foldl :: (a -> time -> b) -> (b -> body -> a) -> a -> T time body -> b foldl f g x = Uniform.foldl g f x . decons

@@ -20,6 +20,7 @@ import qualified Data.AlternatingList.List.Mixed as Mixed  import qualified Numeric.NonNegative.Class as NonNeg+import Numeric.NonNegative.Class (zero, add, )  import Data.Tuple.HT (mapFst, mapSnd, ) @@ -32,6 +33,7 @@  import Test.QuickCheck (Arbitrary(arbitrary)) +import Prelude hiding (foldr, )   newtype T time body = Cons {decons :: Uniform.T body time}@@ -47,15 +49,43 @@   instance (NonNeg.C time) => Monoid (T time body) where-   mempty = Cons (Uniform.singleton 0)-   mappend =-      switchTimeR-      (\ xs t -> lift (Mixed.appendDisparateUniform $~* xs) . delay t)+   mempty = Cons (Uniform.singleton zero)+   mappend = append    mconcat =-      flatten . consTime 0 .+      flatten . consTime zero .       mconcat .       map (consBody [] . fmap (:[])) +append, appendAlt, appendSwitch ::+   (NonNeg.C time) =>+   T time body -> T time body -> T time body+append xs ys =+   forceTimeHead $+   foldr+      delay+      (\b ->+         consTime NonNeg.zero .+         consBody b)+      ys xs++appendAlt xs ys =+   foldr+      (\t ->+         delay t .+         either id (consTime NonNeg.zero))+      (\b -> Right . consBody b)+      (Left ys) xs++{-+not lazy enough for @append (2 /. 'a' ./ 4 /. 'b' ./ 2 /. undefined) undefined@+-}+appendSwitch =+   switchTimeR+      (\ xs t ->+         lift (Mixed.appendDisparateUniform $~* xs) .+         delay t)++ instance Functor (T time) where    fmap f (Cons x) = Cons (Uniform.mapFirst f x) @@ -154,6 +184,8 @@    switchTimeL (\time -> consTime time . f) {- This causes a memory leak when used with chunky time values.+I have found this problem in synthesizer-alsa:EventList.MIDI.matchNote,+but I could not reliably reproduce that in smaller setups.  mapTimeTail =    lift . Mixed.mapSecondTail . BodyTimePriv.unlift@@ -176,19 +208,27 @@ mapTimeInit = lift . Mixed.mapSecondInit . TimeBodyPriv.unlift  +foldr :: (time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b+foldr f g x = Uniform.foldr g f x . decons++forceTimeHead :: (NonNeg.C time) =>+   T time body -> T time body+forceTimeHead =+   mapTimeHead id+ delay :: (NonNeg.C time) =>    time -> T time body -> T time body delay dif =-   mapTimeHead (dif+)+   mapTimeHead (add dif) -flatten :: (Num time) => T time [body] -> T time body+flatten :: (NonNeg.C time) => T time [body] -> T time body flatten =    Cons .    Uniform.foldr-      (Mixed.appendUniformUniform . Uniform.fromSecondList 0)+      (Mixed.appendUniformUniform . Uniform.fromSecondList zero)       Mixed.consSecond    -- consTime       Disp.empty . --      (\(b:bs) xs -> consBody b (List.foldr (cons 0) xs bs)) empty .-   Uniform.mapSecond sum .+   Uniform.mapSecond NonNeg.sum .    Uniform.filterFirst (not . null) .    decons

@@ -37,7 +37,7 @@  beforeBy :: (Ord time) =>    (body -> body -> Bool) ->-   (time, body) -> (time, body) ->  Bool+   (time, body) -> (time, body) -> Bool beforeBy before (t0, me0) (t1, me1) =    case compare t0 t1 of       LT -> True

@@ -38,19 +38,22 @@  infixl 4 ==~ -(==~) :: (Eq body, Num time) =>+(==~) :: (Eq body, NonNeg.C time, Num time) =>    AbsBody.T time body -> RelBody.T time body -> Bool (==~) xs ys =    xs == RelBody.toAbsoluteEventList 0 ys   -duration :: Num time => RelBody.T time body -> Bool+duration ::+   (NonNeg.C time, Num time) =>+   RelBody.T time body -> Bool duration xs =    AbsBody.duration $~ xs == RelBody.duration xs  -mapBody :: (Eq body1, Num time) =>+mapBody ::+   (Eq body1, NonNeg.C time, Num time) =>    (body0 -> body1) -> RelBody.T time body0 -> Bool mapBody f xs =    AbsBody.mapBody f $~ xs ==~ RelBody.mapBody f xs@@ -58,7 +61,7 @@   mapBodyM ::-   (Monad m, Eq body1, NonNeg.C time) =>+   (Monad m, Eq body1, NonNeg.C time, Num time) =>    (m (AbsBody.T time body1) -> AbsBody.T time body1) ->    (body0 -> m body1) -> RelBody.T time body0 -> Bool mapBodyM run f xs =@@ -66,7 +69,7 @@    run (liftM (RelBody.toAbsoluteEventList 0) (RelBody.mapBodyM f xs))  mapBodyMRandom ::-   (NonNeg.C time, Random body, Eq body) =>+   (NonNeg.C time, Num time, Random body, Eq body) =>    Int -> RelBody.T time (body, body) -> Bool mapBodyMRandom seed =    mapBodyM @@ -74,7 +77,7 @@       (state . randomR)  -filter :: (Eq body, Num time) =>+filter :: (Eq body, NonNeg.C time, Num time) =>    (body -> Bool) -> RelBody.T time body -> Bool filter p xs =    AbsBody.filter p $~ xs ==~ RelBody.filter p xs@@ -86,7 +89,7 @@ mapMaybe f = catMaybes . mapBody f -} -catMaybes :: (Eq body, Num time) =>+catMaybes :: (Eq body, NonNeg.C time, Num time) =>    RelBody.T time (Maybe body) -> Bool catMaybes xs =    AbsBody.catMaybes $~ xs ==~ RelBody.catMaybes xs@@ -94,7 +97,7 @@ {- Could be implemented more easily in terms of Uniform.partition -}-partition :: (Eq body, Num time) =>+partition :: (Eq body, NonNeg.C time, Num time) =>    (body -> Bool) -> RelBody.T time body -> Bool partition p xs =    AbsBody.partition p $~ xs ==@@ -106,32 +109,33 @@ Since we need it later for MIDI generation, we will also define a slicing into equivalence classes of events. -}-slice :: (Eq a, Eq body, Num time) =>+slice :: (Eq a, Eq body, NonNeg.C time, Num time) =>    (body -> a) -> RelBody.T time body -> Bool slice f xs =    AbsBody.slice f $~ xs ==    map (mapSnd (RelBody.toAbsoluteEventList 0)) (RelBody.slice f xs)  -collectCoincident :: (NonNeg.C time, Eq body) =>+collectCoincident :: (Eq body, NonNeg.C time, Num time) =>    RelBody.T time body -> Bool collectCoincident xs =    AbsBody.collectCoincident $~ xs ==~    RelBody.collectCoincident xs -collectCoincidentFoldr :: (NonNeg.C time, Eq body) =>+collectCoincidentFoldr :: (Eq body, NonNeg.C time, Num time) =>    RelBody.T time body -> Bool collectCoincidentFoldr xs =    AbsBody.collectCoincident $~ xs ==    AbsBody.collectCoincidentFoldr $~ xs -collectCoincidentNonLazy :: (NonNeg.C time, Eq body) =>+collectCoincidentNonLazy :: (Eq body, NonNeg.C time, Num time) =>    RelBody.T time body -> Bool collectCoincidentNonLazy xs =    AbsBody.collectCoincident $~ xs ==    AbsBody.collectCoincidentNonLazy $~ xs -collectCoincidentInfinite :: (NonNeg.C time, Eq body) =>+collectCoincidentInfinite ::+   (Eq body, NonNeg.C time, Num time) =>    NonEmptyList time body -> Bool collectCoincidentInfinite =    checkInfinite .@@ -139,38 +143,38 @@    makeUncollapsedInfiniteEventList  -flatten :: (NonNeg.C time, Eq body) =>+flatten :: (Eq body, NonNeg.C time, Num time) =>    RelBody.T time [body] -> Bool flatten xs =    AbsBody.flatten $~ xs  ==~  RelBody.flatten xs  -normalize :: (NonNeg.C time, Ord body) =>+normalize :: (Ord body, NonNeg.C time, Num time) =>    RelBody.T time body -> Bool normalize xs =    AbsBody.normalize $~ xs  ==~  RelBody.normalize xs  -merge :: (NonNeg.C time, Ord body) =>+merge :: (Ord body, NonNeg.C time, Num time) =>    RelBody.T time body -> RelBody.T time body -> Bool merge xs ys =    AbsBody.merge $~ xs $~ ys  ==~  RelBody.merge xs ys  -insert :: (NonNeg.C time, Ord body) =>+insert :: (Ord body, NonNeg.C time, Num time) =>    time -> body -> RelBody.T time body -> Bool insert t b xs =    AbsBody.insert t b $~ xs  ==~  RelBody.insert t b xs   -append :: (NonNeg.C time, Eq body) =>+append :: (Eq body, NonNeg.C time, Num time) =>    RelBody.T time body -> RelBody.T time body -> Bool append xs ys =    AbsBody.append $~ xs $~ ys  ==~    RelBody.append xs ys -concat :: (NonNeg.C time, Eq body) =>+concat :: (Eq body, NonNeg.C time, Num time) =>    [RelBody.T time body] -> Bool concat xs =    AbsBody.concat (map (RelBody.toAbsoluteEventList 0) xs)  ==~@@ -184,7 +188,7 @@ -}  -decreaseStart :: (NonNeg.C time, Eq body) =>+decreaseStart :: (Eq body, NonNeg.C time, Num time) =>    time -> time -> RelBody.T time body -> Bool decreaseStart dif0 dif1 xs0 =    let difA = min dif0 dif1@@ -194,7 +198,7 @@        RelBody.decreaseStart difA xs  -delay :: (NonNeg.C time, Eq body) =>+delay :: (Eq body, NonNeg.C time, Num time) =>    time -> RelBody.T time body -> Bool delay dif xs =    AbsBody.delay dif $~ xs  ==~@@ -243,13 +247,15 @@  type NonEmptyList time body = ((time, body), RelBody.T time body) -makeUncollapsedInfiniteEventList :: (NonNeg.C time) =>+makeUncollapsedInfiniteEventList ::+   (NonNeg.C time, Num time) =>    NonEmptyList time body -> AbsBody.T time body makeUncollapsedInfiniteEventList =    makeInfiniteEventList .    mapFst (mapFst (1+)) -makeInfiniteEventList :: (NonNeg.C time) =>+makeInfiniteEventList ::+   (NonNeg.C time, Num time) =>    NonEmptyList time body -> AbsBody.T time body makeInfiniteEventList =    RelBody.toAbsoluteEventList 0 . RelBody.cycle . makeNonEmptyEventList

@@ -45,12 +45,14 @@   -duration :: Num time => RelTime.T time body -> Bool+duration ::+   (NonNeg.C time, Num time) =>+   RelTime.T time body -> Bool duration xs =    AbsTime.duration $~ xs == RelTime.duration xs  -mapBody :: (Eq body1, Num time) =>+mapBody :: (Eq body1, NonNeg.C time, Num time) =>    (body0 -> body1) -> RelTime.T time body0 -> Bool mapBody f xs =    AbsTime.mapBody f $~ xs ==~ RelTime.mapBody f xs@@ -58,7 +60,7 @@   mapBodyM ::-   (Monad m, Eq body1, NonNeg.C time) =>+   (Monad m, Eq body1, NonNeg.C time, Num time) =>    (m (AbsTime.T time body1) -> AbsTime.T time body1) ->    (body0 -> m body1) -> RelTime.T time body0 -> Bool mapBodyM run f xs =@@ -66,7 +68,7 @@    run (liftM (RelTime.toAbsoluteEventList 0) (RelTime.mapBodyM f xs))  mapBodyMRandom ::-   (NonNeg.C time, Random body, Eq body) =>+   (NonNeg.C time, Num time, Random body, Eq body) =>    Int -> RelTime.T time (body, body) -> Bool mapBodyMRandom seed =    mapBodyM @@ -74,19 +76,19 @@       (state . randomR)  -filter :: (Eq body, Num time) =>+filter :: (Eq body, NonNeg.C time, Num time) =>    (body -> Bool) -> RelTime.T time body -> Bool filter p xs =    AbsTime.filter p $~ xs ==~ RelTime.filter p xs  {--mapMaybe :: (Num time) =>+mapMaybe :: (NonNeg.C time, Num time) =>    (body0 -> Maybe body1) ->    RelTime.T time body0 -> RelTime.T time body1 mapMaybe f = catMaybes . mapBody f -} -catMaybes :: (Eq body, Num time) =>+catMaybes :: (Eq body, NonNeg.C time, Num time) =>    RelTime.T time (Maybe body) -> Bool catMaybes xs =    AbsTime.catMaybes $~ xs ==~ RelTime.catMaybes xs@@ -94,7 +96,7 @@ {- Could be implemented more easily in terms of Uniform.partition -}-partition :: (Eq body, Num time) =>+partition :: (Eq body, NonNeg.C time, Num time) =>    (body -> Bool) -> RelTime.T time body -> Bool partition p xs =    AbsTime.partition p $~ xs ==@@ -106,20 +108,20 @@ Since we need it later for MIDI generation, we will also define a slicing into equivalence classes of events. -}-slice :: (Eq a, Eq body, Num time) =>+slice :: (Eq a, Eq body, NonNeg.C time, Num time) =>    (body -> a) -> RelTime.T time body -> Bool slice f xs =    AbsTime.slice f $~ xs ==    map (mapSnd (RelTime.toAbsoluteEventList 0)) (RelTime.slice f xs)  -collectCoincident :: (NonNeg.C time, Eq body) =>+collectCoincident :: (NonNeg.C time, Num time, Eq body) =>    RelTime.T time body -> Bool collectCoincident xs =    AbsTime.collectCoincident $~ xs ==~    RelTime.collectCoincident xs -collectCoincidentInfinite :: (NonNeg.C time, Eq body) =>+collectCoincidentInfinite :: (NonNeg.C time, Num time, Eq body) =>    NonEmptyList time body -> Bool collectCoincidentInfinite =    checkInfinite .@@ -127,38 +129,48 @@    makeUncollapsedInfiniteEventList  -flatten :: (NonNeg.C time, Eq body) =>+flatten :: (NonNeg.C time, Num time, Eq body) =>    RelTime.T time [body] -> Bool flatten xs =    AbsTime.flatten $~ xs  ==~  RelTime.flatten xs  -normalize :: (NonNeg.C time, Ord body) =>+normalize :: (NonNeg.C time, Num time, Ord body) =>    RelTime.T time body -> Bool normalize xs =    AbsTime.normalize $~ xs  ==~  RelTime.normalize xs  -merge :: (NonNeg.C time, Ord body) =>+{-+test fails++1 /. '\DEL' ./ 0 /. '"' ./ 1 /. '}' ./ 0 /. empty+0 /. '\DEL' ./ 1 /. '}' ./ 0 /. '\DEL' ./ 1 /. empty+++4 /. '|' ./ 0 /. '!' ./ 3 /. '"' ./ 1 /. '!' ./ 3 /. empty+1 /. '$' ./ 2 /. '~' ./ 1 /. '|' ./ 1 /. '|' ./ 1 /. empty+-}+merge :: (NonNeg.C time, Num time, Ord body) =>    RelTime.T time body -> RelTime.T time body -> Bool merge xs ys =    AbsTime.merge $~ xs $~ ys  ==~  RelTime.merge xs ys  -insert :: (NonNeg.C time, Ord body) =>+insert :: (NonNeg.C time, Num time, Ord body) =>    time -> body -> RelTime.T time body -> Bool insert t b xs =    AbsTime.insert t b $~ xs  ==~  RelTime.insert t b xs   -append :: (NonNeg.C time, Eq body) =>+append :: (NonNeg.C time, Num time, Eq body) =>    RelTime.T time body -> RelTime.T time body -> Bool append xs ys =    AbsTime.append $~ xs $~ ys  ==~    RelTime.append xs ys -concat :: (NonNeg.C time, Eq body) =>+concat :: (NonNeg.C time, Num time, Eq body) =>    [RelTime.T time body] -> Bool concat xs =    AbsTime.concat (map (RelTime.toAbsoluteEventList 0) xs)  ==~@@ -172,7 +184,7 @@ -}  -decreaseStart :: (NonNeg.C time, Eq body) =>+decreaseStart :: (NonNeg.C time, Num time, Eq body) =>    time -> time -> RelTime.T time body -> Bool decreaseStart dif0 dif1 xs0 =    let difA = min dif0 dif1@@ -182,7 +194,7 @@        RelTime.decreaseStart difA xs  -delay :: (NonNeg.C time, Eq body) =>+delay :: (NonNeg.C time, Num time, Eq body) =>    time -> RelTime.T time body -> Bool delay dif xs =    AbsTime.delay dif $~ xs  ==~@@ -219,18 +231,18 @@  type NonEmptyList time body = ((time, body), RelTime.T time body) -makeUncollapsedInfiniteEventList :: (NonNeg.C time) =>+makeUncollapsedInfiniteEventList :: (NonNeg.C time, Num time) =>    NonEmptyList time body -> AbsTime.T time body makeUncollapsedInfiniteEventList =    makeInfiniteEventList .    mapFst (mapFst (1+)) -makeInfiniteEventList :: (NonNeg.C time) =>+makeInfiniteEventList :: (NonNeg.C time, Num time) =>    NonEmptyList time body -> AbsTime.T time body makeInfiniteEventList =    RelTime.toAbsoluteEventList 0 . RelTime.cycle . makeNonEmptyEventList -makeNonEmptyEventList :: (NonNeg.C time) =>+makeNonEmptyEventList :: (NonNeg.C time, Num time) =>    NonEmptyList time body -> RelTime.T time body makeNonEmptyEventList (p, evs) =    uncurry RelTime.cons p evs

@@ -21,8 +21,9 @@  import Data.EventList.Relative.MixedBody ((/.), (./), empty) +import qualified Numeric.NonNegative.Chunky as NonNegChunky import qualified Numeric.NonNegative.Class as NonNeg-import Numeric.NonNegative.Class ((-|))+import Numeric.NonNegative.Class ((-|), zero, add, ) import Data.EventList.Relative.TimeBody (isNormalized)  import Data.Tuple.HT (mapFst, mapPair, )@@ -208,7 +209,7 @@ delayAdditive :: (NonNeg.C time, Eq body) =>    time -> time -> TimeBodyList.T time body -> Bool delayAdditive dif0 dif1 xs =-   TimeBodyList.delay (dif0+dif1) xs ==+   TimeBodyList.delay (add dif0 dif1) xs ==    TimeBodyList.delay dif0 (TimeBodyList.delay dif1 xs)  delayAppendPause :: (NonNeg.C time, Eq body) =>@@ -234,9 +235,9 @@ takeTimeEndPause :: (NonNeg.C time, Ord body) =>    time -> TimeBodyList.T time body -> Bool takeTimeEndPause t xs =-   t == 0 ||+   t == zero ||    t >= TimeBodyList.duration xs ||-   0 <  snd (TimeMixedList.viewTimeR (TimeMixedList.takeTime t xs))+   zero <  snd (TimeMixedList.viewTimeR (TimeMixedList.takeTime t xs))  takeTimeAppendFirst :: (NonNeg.C time, Eq body) =>    time -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool@@ -246,12 +247,12 @@       (TimeMixedList.takeTime t xs)       (TimeMixedList.takeTime (t -| TimeBodyList.duration xs) ys) -takeTimeAppendSecond :: (NonNeg.C time, Eq body) =>+takeTimeAppendSecond :: (NonNeg.C time, Num time, Eq body) =>    time -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool takeTimeAppendSecond t xs ys0 =    -- the second list must not start with a zero pause    let ys = TimeBodyList.delay 1 ys0-       t1 = t+1+       t1 = add t 1    in  TimeMixedList.takeTime (TimeBodyList.duration xs + t1) (TimeBodyList.append xs ys) ==        TimeMixedList.prependBodyEnd xs (TimeMixedList.takeTime t1 ys) @@ -265,26 +266,43 @@ dropTimeNormalize t =    isNormalized . TimeMixedList.dropTime t . TimeBodyList.normalize -takeTimeInfinite :: (NonNeg.C time, Ord body) =>+takeTimeInfinite :: (NonNeg.C time, Num time, Ord body) =>    time -> NonEmptyList time body -> Bool takeTimeInfinite t =    (t == ) . TimeTimeList.duration .    TimeMixedList.takeTime t . makeUncollapsedInfiniteEventList -dropTimeInfinite :: (NonNeg.C time, Ord body) =>+dropTimeInfinite :: (NonNeg.C time, Num time, Ord body) =>    time -> NonEmptyList time body -> Bool dropTimeInfinite t =    checkInfinite . TimeMixedList.dropTime t . makeUncollapsedInfiniteEventList +_splitAtTimeLazyInfinite ::+   (NonNeg.C time, Num time, Ord body, Show time, Show body) =>+   BodyBodyList.T (NonNegChunky.T time) body -> Bool+_splitAtTimeLazyInfinite =+   not . null . show . snd .+   TimeMixedList.splitAtTime 1000000 .+   MixedBodyList.consTime+      (NonNegChunky.fromChunks $ iterate (2-) 1) +_dropTimeLazyInfinite ::+   (NonNeg.C time, Num time, Ord body, Show time, Show body) =>+   BodyBodyList.T (NonNegChunky.T time) body -> Bool+_dropTimeLazyInfinite =+   not . null . show .+   TimeMixedList.dropTime 1000000 .+   MixedBodyList.consTime+      (NonNegChunky.fromChunks $ iterate (2-) 1)  + durationPause :: (NonNeg.C time) =>    time -> Bool durationPause t =    t == TimeBodyList.duration (TimeBodyList.singleton t (error "durationPause: no need to access body")) -durationAppend :: (NonNeg.C time) =>+durationAppend :: (NonNeg.C time, Num time) =>    TimeBodyList.T time body -> TimeBodyList.T time body -> Bool durationAppend xs ys =    TimeBodyList.duration (TimeBodyList.append xs ys)  ==@@ -323,20 +341,20 @@    in  equalPrefix 100 xs (TimeBodyList.cycle xs)  -filterSatisfy :: (Num time) =>+filterSatisfy :: (NonNeg.C time) =>    (body -> Bool) ->    TimeBodyList.T time body -> Bool filterSatisfy p =    all p . TimeBodyList.getBodies . TimeBodyList.filter p -filterProjection :: (Num time, Eq body) =>+filterProjection :: (NonNeg.C time, Eq body) =>    (body -> Bool) ->    TimeBodyList.T time body -> Bool filterProjection p xs =    TimeBodyList.filter p xs ==    TimeBodyList.filter p (TimeBodyList.filter p xs) -filterCommutative :: (Num time, Eq body) =>+filterCommutative :: (NonNeg.C time, Eq body) =>    (body -> Bool) ->    (body -> Bool) ->    TimeBodyList.T time body -> Bool@@ -344,7 +362,7 @@    TimeBodyList.filter p (TimeBodyList.filter q xs) ==    TimeBodyList.filter q (TimeBodyList.filter p xs) -filterComposition :: (Num time, Eq body) =>+filterComposition :: (NonNeg.C time, Eq body) =>    (body -> Bool) ->    (body -> Bool) ->    TimeBodyList.T time body -> Bool@@ -503,6 +521,12 @@    TimeBodyList.insert time0 body0 (TimeBodyList.insert time1 body1 evs)  ==    TimeBodyList.insert time1 body1 (TimeBodyList.insert time0 body0 evs) +{-+Relative.BodyEnd.insert merge: Falsifiable, after 12 tests:+2+'}'+1 /. '%' ./ 1 /. '}' ./ 0 /. ' ' ./ 5 /. 'z' ./ 5 /. '\'' ./ 2 /. '\DEL' ./ 2 /. 'x' ./ 3 /. '\DEL' ./ empty+-} insertMerge :: (NonNeg.C time, Ord body) =>    time -> body -> TimeBodyList.T time body -> Bool insertMerge time body evs =@@ -523,7 +547,7 @@    ==       let (prefix,suffix) = TimeMixedList.splitAtTime time evs       in  TimeBodyList.normalize (TimeMixedList.appendBodyEnd prefix-             (MixedBodyList.consTime 0 (MixedBodyList.consBody body suffix)))+             (MixedBodyList.consTime zero (MixedBodyList.consBody body suffix)))  insertInfinite :: (NonNeg.C time, Ord body) =>    time -> body -> NonEmptyList time body -> Bool@@ -532,21 +556,21 @@   -moveForwardIdentity :: (NonNeg.C time, Ord body) =>+moveForwardIdentity :: (NonNeg.C time, Num time, Ord body) =>    TimeBodyList.T time body -> Bool moveForwardIdentity evs =    evs ==-   TimeBodyList.moveForward (TimeBodyList.mapBody ((,) 0) evs)+   TimeBodyList.moveForward (TimeBodyList.mapBody ((,) zero) evs) -moveForwardAdditive :: (NonNeg.C time, Ord body) =>+moveForwardAdditive :: (NonNeg.C time, Num 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))+      (TimeBodyList.mapBody (mapFst (uncurry add)) evs)) -moveForwardCommutative :: (NonNeg.C time, Ord body) =>+moveForwardCommutative :: (NonNeg.C time, Num time, Ord body) =>    TimeBodyList.T time ((time,time),body) -> Bool moveForwardCommutative evs =    TimeBodyList.normalize (moveForwardLimited (moveForwardLimited@@ -575,16 +599,16 @@ -}  -moveForwardLimited :: (NonNeg.C time) =>+moveForwardLimited :: (NonNeg.C time, Num 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 .+   flip evalState zero .    TimeBodyList.mapM-      (\t -> modify (t+) >> return t)+      (\t -> modify (add t) >> return t)       (\(t,b) -> gets (\tm -> (min t tm, b)))  @@ -619,14 +643,14 @@    TimeBodyList.T time body -> Bool collectCoincidentGaps xs =    let times = TimeBodyList.getTimes (TimeBodyList.collectCoincident xs)-   in  null times || all (0<) (tail times)+   in  null times || all (zero<) (tail times)  collectCoincidentNonEmpty :: (NonNeg.C time, Eq body) =>    TimeBodyList.T time body -> Bool collectCoincidentNonEmpty =    all (not . null) . TimeBodyList.getBodies . TimeBodyList.collectCoincident -collectCoincidentInfinite :: (NonNeg.C time, Eq body) =>+collectCoincidentInfinite :: (NonNeg.C time, Num time, Eq body) =>    NonEmptyList time body -> Bool collectCoincidentInfinite =    checkInfinite .@@ -720,7 +744,7 @@    EventList.insert time body (fst evs)  ==  fst (insert time body evs) -} -appendSingle :: -- (Num time, Ord time, Ord body) =>+appendSingle :: -- (NonNeg.C time, Ord time, Ord body) =>    body -> TimeBodyList.T time body -> EventList.T time body appendSingle body xs =    Disp.foldr EventList.consTime EventList.consBody EventList.empty $@@ -742,7 +766,7 @@ discretize :: (RealFrac time, Integral i) =>    TimeBodyList.T time body -> TimeBodyList.T i body discretize es =-   evalState (Uniform.mapSecondM roundDiff es) 0+   evalState (Uniform.mapSecondM roundDiff es) zero  resample :: (RealFrac time, Integral i) =>    time -> TimeBodyList.T time body -> TimeBodyList.T i body@@ -755,7 +779,7 @@ toAbsoluteEventList start xs =    let ts = Uniform.getSeconds xs        bs = Uniform.getFirsts  xs-       ats = List.scanl (+) start ts+       ats = List.scanl add start ts    in  maybe           (error "padded list always contains one time value")           (\ ~(ats0,lt) -> (zip ats0 bs, lt))@@ -767,11 +791,12 @@  type NonEmptyList time body = (time, body, TimeBodyList.T time body) -makeUncollapsedInfiniteEventList :: (NonNeg.C time) =>+makeUncollapsedInfiniteEventList ::+   (NonNeg.C time, Num time) =>    NonEmptyList time body -> TimeBodyList.T time body makeUncollapsedInfiniteEventList =    makeInfiniteEventList .-   (\(time,body,xs) -> (time+1,body,xs))+   (\(time,body,xs) -> (add time 1, body, xs))  makeInfiniteEventList :: (NonNeg.C time) =>    NonEmptyList time body -> TimeBodyList.T time body@@ -826,17 +851,17 @@      quickCheck (mapBodyComposition toUpper toLower                :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("map time composition",-     quickCheck ((\dt0 dt1 -> mapTimeComposition (dt0+) (dt1+))+     quickCheck ((\dt0 dt1 -> mapTimeComposition (add dt0) (add dt1))                :: TimeDiff -> TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("map time body commutative",-     quickCheck ((\dt -> mapTimeBodyCommutative (dt+) toUpper)+     quickCheck ((\dt -> mapTimeBodyCommutative (add dt) toUpper)                :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :     ("mapBodyInfinite",      quickCheck (mapBodyInfinite toUpper                :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("mapTimeInfinite",-     quickCheck (\dt -> mapTimeInfinite (dt+)+     quickCheck (\dt -> mapTimeInfinite (add dt)                :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("mapNormalize",@@ -894,6 +919,12 @@      quickCheck (takeTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("dropTimeInfinite",      quickCheck (dropTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :+{-+   ("splitAtTimeLazyInfinite",+     quickCheck (splitAtTimeLazyInfinite :: BodyBodyList.T (NonNegChunky.T TimeDiff) ArbChar -> Bool)) :+   ("dropTimeLazyInfinite",+     quickCheck (dropTimeLazyInfinite :: BodyBodyList.T (NonNegChunky.T TimeDiff) ArbChar -> Bool)) :+-}     ("duration pause",      quickCheck (durationPause :: TimeDiff -> Bool)) :

@@ -26,7 +26,7 @@  import qualified Numeric.NonNegative.Chunky as NonNegChunky import qualified Numeric.NonNegative.Class  as NonNeg-import Numeric.NonNegative.Class ((-|), )+import Numeric.NonNegative.Class ((-|), zero, add, ) import Data.EventList.Relative.TimeTime (isNormalized, )  import System.Random (Random, randomR, mkStdGen, )@@ -152,11 +152,88 @@    time -> body -> time -> time -> body -> time -> Bool consInfix t0a b0 t0b t1a b1 t1b =    TimeTimeList.append (t0a /. b0 ./ t0b /. empty) (t1a /. b1 ./ t1b /. empty)-      == (t0a /. b0 ./ (t0b+t1a) /. b1 ./ t1b /. empty)+      == (t0a /. b0 ./ (add t0b t1a) /. b1 ./ t1b /. empty)  +iterate' :: (a -> a) -> a -> [a]+iterate' f =+   let recourse x = ((:) $! x) $ recourse (f x)+   in  recourse +chunkyShow ::+   Int -> Bool+chunkyShow =+   (\t -> t==t) . take 1000000 . show .+   const (NonNegChunky.fromChunks $ iterate' (2-) (1::TimeDiff)) +_chunkyCheck ::+   Int -> Bool+_chunkyCheck =+   (\t -> t==t) .+   take 1000000 .+--   (!!1000000) .+{-+   NonNegChunky.toChunks .+   NonNegChunky.fromChunks .+-}+   iterate' (1+)++{-+With an early implementation of mapTimeTail this resulted in heap exhaustion.+-}+mapTimeTailChunkyInfinite ::+   (NonNeg.C time, Num time, Eq body, Show body) =>+   (body -> body) ->+   BodyTimeList.T (NonNegChunky.T time) body -> Bool+mapTimeTailChunkyInfinite _f =+   (\t -> t==t) . take 1000000 .+   NonNegChunky.toChunks .+   MixedTimeList.switchTimeL const .+{-+   MixedTimeList.switchTimeL+      MixedTimeList.consTime .+-}+   MixedTimeList.consTime+      (NonNegChunky.fromChunks $ iterate' (2-) 1)++{-+mapTimeTailChunkyInfinite ::+   (NonNeg.C time, Num time, Eq body, Show body) =>+   (body -> body) ->+   BodyTimeList.T (NonNegChunky.T time) body -> Bool+mapTimeTailChunkyInfinite f =+   (\t -> t==t) . take 1000000 . show .+   MixedTimeList.mapTimeTail (fmap f) .+   MixedTimeList.consTime+      (NonNegChunky.fromChunks $ iterate (2-) 1)+-}++{-+mapTimeTailChunkyInfinite :: (NonNeg.C time, Eq body) =>+   (body -> body) ->+   BodyTimeList.T (NonNegChunky.T time) body -> Bool+mapTimeTailChunkyInfinite f =+--   not . NonNegChunky.isNull .+--   not . null . NonNegChunky.toChunks .+   (\t -> t==t) . take 1000000 . NonNegChunky.toChunks .+   MixedTimeList.switchTimeL const .+--   TimeTimeList.dropTime 1000000 .+   MixedTimeList.mapTimeTail (fmap f) .+   MixedTimeList.consTime+      (NonNegChunky.fromChunks $ iterate (2-) 1)+++mapTimeTailChunkyInfinite :: (NonNeg.C time, Eq body) =>+   (body -> body) ->+   NonNegChunky.T time ->+   TimeTimeList.T (NonNegChunky.T time) body -> Bool+mapTimeTailChunkyInfinite f time =+   MixedTimeList.mapTimeTail (fmap f) .+   TimeTimeList.delay+      (let infTime = mappend time infTime in infTime)+-}++ mapBodyComposition :: (Eq body2, Eq time) =>    (body0 -> body1) -> (body1 -> body2) -> TimeTimeList.T time body0 -> Bool mapBodyComposition f g evs =@@ -203,12 +280,12 @@ appendLeftIdentity :: (NonNeg.C time, Eq body) =>    TimeTimeList.T time body -> Bool appendLeftIdentity xs =-   TimeTimeList.append (TimeTimeList.pause 0) xs  ==  xs+   TimeTimeList.append (TimeTimeList.pause zero) xs  ==  xs  appendRightIdentity :: (NonNeg.C time, Eq body) =>    TimeTimeList.T time body -> Bool appendRightIdentity xs =-   TimeTimeList.append xs (TimeTimeList.pause 0)  ==  xs+   TimeTimeList.append xs (TimeTimeList.pause zero)  ==  xs  appendAssociative :: (NonNeg.C time, Eq body) =>    TimeTimeList.T time body -> TimeTimeList.T time body -> TimeTimeList.T time body -> Bool@@ -220,7 +297,7 @@    time -> body -> TimeTimeList.T time body -> Bool appendCons time body xs =    TimeTimeList.cons time body xs  ==-   TimeTimeList.append (TimeTimeList.cons time body (TimeTimeList.pause 0)) xs+   TimeTimeList.append (TimeTimeList.cons time body (TimeTimeList.pause zero)) xs  appendSplitAtTime :: (NonNeg.C time, Eq body) =>    time -> TimeTimeList.T time body -> Bool@@ -261,13 +338,13 @@ delayAdditive :: (NonNeg.C time, Eq body) =>    time -> time -> TimeTimeList.T time body -> Bool delayAdditive dif0 dif1 xs =-   TimeTimeList.delay (dif0+dif1) xs ==+   TimeTimeList.delay (add dif0 dif1) xs ==    TimeTimeList.delay dif0 (TimeTimeList.delay dif1 xs)  delayPause :: (NonNeg.C time) =>    time -> time -> Bool delayPause dif0 dif1 =-   let pause = TimeTimeList.pause (dif0+dif1)+   let pause = TimeTimeList.pause (add dif0 dif1)    in  TimeTimeList.delay dif0 (TimeTimeList.pause dif1) ==        (asTypeOf pause (TimeTimeList.cons dif0 () pause)) @@ -294,9 +371,9 @@ takeTimeEndPause :: (NonNeg.C time, Ord body) =>    time -> TimeTimeList.T time body -> Bool takeTimeEndPause t xs =-   t == 0 ||+   t == zero ||    t >= TimeTimeList.duration xs ||-   0 <  snd (TimeMixedList.viewTimeR (TimeTimeList.takeTime t xs))+   zero <  snd (TimeMixedList.viewTimeR (TimeTimeList.takeTime t xs))  takeTimeAppendFirst :: (NonNeg.C time, Eq body) =>    time -> TimeTimeList.T time body -> TimeTimeList.T time body -> Bool@@ -306,7 +383,7 @@       (TimeTimeList.takeTime t xs)       (TimeTimeList.takeTime (t -| TimeTimeList.duration xs) ys) -takeTimeAppendSecond :: (NonNeg.C time, Eq body) =>+takeTimeAppendSecond :: (NonNeg.C time, Num time, Eq body) =>    time -> TimeTimeList.T time body -> TimeTimeList.T time body -> Bool takeTimeAppendSecond t xs0 ys =    -- the first list must not end with a zero pause@@ -324,20 +401,58 @@ dropTimeNormalize t =    isNormalized . TimeTimeList.dropTime t . TimeTimeList.normalize -takeTimeInfinite :: (NonNeg.C time, Ord body) =>+takeTimeInfinite :: (NonNeg.C time, Num time, Ord body) =>    time -> NonEmptyList time body -> Bool takeTimeInfinite t =    (t == ) . TimeTimeList.duration .    TimeTimeList.takeTime t . makeUncollapsedInfiniteEventList -dropTimeInfinite :: (NonNeg.C time, Ord body) =>+dropTimeInfinite :: (NonNeg.C time, Num time, Ord body) =>    time -> NonEmptyList time body -> Bool dropTimeInfinite t =    checkInfinite . TimeTimeList.dropTime t . makeUncollapsedInfiniteEventList +dropTimeLargeInfinite ::+   (NonNeg.C time, Num time, Ord body) =>+   NonEmptyList time body -> Bool+dropTimeLargeInfinite =+   checkInfinite .+   TimeTimeList.dropTime 10000 .+   makeUncollapsedInfiniteEventList  +splitAtTimeLazyInfinite ::+   (NonNeg.C time, Num time, Ord body, Show time, Show body) =>+   BodyTimeList.T (NonNegChunky.T time) body -> Bool+splitAtTimeLazyInfinite =+   not . null . show . snd .+   TimeTimeList.splitAtTime 1000000 .+   MixedTimeList.consTime+      (NonNegChunky.fromChunks $ iterate (2-) 1) +dropTimeLazyInfinite ::+   (NonNeg.C time, Num time, Ord body, Show time, Show body) =>+   BodyTimeList.T (NonNegChunky.T time) body -> Bool+dropTimeLazyInfinite =+   not . null . show .+   TimeTimeList.dropTime 1000000 .+   MixedTimeList.consTime+      (NonNegChunky.fromChunks $ iterate (2-) 1)++{-+dropTimeLazyInfinite ::+   (NonNeg.C time, Num time, Ord body) =>+   BodyTimeList.T (NonNegChunky.T time) body -> Bool+dropTimeLazyInfinite =+   (\t -> t==t) . take 100 . NonNegChunky.toChunks .+   MixedTimeList.switchTimeL const .+   TimeTimeList.dropTime 1000000 .+   MixedTimeList.consTime+      (NonNegChunky.fromChunks $ iterate (2-) 1)+-}+++ durationPause :: (NonNeg.C time) =>    time -> Bool durationPause t =@@ -347,7 +462,7 @@    TimeTimeList.T time body -> TimeTimeList.T time body -> Bool durationAppend xs ys =    TimeTimeList.duration (TimeTimeList.append xs ys)  ==-   TimeTimeList.duration xs + TimeTimeList.duration ys+   TimeTimeList.duration xs `add` TimeTimeList.duration ys  durationMerge :: (NonNeg.C time, Ord body) =>    TimeTimeList.T time body -> TimeTimeList.T time body -> Bool@@ -394,20 +509,20 @@    in  equalPrefix 100 xs (TimeTimeList.cycle xs)  -filterSatisfy :: (Num time) =>+filterSatisfy :: (NonNeg.C time) =>    (body -> Bool) ->    TimeTimeList.T time body -> Bool filterSatisfy p =    all p . TimeTimeList.getBodies . TimeTimeList.filter p -filterProjection :: (Num time, Eq body) =>+filterProjection :: (NonNeg.C time, Eq body) =>    (body -> Bool) ->    TimeTimeList.T time body -> Bool filterProjection p xs =    TimeTimeList.filter p xs ==    TimeTimeList.filter p (TimeTimeList.filter p xs) -filterCommutative :: (Num time, Eq body) =>+filterCommutative :: (NonNeg.C time, Eq body) =>    (body -> Bool) ->    (body -> Bool) ->    TimeTimeList.T time body -> Bool@@ -415,7 +530,7 @@    TimeTimeList.filter p (TimeTimeList.filter q xs) ==    TimeTimeList.filter q (TimeTimeList.filter p xs) -filterComposition :: (Num time, Eq body) =>+filterComposition :: (NonNeg.C time, Eq body) =>    (body -> Bool) ->    (body -> Bool) ->    TimeTimeList.T time body -> Bool@@ -464,23 +579,23 @@    TimeTimeList.append (TimeTimeList.catMaybes xs) (TimeTimeList.catMaybes ys)  -catMaybesRInfinite :: (NonNeg.C time, Eq body) =>+catMaybesRInfinite :: (NonNeg.C time, Num time, Eq body) =>    NonEmptyList time (Maybe body) -> Bool catMaybesRInfinite xs =    {--   @(1+) is needed in order to assert that the accumulated time is infinite+   @(add 1) is needed in order to assert that the accumulated time is infinite    and can be clipped by @min 100@.    -}    let t =          min 100 $-         List.foldr (+) 0 $+         List.foldr add zero $          TimeTimeList.getTimes $          TimeTimeList.catMaybesR $-         TimeTimeList.mapTime (NonNegChunky.fromNumber . (1+)) $+         TimeTimeList.mapTime (NonNegChunky.fromNumber . (add 1)) $          makeInfiniteEventList xs    in  t == t -catMaybesRInitInfinite :: (NonNeg.C time, Eq body) =>+catMaybesRInitInfinite :: (NonNeg.C time, Num time, Eq body) =>    NonEmptyList time body -> Bool catMaybesRInitInfinite xs =    let t =@@ -488,7 +603,7 @@          MixedTimeList.switchTimeL const $          TimeTimeList.catMaybesR $          TimeTimeList.mapBody (const (Nothing::Maybe())) $-         TimeTimeList.mapTime (NonNegChunky.fromNumber . (1+)) $+         TimeTimeList.mapTime (NonNegChunky.fromNumber . (add 1)) $          makeInfiniteEventList xs    in  t == t @@ -506,27 +621,27 @@    TimeTimeList.partitionMaybeR f xs  partitionMaybeRInfinite ::-   (NonNeg.C time, Eq body0, Eq body1) =>+   (NonNeg.C time, Num time, Eq body0, Eq body1) =>    (body0 -> Maybe body1) ->    NonEmptyList time body0 -> Bool partitionMaybeRInfinite f xs =    {--   @(1+) is needed in order to assert that the accumulated time is infinite+   @(add 1) is needed in order to assert that the accumulated time is infinite    and can be clipped by @min 100@.    -}    let timeSum =          min 100 .-         List.foldr (+) 0 .+         List.foldr add zero .          TimeTimeList.getTimes        t =          mapPair (timeSum, timeSum) $          TimeTimeList.partitionMaybeR f $-         TimeTimeList.mapTime (NonNegChunky.fromNumber . (1+)) $+         TimeTimeList.mapTime (NonNegChunky.fromNumber . add 1) $          makeInfiniteEventList xs    in  t == t  partitionMaybeRInitInfinite ::-   (NonNeg.C time, Eq body0, Eq body1) =>+   (NonNeg.C time, Num time, Eq body0, Eq body1) =>    (body0 -> Maybe body1) ->    NonEmptyList time body0 -> Bool partitionMaybeRInitInfinite f xs =@@ -536,7 +651,7 @@        t =          mapPair (initTime, initTime) $          TimeTimeList.partitionMaybeR f $-         TimeTimeList.mapTime (NonNegChunky.fromNumber . (1+)) $+         TimeTimeList.mapTime (NonNegChunky.fromNumber . add 1) $          makeInfiniteEventList xs    in  t == t @@ -554,12 +669,12 @@ mergeLeftIdentity :: (NonNeg.C time, Ord body) =>    TimeTimeList.T time body -> Bool mergeLeftIdentity xs =-   TimeTimeList.merge (TimeTimeList.pause 0) xs  ==  xs+   TimeTimeList.merge (TimeTimeList.pause zero) xs  ==  xs  mergeRightIdentity :: (NonNeg.C time, Ord body) =>    TimeTimeList.T time body -> Bool mergeRightIdentity xs =-   TimeTimeList.merge xs (TimeTimeList.pause 0)  ==  xs+   TimeTimeList.merge xs (TimeTimeList.pause zero)  ==  xs  mergeCommutative :: (NonNeg.C time, Ord body) =>    TimeTimeList.T time body -> TimeTimeList.T time body -> Bool@@ -698,7 +813,7 @@ insertMerge time body evs0 =    let evs = TimeTimeList.normalize evs0    in  TimeTimeList.insert time body evs  ==-       TimeTimeList.merge (TimeTimeList.cons time body $ TimeTimeList.pause 0) evs+       TimeTimeList.merge (TimeTimeList.cons time body $ TimeTimeList.pause zero) evs  insertNormalize :: (NonNeg.C time, Ord body) =>    time -> body -> TimeTimeList.T time body -> Bool@@ -714,7 +829,7 @@    ==       let (prefix,suffix) = TimeTimeList.splitAtTime time evs       in  TimeTimeList.normalize-             (TimeTimeList.append prefix (TimeTimeList.cons 0 body suffix))+             (TimeTimeList.append prefix (TimeTimeList.cons zero body suffix))       --  append prefix (MixedTimeList.consBody body suffix)  insertInfinite :: (NonNeg.C time, Ord body) =>@@ -725,21 +840,21 @@   -moveForwardIdentity :: (NonNeg.C time, Ord body) =>+moveForwardIdentity :: (NonNeg.C time, Num time, Ord body) =>    TimeTimeList.T time body -> Bool moveForwardIdentity evs =    evs ==-   TimeTimeList.moveForward (TimeTimeList.mapBody ((,) 0) evs)+   TimeTimeList.moveForward (TimeTimeList.mapBody ((,) zero) evs) -moveForwardAdditive :: (NonNeg.C time, Ord body) =>+moveForwardAdditive :: (NonNeg.C time, Num 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))+      (TimeTimeList.mapBody (mapFst (uncurry add)) evs)) -moveForwardCommutative :: (NonNeg.C time, Ord body) =>+moveForwardCommutative :: (NonNeg.C time, Num time, Ord body) =>    TimeTimeList.T time ((time,time),body) -> Bool moveForwardCommutative evs =    TimeTimeList.normalize (moveForwardLimited (moveForwardLimited@@ -747,7 +862,7 @@    TimeTimeList.normalize (moveForwardLimited (moveForwardLimited       (TimeTimeList.mapBody (\((t0,t1),b) -> (t1,(t0,b))) evs))) -moveForwardRestricted :: (NonNeg.C time, Ord body) =>+moveForwardRestricted :: (NonNeg.C time, Num time, Ord body) =>    time -> TimeTimeList.T time (time,body) -> Bool moveForwardRestricted maxTime evs0 =    let evs =@@ -758,7 +873,8 @@        &&  mevs  ==  TimeTimeList.moveForwardRestrictedByStrict (\_ _ -> True) maxTime evs        &&  mevs  ==  TimeTimeList.moveForwardRestrictedByQueue (\_ _ -> False) maxTime evs -moveForwardRestrictedInfinity :: (NonNeg.C time, Ord body) =>+moveForwardRestrictedInfinity ::+   (NonNeg.C time, Num time, Ord body) =>    time -> NonEmptyList time (time,body) -> Bool moveForwardRestrictedInfinity maxTime =    checkInfinite .@@ -769,16 +885,16 @@   -moveForwardLimited :: (NonNeg.C time) =>+moveForwardLimited :: (NonNeg.C time, Num 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 .+   flip evalState zero .    TimeTimeList.mapM-      (\t -> modify (t+) >> return t)+      (\t -> modify (add t) >> return t)       (\(t,b) -> gets (\tm -> (min t tm, b)))  @@ -788,7 +904,7 @@    evs ==    TimeTimeList.arrange       (TimeTimeList.mapBody-          (\x -> TimeTimeList.cons 0 x (TimeTimeList.pause 0)) evs)+          (\x -> TimeTimeList.cons zero x (TimeTimeList.pause zero)) evs)  arrangeDelay :: (NonNeg.C time, Ord body) =>    time -> NonEmptyList time body -> Bool@@ -797,8 +913,8 @@    in  TimeTimeList.delay delay evs ==        TimeTimeList.arrange           (TimeTimeList.mapBody-              (\x -> TimeTimeList.cons delay x (TimeTimeList.pause 0)) $-           TimeTimePriv.mapTimeLast (delay+) evs)+              (\x -> TimeTimeList.cons delay x (TimeTimeList.pause zero)) $+           TimeTimePriv.mapTimeLast (add delay) evs)  arrangeSimple :: (NonNeg.C time, Ord body) =>    TimeTimeList.T time (TimeTimeList.T time body) ->@@ -809,10 +925,10 @@    TimeTimeList.foldr       (TimeTimeList.delay)       (TimeTimeList.merge)-      (TimeTimeList.pause 0)+      (TimeTimeList.pause zero)       (TimeTimeList.mapBody TimeTimeList.normalize evs) -arrangeAbsolute :: (NonNeg.C time, Ord body) =>+arrangeAbsolute :: (NonNeg.C time, Num time, Ord body) =>    TimeTimeList.T time (TimeTimeList.T time body) ->    Bool arrangeAbsolute evs =@@ -822,10 +938,10 @@           TimeTimeList.merge              (TimeTimeList.delay t (TimeTimeList.normalize xs)) ys)       (,)-      (TimeTimeList.pause 0, TimeTimeList.pause 0)-      (TimeTimeList.toAbsoluteEventList 0 evs)+      (TimeTimeList.pause zero, TimeTimeList.pause zero)+      (TimeTimeList.toAbsoluteEventList zero evs) -arrangeInfinity :: (NonNeg.C time, Ord body) =>+arrangeInfinity :: (NonNeg.C time, Num time, Ord body) =>    NonEmptyList time (NonEmptyList time body) -> Bool arrangeInfinity =    checkInfinite .@@ -845,14 +961,14 @@    TimeTimeList.T time body -> Bool collectCoincidentGaps xs =    let times = tail (TimeTimeList.getTimes (TimeTimeList.collectCoincident xs))-   in  null times || all (0<) (init times)+   in  null times || all (zero<) (init times)  collectCoincidentNonEmpty :: (NonNeg.C time, Eq body) =>    TimeTimeList.T time body -> Bool collectCoincidentNonEmpty =    all (not . null) . TimeTimeList.getBodies . TimeTimeList.collectCoincident -collectCoincidentInfinite :: (NonNeg.C time, Eq body) =>+collectCoincidentInfinite :: (NonNeg.C time, Num time, Eq body) =>    NonEmptyList time body -> Bool collectCoincidentInfinite =    checkInfinite .@@ -975,7 +1091,7 @@ discretize :: (RealFrac time, Integral i) =>    TimeTimeList.T time body -> TimeTimeList.T i body discretize es =-   evalState (Uniform.mapSecondM roundDiff es) 0+   evalState (Uniform.mapSecondM roundDiff es) zero  resample :: (RealFrac time, Integral i) =>    time -> TimeTimeList.T time body -> TimeTimeList.T i body@@ -988,7 +1104,7 @@ toAbsoluteEventList start xs =    let ts = Uniform.getSeconds xs        bs = Uniform.getFirsts  xs-       ats = List.scanl (+) start ts+       ats = List.scanl add start ts    in  maybe           (error "padded list always contains one time value")           (\ ~(ats0,lt) -> (zip ats0 bs, lt))@@ -1000,11 +1116,12 @@  type NonEmptyList time body = (time, body, TimeTimeList.T time body) -makeUncollapsedInfiniteEventList :: (NonNeg.C time) =>+makeUncollapsedInfiniteEventList ::+   (NonNeg.C time, Num time) =>    NonEmptyList time body -> TimeTimeList.T time body makeUncollapsedInfiniteEventList =    makeInfiniteEventList .-   (\(time,body,xs) -> (time+1,body,xs))+   (\(time,body,xs) -> (add time 1, body, xs))  makeInfiniteEventList :: (NonNeg.C time) =>    NonEmptyList time body -> TimeTimeList.T time body@@ -1071,23 +1188,31 @@      quickCheck (snocTimeBodyInfinite :: TimeDiff -> ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("consInfix",      quickCheck (consInfix :: TimeDiff -> ArbChar -> TimeDiff -> TimeDiff -> ArbChar -> TimeDiff -> Bool)) :+   ("chunkyShow",+     quickCheck chunkyShow) :+{-+   ("chunkyCheck",+     quickCheck chunkyCheck) :+-}+   ("mapTimeTailChunkyInfinite",+     quickCheck (mapTimeTailChunkyInfinite succ :: BodyTimeList.T (NonNegChunky.T TimeDiff) ArbChar -> Bool)) :      ("map body composition",      quickCheck (mapBodyComposition toUpper toLower                :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("map time composition",-     quickCheck ((\dt0 dt1 -> mapTimeComposition (dt0+) (dt1+))+     quickCheck ((\dt0 dt1 -> mapTimeComposition (add dt0) (add dt1))                :: TimeDiff -> TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("map time body commutative",-     quickCheck ((\dt -> mapTimeBodyCommutative (dt+) toUpper)+     quickCheck ((\dt -> mapTimeBodyCommutative (add dt) toUpper)                :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :     ("mapBodyInfinite",      quickCheck (mapBodyInfinite toUpper                :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("mapTimeInfinite",-     quickCheck (\dt -> mapTimeInfinite (dt+)+     quickCheck (\dt -> mapTimeInfinite (add dt)                :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("mapNormalize",@@ -1151,6 +1276,12 @@      quickCheck (takeTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("dropTimeInfinite",      quickCheck (dropTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :+   ("dropTimeLargeInfinite",+     quickCheck (dropTimeLargeInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :+   ("splitAtTimeLazyInfinite",+     quickCheck (splitAtTimeLazyInfinite :: BodyTimeList.T (NonNegChunky.T TimeDiff) ArbChar -> Bool)) :+   ("dropTimeLazyInfinite",+     quickCheck (dropTimeLazyInfinite :: BodyTimeList.T (NonNegChunky.T TimeDiff) ArbChar -> Bool)) :     ("duration pause",      quickCheck (durationPause :: TimeDiff -> Bool)) :

@@ -5,16 +5,20 @@ import qualified Test.Data.EventList.Relative.BodyEnd as RelBodyEnd import qualified Test.Data.EventList.Relative.TimeEnd as RelTimeEnd +import qualified System.IO as IO++ prefix :: String -> [(String, IO ())] -> [(String, IO ())] prefix msg =    map (\(str,test) -> (msg ++ "." ++ str, test))  main :: IO () main =-   mapM_ (\(msg,io) -> putStr (msg++": ") >> io) $-   concat $-      prefix "Absolute.BodyEnd" AbsBodyEnd.tests :-      prefix "Absolute.TimeEnd" AbsTimeEnd.tests :-      prefix "Relative.BodyEnd" RelBodyEnd.tests :-      prefix "Relative.TimeEnd" RelTimeEnd.tests :-      []+   IO.hSetBuffering IO.stdout IO.NoBuffering >>+   (mapM_ (\(msg,io) -> putStr (msg++": ") >> io) $+    concat $+       prefix "Absolute.BodyEnd" AbsBodyEnd.tests :+       prefix "Absolute.TimeEnd" AbsTimeEnd.tests :+       prefix "Relative.BodyEnd" RelBodyEnd.tests :+       prefix "Relative.TimeEnd" RelTimeEnd.tests :+       [])