event-list 0.0.10.1 → 0.0.11

raw patch · 16 files changed

+448/−141 lines, 16 filesdep ~transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

• event-list.cabal +4/−5
• src/Data/AlternatingList/List/Disparate.hs +12/−2
• src/Data/AlternatingList/List/Mixed.hs +9/−1
• src/Data/AlternatingList/List/Uniform.hs +12/−4
• src/Data/EventList/Absolute/TimeBody.hs +11/−48
• src/Data/EventList/Absolute/TimeBodyPrivate.hs +79/−3
• src/Data/EventList/Relative/BodyBody.hs +2/−2
• src/Data/EventList/Relative/BodyBodyPrivate.hs +23/−1
• src/Data/EventList/Relative/BodyTime.hs +68/−8
• src/Data/EventList/Relative/BodyTimePrivate.hs +26/−1
• src/Data/EventList/Relative/TimeBody.hs +23/−10
• src/Data/EventList/Relative/TimeBodyPrivate.hs +20/−4
• src/Data/EventList/Relative/TimeTime.hs +36/−41
• src/Data/EventList/Relative/TimeTimePrivate.hs +50/−5
• src/Test/Data/EventList/Relative/TimeEnd.hs +72/−6
• src/Test/Utility.hs +1/−0

@@ -1,5 +1,5 @@ Name:             event-list-Version:          0.0.10.1+Version:          0.0.11 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.10.1+  tag:      0.0.11  Flag splitBase   description: Choose the new smaller, split-up base package.@@ -37,8 +37,8 @@  Library   Build-Depends:-    non-negative>=0.0 && <0.1,-    transformers >=0.0.1 && <0.2,+    non-negative >=0.0 && <0.1,+    transformers >=0.1 && <0.3,     utility-ht >=0.0.3 && <0.1,     QuickCheck >=1.1 && <3   If flag(splitBase)@@ -88,7 +88,6 @@   GHC-Options:      -Wall   Hs-Source-Dirs:   src   Main-Is:          Test/Main.hs-  Extensions:       GeneralizedNewtypeDeriving   Other-Modules:     Test.Utility     Test.Data.EventList.Absolute.BodyEnd

@@ -20,7 +20,7 @@     getFirsts, getSeconds, length, genericLength,     empty, singleton, null,     cons, snoc, viewL, viewR, switchL, switchR, mapHead, mapLast,-    foldr, foldrPair,+    foldr, foldrPair, foldl, reverse,     format,     append, concat, cycle,     splitAt, take, drop,@@ -42,7 +42,8 @@ import Test.QuickCheck (Arbitrary, arbitrary, )  import Prelude hiding-   (null, foldr, map, concat, cycle, length, take, drop, splitAt,+   (null, foldr, foldl, map, concat, cycle, length,+    take, drop, splitAt, reverse,     sequence, sequence_, )  @@ -242,7 +243,11 @@ foldrPair f x =    List.foldr (\ ~(Pair a b) -> f a b) x . decons +foldl :: (c -> a -> d) -> (d -> b -> c) -> c -> T a b -> c+foldl f g c0 xs =+   foldr (\a go c -> go (f c a)) (\b go d -> go (g d b)) id xs c0 + append :: T a b -> T a b -> T a b append (Cons xs) = lift (xs++) @@ -251,6 +256,11 @@  cycle :: T a b -> T a b cycle = Cons . List.cycle . decons++-- for a nicer implementation see Mixed+reverse :: T a b -> T b a+reverse =+   foldl (flip (,)) (\ ~(a,xs) b -> cons b a xs) empty   

@@ -22,10 +22,10 @@     mapSecondR, mapSecondLast, mapSecondInit,     appendUniformUniform, appendDisparateUniform, appendUniformDisparate,     concatUniform, concatDisparate,+    reverseUniform, reverseDisparate,     splitAtDisparateUniform, splitAtUniformDisparate, splitAtUniformUniform,     takeDisparate, takeUniform, dropDisparate, dropUniform,     {- spanFirst, spanSecond, spanDisparate, -}-    ) where  @@ -204,6 +204,14 @@ mapSecondInit f = mapSecondR (f,id)  ++reverseUniform :: Uniform.T a b -> Uniform.T a b+reverseUniform =+   Uniform.foldl (flip consFirst) (flip consSecond) Disp.empty++reverseDisparate :: Disp.T a b -> Disp.T b a+reverseDisparate =+   Disp.foldl (flip consSecond) (flip consFirst) Disp.empty   appendUniformUniform :: Uniform.T a b -> Uniform.T b a -> Disp.T b a

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007-2009+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -19,8 +19,8 @@     getFirsts, getSeconds, length, genericLength,     fromFirstList, fromSecondList, fromEitherList,     singleton, isSingleton,-    cons, snoc, mapSecondHead,-    foldr,+    cons, snoc, reverse, mapSecondHead,+    foldr, foldl,     format,     filterFirst, partitionFirst, partitionMaybeFirst,     partitionEitherFirst, unzipEitherFirst,@@ -52,7 +52,7 @@     Eq, Ord, Show, (>)) -} import Prelude hiding-   (null, foldr, map, concat, length, sequence, sequence_, )+   (null, foldr, foldl, map, concat, length, reverse, sequence, sequence_, )   {- |@@ -206,6 +206,14 @@ 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 +foldl :: (c -> a -> d) -> (d -> b -> c) -> d -> T a b -> c+foldl f g d0 xs =+   foldr (\a go c -> go (f c a)) (\b go d -> go (g d b)) id xs d0++-- for a nicer implementation see Mixed+reverse :: T a b -> T a b+reverse =+   foldl (\ ~(Cons a xs) b -> Disp.cons b a xs) (flip Cons) Disp.empty   filterFirst :: (a -> Bool) -> T a b -> T a [b]

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007-2009+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -17,7 +17,8 @@     mapM, mapM_, mapBodyM, mapTimeM,     merge, mergeBy, insert, insertBy,     moveForward,-    decreaseStart, delay, filter, partition, slice, foldr, foldrPair,+    decreaseStart, delay, filter, partition, partitionMaybe,+    slice, foldr, foldrPair,     mapMaybe, catMaybes,     normalize, isNormalized,     collectCoincident, flatten, mapCoincident,@@ -80,15 +81,6 @@ viewR = fmap (mapFst Cons) . Disp.viewR . decons  -{-# INLINE switchL #-}-switchL :: c -> ((time, body) -> T time body -> c) -> T time body -> c-switchL f g = Disp.switchL f (\ t b  -> g (t,b) . Cons) . decons--{-# INLINE switchR #-}-switchR :: c -> (T time body -> (time, body) -> c) -> T time body -> c-switchR f g = Disp.switchR f (\xs t b -> g (Cons xs) (t,b)) . decons-- fromPairList :: [(a,b)] -> T a b fromPairList = Cons . Disp.fromPairList @@ -101,23 +93,9 @@ getTimes :: T time body -> [time] getTimes = Disp.getFirsts . decons -{- |-Duration of an empty event list is considered zero.-However, I'm not sure if this is sound.--}-duration :: Num time => T time body -> time-duration = switchR 0 (const fst)   -mapBody :: (body0 -> body1) -> T time body0 -> T time body1-mapBody f = lift (Disp.mapSecond f)--mapTime :: (time0 -> time1) -> T time0 body -> T time1 body-mapTime f = lift (Disp.mapFirst f)--- concatMapMonoid :: Monoid m =>    (time -> m) -> (body -> m) ->    T time body -> m@@ -216,6 +194,14 @@           (if p b then mapFst else mapSnd) (cons t b))       (empty, empty) +partitionMaybe ::+   (body0 -> Maybe body1) -> T time body0 -> (T time body1, T time body0)+partitionMaybe p =+   foldrPair+      (\ t b ->+          maybe (mapSnd (cons t b)) (mapFst . cons t) (p b))+      (empty, empty)+ {- | Since we need it later for MIDI generation, we will also define a slicing into equivalence classes of events.@@ -390,22 +376,7 @@   -append :: (Ord time, Num time) =>-   T time body -> T time body -> T time body-append xs = lift (Disp.append $~ xs) . delay (duration xs) -concat :: (Ord time, Num time) =>-   [T time body] -> T time body-concat xs =-   let ts = scanl (+) 0 (map duration xs)-   in  Cons $ Disp.concat $ map decons $ zipWith delay ts xs--cycle :: (Ord time, Num time) =>-   T time body -> T time body-cycle = concat . List.repeat--- {- splitAtTime :: (Ord time, Num time) =>    time -> T time body -> (Uniform.T body time, T time body)@@ -441,14 +412,6 @@                then t-dif                else error "decreaseStart: difference too big") b             (mapTime (subtract dif) xs))--delay :: (Ord time, Num time) =>-   time -> T time body -> T time body-delay dif =-   if dif>=0-     then mapTime (dif+)-     else error "delay: negative delay"-   {- |

@@ -12,15 +12,41 @@ -- import qualified Data.AlternatingList.List.Mixed as Mixed  import qualified Control.Monad as Monad-import qualified Control.Applicative as Applicative-+import qualified Data.Foldable as Fold+import qualified Data.Traversable as Trav+import qualified Control.Applicative as App import Control.Applicative (Applicative, )+import Data.Monoid (Monoid, mempty, mappend, mconcat, ) +import Test.QuickCheck (Arbitrary(arbitrary)) +import Prelude hiding (concat, cycle)++ newtype T time body = Cons {decons :: Disp.T time body}    deriving (Eq, Ord, Show)  +instance (Arbitrary time, Arbitrary body) =>+             Arbitrary (T time body) where+   arbitrary = Monad.liftM Cons arbitrary++instance (Num time, Ord time) => Monoid (T time body) where+   mempty = Cons Disp.empty+   mappend = append+   mconcat = concat++instance Functor (T time) where+   fmap f (Cons x) = Cons (Disp.mapSecond f x)++instance Fold.Foldable (T time) where+   foldMap = Trav.foldMapDefault++instance Trav.Traversable (T time) where+   traverse f =+      App.liftA Cons . Disp.traverse App.pure f . decons++ infixl 5 $~  ($~) :: (Disp.T time body -> a) -> (T time body -> a)@@ -35,9 +61,59 @@ liftA :: Applicative m =>    (Disp.T time0 body0 -> m (Disp.T time1 body1)) ->    (T time0 body0 -> m (T time1 body1))-liftA f = Applicative.liftA Cons . f . decons+liftA f = App.liftA Cons . f . decons  liftM :: Monad m =>    (Disp.T time0 body0 -> m (Disp.T time1 body1)) ->    (T time0 body0 -> m (T time1 body1)) liftM f = Monad.liftM Cons . f . decons+++{-# INLINE switchL #-}+switchL :: c -> ((time, body) -> T time body -> c) -> T time body -> c+switchL f g = Disp.switchL f (\ t b  -> g (t,b) . Cons) . decons++{-# INLINE switchR #-}+switchR :: c -> (T time body -> (time, body) -> c) -> T time body -> c+switchR f g = Disp.switchR f (\xs t b -> g (Cons xs) (t,b)) . decons+++mapBody :: (body0 -> body1) -> T time body0 -> T time body1+mapBody f = lift (Disp.mapSecond f)++mapTime :: (time0 -> time1) -> T time0 body -> T time1 body+mapTime f = lift (Disp.mapFirst f)+++{- |+Duration of an empty event list is considered zero.+However, I'm not sure if this is sound.+-}+duration :: Num time => T time body -> time+duration = switchR 0 (const fst)++delay :: (Ord time, Num time) =>+   time -> T time body -> T time body+delay dif =+   if dif>=0+     then mapTime (dif+)+     else error "delay: negative delay"+++append :: (Ord time, Num time) =>+   T time body -> T time body -> T time body+append xs = lift (Disp.append $~ xs) . delay (duration xs)++concat :: (Ord time, Num time) =>+   [T time body] -> T time body+concat xs =+   let ts = scanl (+) 0 (map duration xs)+   in  Cons $ Disp.concat $ map decons $ zipWith delay ts xs++{-+Unfortunately in absolute lists we cannot use sharing as in List.cycle+since the start times of the later lists are greater.+-}+cycle :: (Ord time, Num time) =>+   T time body -> T time body+cycle = concat . repeat

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007-2009+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -11,7 +11,7 @@ -} module Data.EventList.Relative.BodyBody    (T,-    concatMapMonoid, mapM,+    concatMapMonoid, traverse, mapM,    ) where  import Data.EventList.Relative.BodyBodyPrivate

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -12,6 +12,9 @@ -- import qualified Data.AlternatingList.List.Mixed as Mixed  import qualified Control.Monad as Monad+import qualified Data.Foldable as Fold+import qualified Data.Traversable as Trav+import qualified Control.Applicative as App  import Test.QuickCheck (Arbitrary(arbitrary)) @@ -27,6 +30,25 @@ instance (Arbitrary time, Arbitrary body) =>              Arbitrary (T time body) where    arbitrary = Monad.liftM Cons arbitrary+++{-+instance Monoid (T time body) where++mempty cannot be defined++mappend could be defined by inserting a time difference of zero+-}++instance Functor (T time) where+   fmap f (Cons x) = Cons (Uniform.mapSecond f x)++instance Fold.Foldable (T time) where+   foldMap = Trav.foldMapDefault++instance Trav.Traversable (T time) where+   traverse f =+      App.liftA Cons . Uniform.traverse App.pure f . decons   infixl 5 $**

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007-2009+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -10,9 +10,14 @@  -} module Data.EventList.Relative.BodyTime-   (T, empty,+   (T,+    empty, singleton, null,     fromPairList, toPairList,-    concatMapMonoid, traverse, mapM,+    getTimes, getBodies, duration, durationR,+    mapBody, mapTime,+    concatMapMonoid,+    traverse, traverse_, traverseBody, traverseTime,+    mapM, mapM_, mapBodyM, mapTimeM,     foldr, foldrPair,     cons, snoc, viewL, viewR, switchL, switchR,     span,@@ -23,13 +28,14 @@ import qualified Data.AlternatingList.List.Disparate as Disp -- import qualified Data.AlternatingList.List.Uniform as Uniform -import Control.Applicative (Applicative, WrappedMonad(WrapMonad, unwrapMonad), liftA, )-import Data.Monoid (Monoid, )+import Control.Applicative (Applicative, WrappedMonad(WrapMonad, unwrapMonad), )+import Data.Monoid (Monoid, mempty, )  import Data.Tuple.HT (mapFst, mapSnd, mapPair, )+import qualified Data.List as List  import Prelude hiding-   (mapM, foldr, span, )+   (mapM, mapM_, foldr, span, null, )   fromPairList :: [(body, time)] -> T time body@@ -38,7 +44,26 @@ toPairList :: T time body -> [(body, time)] toPairList = Disp.toPairList . decons +getBodies :: T time body -> [body]+getBodies = Disp.getFirsts . decons +getTimes :: T time body -> [time]+getTimes = Disp.getSeconds . decons++duration :: Num time => T time body -> time+duration = sum . getTimes++durationR :: Num time => T time body -> time+durationR = List.foldr (+) 0 . getTimes+++mapBody :: (body0 -> body1) -> T time body0 -> T time body1+mapBody f = lift (Disp.mapFirst f)++mapTime :: (time0 -> time1) -> T time0 body -> T time1 body+mapTime f = lift (Disp.mapSecond f)++ concatMapMonoid :: Monoid m =>    (time -> m) -> (body -> m) ->    T time body -> m@@ -49,15 +74,44 @@    (time0 -> m time1) -> (body0 -> m body1) ->    T time0 body0 -> m (T time1 body1) traverse timeAction bodyAction =-   liftA Cons . Disp.traverse bodyAction timeAction . decons+   liftA (Disp.traverse bodyAction timeAction) +traverse_ :: Applicative m =>+   (time -> m ()) -> (body -> m ()) ->+   T time body -> m ()+traverse_ f g = Disp.traverse_ g f . decons++traverseBody :: Applicative m =>+   (body0 -> m body1) -> T time body0 -> m (T time body1)+traverseBody f = liftA (Disp.traverseFirst f)++traverseTime :: Applicative m =>+   (time0 -> m time1) -> T time0 body -> m (T time1 body)+traverseTime f = liftA (Disp.traverseSecond f)++ mapM :: Monad m =>    (time0 -> m time1) -> (body0 -> m body1) ->    T time0 body0 -> m (T time1 body1) mapM timeAction bodyAction =    unwrapMonad . traverse (WrapMonad . timeAction) (WrapMonad . bodyAction) +mapM_ :: Monad m =>+   (time -> m ()) -> (body -> m ()) ->+   T time body -> m ()+mapM_ f g =+   unwrapMonad . traverse_ (WrapMonad . f) (WrapMonad . g) ++mapBodyM :: Monad m =>+   (body0 -> m body1) -> T time body0 -> m (T time body1)+mapBodyM f = unwrapMonad . traverseBody (WrapMonad . f)++mapTimeM :: Monad m =>+   (time0 -> m time1) -> T time0 body -> m (T time1 body)+mapTimeM f = unwrapMonad . traverseTime (WrapMonad . f)++ foldr :: (body -> a -> b) -> (time -> b -> a) -> b -> T time body -> b foldr f g x = Disp.foldr f g x . decons @@ -66,7 +120,13 @@   empty :: T time body-empty = Cons Disp.empty+empty = mempty++null :: T time body -> Bool+null = Disp.null . decons++singleton :: body -> time -> T time body+singleton body time = Cons $ Disp.singleton body time   cons :: body -> time -> T time body -> T time body

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -12,6 +12,10 @@ import qualified Data.AlternatingList.List.Mixed as Mixed  import qualified Control.Monad as Monad+import qualified Data.Foldable as Fold+import qualified Data.Traversable as Trav+import qualified Control.Applicative as App+import Data.Monoid (Monoid, mempty, mappend, )  import Test.QuickCheck (Arbitrary(arbitrary)) @@ -28,7 +32,21 @@              Arbitrary (T time body) where    arbitrary = Monad.liftM Cons arbitrary +instance Monoid (T time body) where+   mempty = Cons Disp.empty+   mappend (Cons x) (Cons y) = Cons (Disp.append x y) +instance Functor (T time) where+   fmap f (Cons x) = Cons (Disp.mapFirst f x)++instance Fold.Foldable (T time) where+   foldMap = Trav.foldMapDefault++instance Trav.Traversable (T time) where+   traverse f =+      App.liftA Cons . Disp.traverse f App.pure . decons++ infixl 5 $*~  ($*~) :: (Disp.T body time -> a) -> (T time body -> a)@@ -40,6 +58,11 @@    (T time0 body0 -> T time1 body1) lift f = Cons . f . decons +liftA :: App.Applicative m =>+   (Disp.T body0 time0 -> m (Disp.T body1 time1)) ->+   (T time0 body0 -> m (T time1 body1))+liftA f = App.liftA Cons . f . decons+ liftM :: Monad m =>    (Disp.T body0 time0 -> m (Disp.T body1 time1)) ->    (T time0 body0 -> m (T time1 body1))@@ -52,12 +75,14 @@   +-- mconcat concat :: -- (NonNeg.C time) =>    [T time body] -> T time body concat =    Cons . Disp.concat . map decons  +-- mcycle - if it would be a standard function cycle :: -- (NonNeg.C time) =>    T time body -> T time body cycle = lift Disp.cycle

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007-2009+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -32,7 +32,7 @@     foldr, foldrPair,     merge, mergeBy, insert, insertBy,     moveForward,-    decreaseStart, delay, filter, partition, slice, span,+    decreaseStart, delay, filter, partition, partitionMaybe, slice, span,     mapMaybe, catMaybes,     normalize, isNormalized,     collectCoincident, flatten, mapCoincident,@@ -273,6 +273,17 @@                       else mapSnd (cons t1' b) (recourse t0' 0 es))    in  recourse +partitionMaybe :: (Num time) =>+   (body0 -> Maybe body1) -> T time body0 ->+   (T time body1, T time body0)+partitionMaybe f =+   mapPair (catMaybes, catMaybes) .+   foldrPair (\t a ->+      let mb = f a+          a1 = maybe (Just a) (const Nothing) mb+      in  mapPair (cons t mb, cons t a1))+      (empty, empty)+ {- | Using a classification function we splice the event list into lists, each containing the same class.@@ -386,16 +397,18 @@   -insertBy :: (NonNeg.C time, Ord body) =>+insertBy :: (NonNeg.C time) =>    (body -> body -> Bool) ->    time -> body -> T time body -> T time body-insertBy before t0 me0 =-   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 $ insert (t0-t1) me0 mevs)+insertBy before =+   let recourse t0 me0 =+          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)+   in  recourse   {- |

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007-2009+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -15,9 +15,11 @@ import qualified Data.AlternatingList.List.Mixed as Mixed  import qualified Control.Monad as Monad-import qualified Control.Applicative as Applicative-+import qualified Data.Foldable as Fold+import qualified Data.Traversable as Trav+import qualified Control.Applicative as App import Control.Applicative (Applicative, )+import Data.Monoid (Monoid, mempty, mappend, )  import Data.Tuple.HT (mapSnd, ) @@ -37,7 +39,21 @@              Arbitrary (T time body) where    arbitrary = Monad.liftM Cons arbitrary +instance Monoid (T time body) where+   mempty = Cons Disp.empty+   mappend (Cons x) (Cons y) = Cons (Disp.append x y) +instance Functor (T time) where+   fmap f (Cons x) = Cons (Disp.mapSecond f x)++instance Fold.Foldable (T time) where+   foldMap = Trav.foldMapDefault++instance Trav.Traversable (T time) where+   traverse f =+      App.liftA Cons . Disp.traverse App.pure f . decons++ infixl 5 $~*  ($~*) :: (Disp.T time body -> a) -> (T time body -> a)@@ -52,7 +68,7 @@ liftA :: Applicative m =>    (Disp.T time0 body0 -> m (Disp.T time1 body1)) ->    (T time0 body0 -> m (T time1 body1))-liftA f = Applicative.liftA Cons . f . decons+liftA f = App.liftA Cons . f . decons  liftM :: Monad m =>    (Disp.T time0 body0 -> m (Disp.T time1 body1)) ->

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007-2009+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -19,10 +19,12 @@     moveForward, moveForwardRestricted, moveBackward, arrange, arrangeBy,     moveForwardRestrictedBy,     moveForwardRestrictedByQueue, moveForwardRestrictedByStrict,-    decreaseStart, delay, filter, partition, slice, foldr,+    decreaseStart, delay,+    filter, partition, partitionMaybe, partitionMaybeR, slice,+    foldr, foldl,     pause, isPause, cons, snoc, viewL, viewR, switchL, switchR,     mapMaybe, catMaybes, catMaybesR,-    append, concat, concatNaive, cycle, cycleNaive,+    append, concat, concatNaive, cycle, cycleNaive, reverse,     splitAtTime, takeTime, dropTime,     discretize, resample,     collectCoincident, flatten, mapCoincident,@@ -31,7 +33,6 @@    ) where  import Data.EventList.Relative.TimeTimePrivate as TimeTimePriv-import Data.EventList.Relative.TimeBodyPrivate (($~*))  import qualified Data.EventList.Relative.BodyTimePrivate as BodyTimePriv import qualified Data.EventList.Relative.TimeBody as TimeBodyList@@ -39,14 +40,14 @@ import qualified Data.EventList.Absolute.TimeTimePrivate as AbsoluteEventPriv import qualified Data.EventList.Absolute.TimeTime as AbsoluteEventList -import qualified Data.AlternatingList.List.Disparate as Disp+-- import qualified Data.AlternatingList.List.Disparate as Disp import qualified Data.AlternatingList.List.Uniform as Uniform import qualified Data.AlternatingList.List.Mixed as Mixed  import qualified Data.List as List import qualified Data.EventList.Utility as Utility -import Data.Monoid (Monoid, )+import Data.Monoid (Monoid, mconcat, mappend, )  import qualified Numeric.NonNegative.Class as NonNeg import Data.Tuple.HT (mapFst, mapSnd, mapPair, )@@ -59,7 +60,8 @@ import Control.Applicative (Applicative, WrappedMonad(WrapMonad, unwrapMonad), )  import Prelude hiding-   (null, foldr, map, filter, concat, cycle, sequence, sequence_, mapM, mapM_)+   (null, foldr, foldl, map, filter, concat, cycle, reverse,+    sequence, sequence_, mapM, mapM_)   @@ -203,7 +205,7 @@ merge = mergeBy (<)  {--Could be implemented using as 'splitAt' and 'insert'.+Could be implemented using 'splitAt' and 'insert'. -} mergeBy :: (NonNeg.C time) =>    (body -> body -> Bool) ->@@ -415,16 +417,11 @@ -} append :: (NonNeg.C time) =>    T time body -> T time body -> T time body-append =-   switchTimeR-   (\ xs t -> lift (Mixed.appendDisparateUniform $~* xs) . delay t)+append = mappend  concat :: (NonNeg.C time) =>    [T time body] -> T time body-concat =-   flatten . consTime 0 .-   BodyTimePriv.concat .-   List.map (consBody [] . mapBody (:[]))+concat = mconcat  {- | 'concat' and 'concatNaive' are essentially the same.@@ -497,34 +494,13 @@ decreaseStart dif =    mapTimeHead (subtract dif) -delay :: (NonNeg.C time) =>-   time -> T time body -> T time body-delay dif =-   mapTimeHead (dif+) -{- |---}- collectCoincident :: (NonNeg.C time) => T time body -> T time [body] collectCoincident =    mapTimeInit TimeBodyList.collectCoincident  -flatten :: (Num time) => T time [body] -> T time body-flatten =-   Cons .-   Uniform.foldr-      (Mixed.appendUniformUniform . Uniform.fromSecondList 0)-      Mixed.consSecond    -- consTime-      Disp.empty .---      (\(b:bs) xs -> consBody b (List.foldr (cons 0) xs bs)) empty .-   Uniform.mapSecond sum .-   Uniform.filterFirst (not . List.null) .-   decons -- mapCoincident :: (NonNeg.C time) =>    ([a] -> [b]) -> T time a -> T time b mapCoincident f =@@ -578,7 +554,27 @@    Uniform.partitionFirst p .    decons +partitionMaybe :: (Num time) =>+   (body0 -> Maybe body1) -> T time body0 ->+   (T time body1, T time body0)+partitionMaybe f =+   mapPair (mapTime sum . Cons, mapTime sum . Cons) .+   Uniform.partitionMaybeFirst f .+   decons+ {- |+Cf. 'catMaybesR'+-}+partitionMaybeR :: (Num 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 (Cons, Cons) .+   Uniform.partitionMaybeFirst f .+   decons++{- | Since we need it later for MIDI generation, we will also define a slicing into equivalence classes of events. -}@@ -586,16 +582,15 @@    (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 --}+reverse :: T time body -> T time body+reverse = lift Uniform.reverse   discretize :: (NonNeg.C time, RealFrac time, NonNeg.C i, Integral i) =>

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007-2009+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -13,16 +13,22 @@ import qualified Data.EventList.Relative.BodyTimePrivate as BodyTimeList import qualified Data.EventList.Relative.BodyTimePrivate as BodyTimePriv --- import qualified Data.AlternatingList.List.Disparate as Disp+import Data.EventList.Relative.TimeBodyPrivate (($~*))++import qualified Data.AlternatingList.List.Disparate as Disp import qualified Data.AlternatingList.List.Uniform as Uniform import qualified Data.AlternatingList.List.Mixed as Mixed +import qualified Numeric.NonNegative.Class as NonNeg+ import Data.Tuple.HT (mapFst, mapSnd, )  import qualified Control.Monad as Monad-import qualified Control.Applicative as Applicative-+import qualified Data.Foldable as Fold+import qualified Data.Traversable as Trav+import qualified Control.Applicative as App import Control.Applicative (Applicative, )+import Data.Monoid (Monoid, mempty, mappend, mconcat, )  import Test.QuickCheck (Arbitrary(arbitrary)) @@ -40,6 +46,27 @@    arbitrary = Monad.liftM Cons arbitrary  +instance (NonNeg.C time) => Monoid (T time body) where+   mempty = Cons (Uniform.singleton 0)+   mappend =+      switchTimeR+      (\ xs t -> lift (Mixed.appendDisparateUniform $~* xs) . delay t)+   mconcat =+      flatten . consTime 0 .+      mconcat .+      map (consBody [] . fmap (:[]))++instance Functor (T time) where+   fmap f (Cons x) = Cons (Uniform.mapFirst f x)++instance Fold.Foldable (T time) where+   foldMap = Trav.foldMapDefault++instance Trav.Traversable (T time) where+   traverse f =+      App.liftA Cons . Uniform.traverse f App.pure . decons++ infixl 5 $~~  ($~~) :: (Uniform.T body time -> a) -> (T time body -> a)@@ -54,7 +81,7 @@ liftA :: Applicative m =>    (Uniform.T body0 time0 -> m (Uniform.T body1 time1)) ->    (T time0 body0 -> m (T time1 body1))-liftA f = Applicative.liftA Cons . f . decons+liftA f = App.liftA Cons . f . decons  liftM :: Monad m =>    (Uniform.T body0 time0 -> m (Uniform.T body1 time1)) ->@@ -140,3 +167,21 @@    (TimeBodyList.T time body0 -> TimeBodyList.T time body1) ->    T time body0 -> T time body1 mapTimeInit = lift . Mixed.mapSecondInit . TimeBodyPriv.unlift+++delay :: (NonNeg.C time) =>+   time -> T time body -> T time body+delay dif =+   mapTimeHead (dif+)++flatten :: (Num time) => T time [body] -> T time body+flatten =+   Cons .+   Uniform.foldr+      (Mixed.appendUniformUniform . Uniform.fromSecondList 0)+      Mixed.consSecond    -- consTime+      Disp.empty .+--      (\(b:bs) xs -> consBody b (List.foldr (cons 0) xs bs)) empty .+   Uniform.mapSecond sum .+   Uniform.filterFirst (not . null) .+   decons

@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -20,19 +20,20 @@ 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.MixedTime ((/.), (./), empty, ) -import Data.EventList.Relative.TimeTimePrivate (($~~), lift)+import Data.EventList.Relative.TimeTimePrivate (($~~), lift, )  import qualified Numeric.NonNegative.Chunky as NonNegChunky import qualified Numeric.NonNegative.Class  as NonNeg-import Numeric.NonNegative.Class ((-|))-import Data.EventList.Relative.TimeTime (isNormalized)+import Numeric.NonNegative.Class ((-|), )+import Data.EventList.Relative.TimeTime (isNormalized, )  import System.Random (Random, randomR, mkStdGen, ) import Control.Monad.Trans.State (state, evalState, gets, modify, ) import Control.Monad (liftM2, )-import Data.Tuple.HT (mapFst, )+import Data.Maybe.HT (toMaybe, )+import Data.Tuple.HT (mapFst, mapPair, ) import qualified Data.List as List  @@ -492,6 +493,54 @@    in  t == t  +partitionMaybe :: (NonNeg.C time, Eq body) =>+   (body -> Bool) -> TimeTimeList.T time body -> Bool+partitionMaybe p xs =+   TimeTimeList.partitionMaybe (\x -> toMaybe (p x) x) xs ==+   TimeTimeList.partition p xs++partitionMaybeR :: (NonNeg.C time, Eq body0, Eq body1) =>+   (body0 -> Maybe body1) -> TimeTimeList.T time body0 -> Bool+partitionMaybeR f xs =+   TimeTimeList.partitionMaybe f xs ==+   TimeTimeList.partitionMaybeR f xs++partitionMaybeRInfinite ::+   (NonNeg.C 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+   and can be clipped by @min 100@.+   -}+   let timeSum =+         min 100 .+         List.foldr (+) 0 .+         TimeTimeList.getTimes+       t =+         mapPair (timeSum, timeSum) $+         TimeTimeList.partitionMaybeR f $+         TimeTimeList.mapTime (NonNegChunky.fromNumber . (1+)) $+         makeInfiniteEventList xs+   in  t == t++partitionMaybeRInitInfinite ::+   (NonNeg.C time, Eq body0, Eq body1) =>+   (body0 -> Maybe body1) ->+   NonEmptyList time body0 -> Bool+partitionMaybeRInitInfinite f xs =+   let initTime =+         min 100 .+         MixedTimeList.switchTimeL const+       t =+         mapPair (initTime, initTime) $+         TimeTimeList.partitionMaybeR f $+         TimeTimeList.mapTime (NonNegChunky.fromNumber . (1+)) $+         makeInfiniteEventList xs+   in  t == t++ {- | 'TimeTimeList.merge' preserves normalization of its operands. -}@@ -830,6 +879,13 @@   +reverseAppend :: (NonNeg.C time, Eq body) =>+   TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+reverseAppend xs ys =+   TimeTimeList.reverse (TimeTimeList.append xs ys)  ==+   TimeTimeList.append (TimeTimeList.reverse ys) (TimeTimeList.reverse xs)++ mapBodyMAppend ::    (Monad m, Eq body1, NonNeg.C time) =>    (m (TimeTimeList.T time body1) -> TimeTimeList.T time body1) ->@@ -1131,6 +1187,14 @@      quickCheck (catMaybesRInfinite :: NonEmptyList TimeDiff (Maybe ArbChar) -> Bool)) :    ("catMaybesRInitInfinite",      quickCheck (catMaybesRInitInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :+   ("partitionMaybe",+     quickCheck (\c -> partitionMaybe (c<) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :+   ("partitionMaybeR",+     quickCheck (\c -> partitionMaybeR (\x -> toMaybe (c<x) (fromEnum x)) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :+   ("partitionMaybeRInfinite",+     quickCheck (\c -> partitionMaybeRInfinite (\x -> toMaybe (c<x) (fromEnum x)) :: NonEmptyList TimeDiff ArbChar -> Bool)) :+   ("partitionMaybeRInitInfinite",+     quickCheck (\c -> partitionMaybeRInitInfinite (\x -> toMaybe (c<x) (fromEnum x)) :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("mergeNormalize",      quickCheck (mergeNormalize :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :@@ -1213,6 +1277,8 @@      quickCheck (mapCoincidentComposition reverse reverse :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("mapCoincidentReverse",      quickCheck (mapCoincidentReverse :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :+   ("reverseAppend",+     quickCheck (reverseAppend :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :     ("mapBodyMAppendRandom",      quickCheck (mapBodyMAppendRandom :: Int -> TimeTimeList.T TimeDiff (ArbChar,ArbChar) -> TimeTimeList.T TimeDiff (ArbChar,ArbChar) -> Bool)) :

@@ -1,3 +1,4 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Utility where  import qualified Numeric.NonNegative.Wrapper as NonNeg