event-list 0.1.1.3 → 0.1.2

raw patch · 12 files changed

+141/−39 lines, 12 filesdep +semigroupsdep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: semigroups

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

• event-list.cabal +4/−2
• src/Data/AlternatingList/List/Disparate.hs +6/−0
• src/Data/EventList/Absolute/TimeBody.hs +2/−2
• src/Data/EventList/Absolute/TimeBodyPrivate.hs +4/−0
• src/Data/EventList/Relative/BodyTimePrivate.hs +5/−1
• src/Data/EventList/Relative/TimeBodyPrivate.hs +5/−1
• src/Data/EventList/Relative/TimeMixed.hs +49/−22
• src/Data/EventList/Relative/TimeTimePrivate.hs +4/−0
• src/Test/Data/EventList/Absolute/TimeEnd.hs +3/−5
• src/Test/Data/EventList/Relative/BodyEnd.hs +41/−3
• src/Test/Data/EventList/Relative/TimeEnd.hs +15/−3
• src/Test/Utility.hs +3/−0

@@ -1,5 +1,5 @@ Name:             event-list-Version:          0.1.1.3+Version:          0.1.2 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.1.1.3+  tag:      0.1.2  Flag splitBase   description: Choose the new smaller, split-up base package.@@ -35,6 +35,7 @@   Build-Depends:     non-negative >=0.1 && <0.2,     transformers >=0.1 && <0.6,+    semigroups >=0.1 && <1.0,     utility-ht >=0.0.10 && <0.1,     QuickCheck >=2.1 && <3   If flag(splitBase)@@ -76,6 +77,7 @@   Build-Depends:     QuickCheck >=2.1 && <3,     transformers,+    semigroups,     non-negative,     utility-ht,     base

@@ -125,11 +125,17 @@    lift $ zipWith (\x (Pair a b) -> Pair a (f x b)) xs  +{- |+Counterpart to 'Foldable.fold'.+-} concatMonoid :: Monoid m =>    T m m -> m concatMonoid =    foldr mappend mappend mempty +{- |+Counterpart to 'Foldable.foldMap'.+-} concatMapMonoid :: Monoid m =>    (time -> m) ->    (body -> m) ->

@@ -339,8 +339,8 @@              (_, Nothing) -> xs0              (Just (x,xs), Just (y,ys)) ->                 if beforeBy before x y-                  then uncurry cons x $ mergeBy before xs ys0-                  else uncurry cons y $ mergeBy before ys xs0+                  then uncurry cons x $ recourse xs ys0+                  else uncurry cons y $ recourse ys xs0    in  recourse  {- |

@@ -17,6 +17,7 @@ import qualified Control.Applicative as App import Control.Applicative (Applicative, ) import Data.Monoid (Monoid, mempty, mappend, mconcat, )+import Data.Semigroup (Semigroup, (<>), )  import Test.QuickCheck (Arbitrary(arbitrary, shrink)) @@ -31,6 +32,9 @@              Arbitrary (T time body) where    arbitrary = Monad.liftM Cons arbitrary    shrink = liftM shrink++instance (Num time, Ord time) => Semigroup (T time body) where+   (<>) = append  instance (Num time, Ord time) => Monoid (T time body) where    mempty = Cons Disp.empty

@@ -16,6 +16,7 @@ import qualified Data.Traversable as Trav import qualified Control.Applicative as App import Data.Monoid (Monoid, mempty, mappend, )+import Data.Semigroup (Semigroup, (<>), )  import Test.QuickCheck (Arbitrary(arbitrary, shrink)) @@ -33,9 +34,12 @@    arbitrary = Monad.liftM Cons arbitrary    shrink = liftM shrink +instance Semigroup (T time body) where+   Cons x <> Cons y = Cons (Disp.append x y)+ instance Monoid (T time body) where    mempty = Cons Disp.empty-   mappend (Cons x) (Cons y) = Cons (Disp.append x y)+   mappend = (<>)  instance Functor (T time) where    fmap f (Cons x) = Cons (Disp.mapFirst f x)

@@ -20,6 +20,7 @@ import qualified Control.Applicative as App import Control.Applicative (Applicative, ) import Data.Monoid (Monoid, mempty, mappend, )+import Data.Semigroup (Semigroup, (<>), )  import Data.Tuple.HT (mapSnd, ) @@ -40,9 +41,12 @@    arbitrary = Monad.liftM Cons arbitrary    shrink = liftM shrink +instance Semigroup (T time body) where+   Cons x <> Cons y = Cons (Disp.append x y)+ instance Monoid (T time body) where    mempty = Cons Disp.empty-   mappend (Cons x) (Cons y) = Cons (Disp.append x y)+   mappend = (<>)  instance Functor (T time) where    fmap f (Cons x) = Cons (Disp.mapSecond f x)

@@ -6,8 +6,8 @@ Portability :  Haskell 98  -Event lists starting with a body and ending with a time difference.-+Event lists starting with a time difference+and ending with either a data body or a time difference. -} module Data.EventList.Relative.TimeMixed    (snocBody, snocTime,@@ -18,6 +18,7 @@     mapBodyR, mapBodyLast, mapBodyInit,     appendBodyEnd, prependBodyEnd,     splitAtTime, takeTime, dropTime,+    splitAfterTime, takeAfterTime, dropAfterTime,    ) where  import qualified Data.EventList.Relative.TimeBody as TimeBodyList@@ -38,7 +39,7 @@ -- import Data.AlternatingList.List.Mixed ((/.), (./))  import qualified Numeric.NonNegative.Class as NonNeg-import Data.Tuple.HT (mapFst, mapPair, )+import Data.Tuple.HT (mapFst, mapSnd, mapPair, )   snocBody :: TimeTimeList.T time body -> body -> TimeBodyList.T time body@@ -89,33 +90,41 @@    TimeTimePriv.lift . Mixed.appendDisparateUniform . TimeBodyPriv.decons  +liftSplit ::+   (Disp.T time0 body0 -> (Uniform.T body1 time1, Disp.T time2 body2)) ->+   TimeBodyList.T time0 body0 ->+   (TimeTimeList.T time1 body1, TimeBodyList.T time2 body2)+liftSplit f =+   mapPair (TimeTimePriv.Cons, TimeBodyPriv.Cons) . f . TimeBodyPriv.decons  splitAtTimeAux :: (NonNeg.C time) =>+   (time -> time -> (time, (Bool, time))) ->    time -> Disp.T time body ->    (Uniform.T body time, Disp.T time body)-splitAtTimeAux t0 =-   mapFst Uniform.forceSecondHead .-   Mixed.switchFirstL-      (Mixed.consSecond NonNeg.zero Disp.empty, Disp.empty)-      (\t1 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)+splitAtTimeAux splitTime =+   let go t0 =+         mapFst Uniform.forceSecondHead .+         Mixed.switchFirstL+            (Mixed.consSecond NonNeg.zero Disp.empty, Disp.empty)+            (\t1 xs ->+               let (mt,~(before,dt)) = splitTime 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) $ go dt ys)+                           xs)+   in  go +{- |+At the division time move all zero time differences to the suffix part,+that is we will always split before a group of events.+-} splitAtTime :: (NonNeg.C time) =>    time -> TimeBodyList.T time body ->    (TimeTimeList.T time body, TimeBodyList.T time body)-splitAtTime t =-   mapPair (TimeTimePriv.Cons, TimeBodyPriv.Cons) .-   splitAtTimeAux t .-   TimeBodyPriv.decons+splitAtTime = liftSplit . splitAtTimeAux NonNeg.split  takeTime :: (NonNeg.C time) =>    time -> TimeBodyList.T time body -> TimeTimeList.T time body@@ -126,3 +135,21 @@ dropTime t = snd . splitAtTime t  +{- |+At the division time move all zero time differences to the prefix part,+that is we will always split after a group of events.+-}+splitAfterTime :: (NonNeg.C time) =>+   time -> TimeBodyList.T time body ->+   (TimeTimeList.T time body, TimeBodyList.T time body)+splitAfterTime =+   liftSplit .+   splitAtTimeAux (\t0 t1 -> mapSnd (mapFst not) $ NonNeg.split t1 t0)++takeAfterTime :: (NonNeg.C time) =>+   time -> TimeBodyList.T time body -> TimeTimeList.T time body+takeAfterTime t = fst . splitAfterTime t++dropAfterTime :: (NonNeg.C time) =>+   time -> TimeBodyList.T time body -> TimeBodyList.T time body+dropAfterTime t = snd . splitAfterTime t

@@ -30,6 +30,7 @@ import qualified Control.Applicative as App import Control.Applicative (Applicative, ) import Data.Monoid (Monoid, mempty, mappend, mconcat, )+import Data.Semigroup (Semigroup, (<>), )  import Test.QuickCheck (Arbitrary(arbitrary, shrink)) @@ -48,6 +49,9 @@    arbitrary = Monad.liftM Cons arbitrary    shrink = liftM shrink ++instance (NonNeg.C time) => Semigroup (T time body) where+   (<>) = append  instance (NonNeg.C time) => Monoid (T time body) where    mempty = Cons (Uniform.singleton zero)

@@ -208,20 +208,18 @@        I add a small amount to the numerator in order        to prevent the case of a fraction like 10.5,        which can be easily rounded to 10 or 11-       depending to previous rounding errors.+       depending on previous rounding errors.        -}        xs = RelTime.mapTime ((1e-6 +) . makeFracTime) xs0        rate = timeToDouble rateInt + 1    in  AbsTime.resample rate $~ xs ==~-       (RelTime.resample rate xs `asTypeOf`-           RelTime.pause (undefined::TimeDiff))+       intTimeList (RelTime.resample rate xs)  resampleInfinite :: (Eq body) =>    TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) body -> Bool resampleInfinite rateInt =    let rate = timeToDouble rateInt + 1-   in  checkInfinite .-       (`asTypeOf` AbsTime.pause (undefined::TimeDiff)) .+   in  checkInfinite . intTimeList .        AbsTime.resample rate .        makeInfiniteEventList .        mapPair (mapFst makeFracTime, RelTime.mapTime makeFracTime)

@@ -27,6 +27,7 @@ import Data.EventList.Relative.TimeBody (isNormalized)  import Data.Tuple.HT (mapFst, mapPair, )+import Data.Bool.HT (implies, ) import System.Random (Random, randomR, mkStdGen, ) import Control.Monad.Trans.State (state, evalState, gets, modify, ) import Control.Monad (liftM2)@@ -174,6 +175,25 @@ appendSplitAtTime t xs =    xs == uncurry TimeMixedList.appendBodyEnd (TimeMixedList.splitAtTime t xs) +appendSplitAfterTime :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> Bool+appendSplitAfterTime t xs =+   xs == uncurry TimeMixedList.appendBodyEnd (TimeMixedList.splitAfterTime t xs)++nonZeroTakeTime :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> Bool+nonZeroTakeTime t xs =+   NonNeg.zero < t && t < TimeBodyList.duration xs+   `implies`+   (TimeMixedList.switchTimeR (\_ t0 -> t0 > NonNeg.zero) $+      TimeMixedList.takeTime t xs)++nonZeroDropAfterTime :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> Bool+nonZeroDropAfterTime t xs =+   MixedBodyList.switchTimeL True (\t0 _ -> t0 > NonNeg.zero) $+      TimeMixedList.dropAfterTime t xs+ mapBodyAppend :: (Eq body1, NonNeg.C time) =>    (body0 -> body1) -> TimeBodyList.T time body0 -> TimeBodyList.T time body0 -> Bool mapBodyAppend f xs ys =@@ -771,8 +791,18 @@    time -> TimeBodyList.T time body -> TimeBodyList.T i body resample rate es =    discretize (mapTime (rate*) es)+-} +resampleInfinite :: (Eq body) =>+   TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) body -> Bool+resampleInfinite rateInt =+   let rate = timeToDouble rateInt + 1+   in  checkInfinite . intTimeList . TimeBodyList.resample rate .+       makeInfiniteEventList .+       mapPair (mapFst makeFracTime, TimeBodyList.mapTime makeFracTime) ++{- toAbsoluteEventList :: (Num time) =>    time -> TimeBodyList.T time body -> AbsoluteEventList.T time body toAbsoluteEventList start xs =@@ -788,14 +818,14 @@   -type NonEmptyList time body = (time, body, TimeBodyList.T time body)+type NonEmptyList time body = ((time, body), TimeBodyList.T time body)  makeUncollapsedInfiniteEventList ::    (NonNeg.C time, Num time) =>    NonEmptyList time body -> TimeBodyList.T time body makeUncollapsedInfiniteEventList =    makeInfiniteEventList .-   (\(time,body,xs) -> (add time 1, body, xs))+   mapFst (\(time,body) -> (add time 1, body))  makeInfiniteEventList :: (NonNeg.C time) =>    NonEmptyList time body -> TimeBodyList.T time body@@ -804,7 +834,7 @@  makeNonEmptyEventList :: (NonNeg.C time) =>    NonEmptyList time body -> TimeBodyList.T time body-makeNonEmptyEventList (t, b, evs) =+makeNonEmptyEventList ((t, b), evs) =    TimeBodyList.cons t b evs  {- |@@ -883,6 +913,12 @@                :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("appendSplitAtTime",      quickCheck (appendSplitAtTime :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :+   ("appendSplitAfterTime",+     quickCheck (appendSplitAfterTime :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :+   ("nonZeroTakeTime",+     quickCheck (nonZeroTakeTime :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :+   ("nonZeroDropAfterTime",+     quickCheck (nonZeroDropAfterTime :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("appendFirstInfinite",      quickCheck (appendFirstInfinite :: NonEmptyList TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("appendSecondInfinite",@@ -1034,5 +1070,7 @@      quickCheck (mapBodyMAppendRandom :: Int -> TimeBodyList.T TimeDiff (ArbChar,ArbChar) -> TimeBodyList.T TimeDiff (ArbChar,ArbChar) -> Bool)) :    ("mapBodyMInfinite",      quickCheck (mapBodyMInfinite :: Int -> NonEmptyList TimeDiff (ArbChar,ArbChar) -> Bool)) :+   ("resampleInfinite",+     quickCheck (resampleInfinite :: TimeDiff -> NonEmptyList (TimeDiff,TimeDiff) ArbChar -> Bool)) :     []

@@ -1097,8 +1097,18 @@    time -> TimeTimeList.T time body -> TimeTimeList.T i body resample rate es =    discretize (mapTime (rate*) es)+-} +resampleInfinite :: (Eq body) =>+   TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) body -> Bool+resampleInfinite rateInt =+   let rate = timeToDouble rateInt + 1+   in  checkInfinite . intTimeList . TimeTimeList.resample rate .+       makeInfiniteEventList .+       mapPair (mapFst makeFracTime, TimeTimeList.mapTime makeFracTime) ++{- toAbsoluteEventList :: (Num time) =>    time -> TimeTimeList.T time body -> AbsoluteEventList.T time body toAbsoluteEventList start xs =@@ -1114,14 +1124,14 @@   -type NonEmptyList time body = (time, body, TimeTimeList.T time body)+type NonEmptyList time body = ((time, body), TimeTimeList.T time body)  makeUncollapsedInfiniteEventList ::    (NonNeg.C time, Num time) =>    NonEmptyList time body -> TimeTimeList.T time body makeUncollapsedInfiniteEventList =    makeInfiniteEventList .-   (\(time,body,xs) -> (add time 1, body, xs))+   mapFst (\(time,body) -> (add time 1, body))  makeInfiniteEventList :: (NonNeg.C time) =>    NonEmptyList time body -> TimeTimeList.T time body@@ -1130,7 +1140,7 @@  makeNonEmptyEventList :: (NonNeg.C time) =>    NonEmptyList time body -> TimeTimeList.T time body-makeNonEmptyEventList (t, b, evs) =+makeNonEmptyEventList ((t, b), evs) =    TimeTimeList.cons t b evs  {- |@@ -1415,5 +1425,7 @@      quickCheck (mapBodyMAppendRandom :: Int -> TimeTimeList.T TimeDiff (ArbChar,ArbChar) -> TimeTimeList.T TimeDiff (ArbChar,ArbChar) -> Bool)) :    ("mapBodyMInfinite",      quickCheck (mapBodyMInfinite :: Int -> NonEmptyList TimeDiff (ArbChar,ArbChar) -> Bool)) :+   ("resampleInfinite",+     quickCheck (resampleInfinite :: TimeDiff -> NonEmptyList (TimeDiff,TimeDiff) ArbChar -> Bool)) :     []

@@ -36,3 +36,6 @@ makeFracTime :: (TimeDiff, TimeDiff) -> NonNeg.Double makeFracTime (n,d) =    timeToDouble n / (timeToDouble d + 1)++intTimeList :: events TimeDiff body -> events TimeDiff body+intTimeList = id