event-list 0.0.8 → 0.0.9

raw patch · 21 files changed

+144/−137 lines, 21 filesdep +utility-htPVP ok

version bump matches the API change (PVP)

Dependencies added: utility-ht

API changes (from Hackage documentation)

Files

• event-list.cabal +2/−1
• src/Data/AlternatingList/List/Disparate.hs +24/−10
• src/Data/AlternatingList/List/Mixed.hs +1/−1
• src/Data/AlternatingList/List/Uniform.hs +25/−8
• src/Data/EventList/Absolute/TimeBody.hs +17/−5
• src/Data/EventList/Absolute/TimeTime.hs +15/−4
• src/Data/EventList/Absolute/TimeTimePrivate.hs +1/−1
• src/Data/EventList/Relative/BodyBody.hs +8/−2
• src/Data/EventList/Relative/BodyTime.hs +10/−2
• src/Data/EventList/Relative/MixedBody.hs +1/−1
• src/Data/EventList/Relative/MixedTime.hs +1/−1
• src/Data/EventList/Relative/TimeBody.hs +17/−6
• src/Data/EventList/Relative/TimeBodyPrivate.hs +1/−1
• src/Data/EventList/Relative/TimeMixed.hs +1/−1
• src/Data/EventList/Relative/TimeTime.hs +13/−2
• src/Data/EventList/Relative/TimeTimePrivate.hs +1/−1
• src/Data/EventList/Utility.hs +1/−81
• src/Test/Data/EventList/Absolute/BodyEnd.hs +1/−3
• src/Test/Data/EventList/Absolute/TimeEnd.hs +1/−3
• src/Test/Data/EventList/Relative/BodyEnd.hs +2/−2
• src/Test/Data/EventList/Relative/TimeEnd.hs +1/−1

@@ -1,5 +1,5 @@ Name:             event-list-Version:          0.0.8+Version:          0.0.9 License:          GPL License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -30,6 +30,7 @@ Library   Build-Depends: non-negative>=0.0 && <0.1   Build-Depends: transformers >=0.0.1 && <0.2+  Build-Depends: utility-ht >=0.0.3 && <0.1   If flag(splitBase)     Build-Depends: base >= 2   Else

@@ -13,6 +13,7 @@    (T,     fromPairList, toPairList,     map, mapFirst, mapSecond,+    concatMonoid, concatMapMonoid,     sequence, sequence_,     mapM, mapM_, mapFirstM, mapSecondM,     getFirsts, getSeconds, length, genericLength,@@ -27,12 +28,12 @@     zipWithFirst, zipWithSecond,    ) where -import qualified Data.EventList.Utility as Utility--import Data.EventList.Utility (mapPair, mapSnd, )+import Data.Tuple.HT (mapSnd, mapPair, )  import qualified Data.List as List+import qualified Data.List.HT as ListHT import qualified Control.Monad as Monad+import Data.Monoid (Monoid, mempty, mappend, )  import Test.QuickCheck (Arbitrary, arbitrary, coarbitrary) @@ -106,7 +107,19 @@ mapSecond g = lift (List.map (mapPairSecond g))  +concatMonoid :: Monoid m =>+   T m m -> m+concatMonoid =+   foldr mappend mappend mempty +concatMapMonoid :: Monoid m =>+   (time -> m) ->+   (body -> m) ->+   T time body -> m+concatMapMonoid f g =+   concatMonoid . map f g++ sequence :: Monad m =>    T (m a) (m b) -> m (T a b) sequence =@@ -114,10 +127,11 @@    Monad.mapM (\(Pair a b) -> Monad.liftM2 Pair a b) .    decons -sequence_ :: Monad m =>-   T (m ()) (m ()) -> m ()+sequence_ :: (Monad m, Monoid d) =>+   T (m d) (m d) -> m d sequence_ =-   Monad.mapM_ (\(Pair a b) -> a >> b) . decons+   foldr (Monad.liftM2 mappend) (Monad.liftM2 mappend) $ return mempty+--   Monad.mapM_ (\(Pair a b) -> Monad.liftM2 mappend a b) . decons   mapM :: Monad m =>@@ -126,8 +140,8 @@ mapM aAction bAction =    sequence . map aAction bAction -mapM_ :: Monad m =>-   (a -> m ()) -> (b -> m ()) -> T a b -> m ()+mapM_ :: (Monad m, Monoid d) =>+   (a -> m d) -> (b -> m d) -> T a b -> m d mapM_ aAction bAction =    sequence_ . map aAction bAction @@ -195,13 +209,13 @@ viewR :: T a b -> Maybe (T a b, (a, b)) viewR =    fmap (mapPair (Cons, \ ~(Pair a b) -> (a, b))) .-   Utility.viewR . decons+   ListHT.viewR . decons  {-# INLINE switchR #-} switchR :: c -> (T a b -> a -> b -> c) -> T a b -> c switchR f g =    maybe f (\ ~(xs, ~(Pair a b)) -> g (Cons xs) a b) .-   Utility.viewR . decons+   ListHT.viewR . decons  {-# INLINE mapLast #-} mapLast :: ((a,b) -> (a,b)) -> T a b -> T a b

@@ -36,7 +36,7 @@  import qualified Control.Monad as Monad -import Data.EventList.Utility (mapPair, mapFst, mapSnd)+import Data.Tuple.HT (mapFst, mapSnd, mapPair, )  import Prelude hiding    (null, foldr, map, concat, sequence, sequence_, mapM, mapM_)

@@ -12,7 +12,9 @@ module Data.AlternatingList.List.Uniform    (T(Cons),     map, mapFirst, mapSecond,-    sequence, sequence_, mapM, mapM_, mapFirstM, mapSecondM,+    concatMonoid, concatMapMonoid,+    sequence, sequence_,+    mapM, mapM_, mapFirstM, mapSecondM,     getFirsts, getSeconds, length, genericLength,     fromFirstList, fromSecondList, fromEitherList,     singleton, isSingleton,@@ -32,11 +34,13 @@ import qualified Control.Monad as Monad import qualified Data.List as List -import Control.Monad (Monad, return, (>>))+import Control.Monad (Monad, return, )+import Data.Monoid (Monoid, mempty, mappend, )  import Test.QuickCheck (Arbitrary, arbitrary, coarbitrary) -import Data.EventList.Utility (toMaybe, mapPair, mapFst, mapSnd)+import Data.Tuple.HT (mapFst, mapSnd, mapPair, )+import Data.Maybe.HT (toMaybe, ) {- this way we cannot access (:) in Hugs import Data.Maybe (Maybe, maybe) import Text.Show (Show, ShowS, showsPrec, showParen, showString)@@ -91,15 +95,28 @@   +concatMonoid :: Monoid m =>+   T m m -> m+concatMonoid =+   foldr mappend mappend mempty++concatMapMonoid :: Monoid m =>+   (time -> m) ->+   (body -> m) ->+   T time body -> m+concatMapMonoid f g =+   concatMonoid . map f g++ sequence :: Monad m =>    T (m a) (m b) -> m (T a b) sequence (Cons b xs) =    Monad.liftM2 Cons b (Disp.sequence xs) -sequence_ :: Monad m =>-   T (m ()) (m ()) -> m ()+sequence_ :: (Monad m, Monoid d) =>+   T (m d) (m d) -> m d sequence_ (Cons b xs) =-   b >> Disp.sequence_ xs+   Monad.liftM2 mappend b $ Disp.sequence_ xs   mapM :: Monad m =>@@ -108,8 +125,8 @@ mapM aAction bAction =    sequence . map aAction bAction -mapM_ :: Monad m =>-   (a -> m ()) -> (b -> m ()) -> T a b -> m ()+mapM_ :: (Monad m, Monoid d) =>+   (a -> m d) -> (b -> m d) -> T a b -> m d mapM_ aAction bAction =    sequence_ . map aAction bAction 

@@ -12,6 +12,7 @@     fromPairList, toPairList,     getTimes, getBodies, duration,     mapBody, mapTime,+    concatMapMonoid,     mapM, mapM_, mapBodyM, mapTimeM,     merge, mergeBy, insert, insertBy,     moveForward,@@ -36,8 +37,13 @@ import qualified Data.List as List import qualified Data.EventList.Utility as Utility -import Data.EventList.Utility-   (mapFst, mapSnd, toMaybe, isMonotonic, isMonotonicLazy, beforeBy)+import Data.Monoid (Monoid, )++import Data.Tuple.HT (mapFst, mapSnd, )+import Data.Maybe.HT (toMaybe, )+import Data.List.HT (isAscending, isAscendingLazy, )+import Data.Function.HT (compose2, )+import Data.EventList.Utility (beforeBy, ) import qualified Control.Monad as Monad import Control.Monad.Trans.State (state, evalState) @@ -108,6 +114,12 @@   +concatMapMonoid :: Monoid m =>+   (time -> m) -> (body -> m) ->+   T time body -> m+concatMapMonoid f g =+   Disp.concatMapMonoid f g . decons+ mapM :: Monad m =>    (time0 -> m time1) -> (body0 -> m body1) ->    T time0 body0 -> m (T time1 body1)@@ -141,7 +153,7 @@    lift       (Disp.zipWithFirst          (\b t -> if b then t else error "times out of order")-         (isMonotonicLazy (getTimes xs)))+         (isAscendingLazy (getTimes xs)))       xs  @@ -268,7 +280,7 @@ isNormalized :: (Ord time, Num time, Ord body) =>    T time body -> Bool isNormalized =-   all isMonotonic . getBodies . collectCoincident+   all isAscending . getBodies . collectCoincident   {- |@@ -345,7 +357,7 @@    T time (time, body) -> T time body moveForward =    fromPairList .-   List.sortBy (Utility.composeDouble compare fst) .+   List.sortBy (compose2 compare fst) .    List.map (\ ~(time,(timeDiff,body)) -> (time - timeDiff, body)) .    toPairList 

@@ -12,7 +12,7 @@     pause, isPause,     viewL, switchL, cons, snoc,     mapBody, mapTime,-    mapM, mapM_, mapBodyM, mapTimeM,+    concatMapMonoid, mapM, mapM_, mapBodyM, mapTimeM,     getTimes, getBodies, duration,     merge, mergeBy, insert, insertBy,     moveForward,@@ -34,12 +34,16 @@ import qualified Data.AlternatingList.List.Mixed as Mixed  import qualified Data.List as List+import qualified Data.List.HT as ListHT import qualified Data.EventList.Utility as Utility -import Data.EventList.Utility (mapPair, mapSnd, toMaybe, isMonotonic)+import Data.Tuple.HT (mapSnd, mapPair, )+import Data.Maybe.HT (toMaybe, )+import Data.List.HT (isAscending, ) import qualified Control.Monad as Monad import Control.Monad.Trans.State (state, evalState) +import Data.Monoid (Monoid, ) import Data.Maybe (fromMaybe)  import Prelude hiding@@ -96,6 +100,13 @@   +concatMapMonoid :: Monoid m =>+   (time -> m) -> (body -> m) ->+   T time body -> m+concatMapMonoid f g =+   Uniform.concatMapMonoid g f . decons++ mapM :: Monad m =>    (time0 -> m time1) -> (body0 -> m body1) ->    T time0 body0 -> m (T time1 body1)@@ -196,7 +207,7 @@ isNormalized :: (Ord time, Num time, Ord body) =>    T time body -> Bool isNormalized =-   all isMonotonic . getBodies . collectCoincident+   all isAscending . getBodies . collectCoincident   @@ -258,7 +269,7 @@        (ts,dur) =           fromMaybe              (error "list of accumulated times is always non-empty")-             (Utility.viewR ts0)+             (ListHT.viewR ts0)    in  snocTime           (TimeBodyPriv.Cons $ Disp.concat $ List.map TimeBodyPriv.decons $            zipWith TimeBodyList.delay ts (List.map (fst . viewTimeR) xs))

@@ -15,7 +15,7 @@ import qualified Data.AlternatingList.List.Uniform as Uniform import qualified Data.AlternatingList.List.Mixed as Mixed -import Data.EventList.Utility (mapFst)+import Data.Tuple.HT (mapFst, )  import qualified Control.Monad as Monad 

@@ -11,7 +11,7 @@ -} module Data.EventList.Relative.BodyBody    (T,-    mapM,+    concatMapMonoid, mapM,    ) where  import Data.EventList.Relative.BodyBodyPrivate@@ -19,11 +19,17 @@ -- import qualified Data.AlternatingList.List.Disparate as Disp import qualified Data.AlternatingList.List.Uniform as Uniform +import Data.Monoid (Monoid, )+ import Prelude hiding (mapM)  +concatMapMonoid :: Monoid m =>+   (time -> m) -> (body -> m) ->+   T time body -> m+concatMapMonoid f g = Uniform.concatMapMonoid f g . decons+ mapM :: Monad m =>    (time0 -> m time1) -> (body0 -> m body1) ->    T time0 body0 -> m (T time1 body1) mapM f g = liftM (Uniform.mapM f g)-

@@ -12,7 +12,7 @@ module Data.EventList.Relative.BodyTime    (T, empty,     fromPairList, toPairList,-    mapM,+    concatMapMonoid, mapM,     foldr, foldrPair,     cons, snoc, viewL, viewR, switchL, switchR,     span,@@ -23,8 +23,10 @@ import qualified Data.AlternatingList.List.Disparate as Disp -- import qualified Data.AlternatingList.List.Uniform as Uniform -import Data.EventList.Utility (mapPair, mapFst, mapSnd, )+import Data.Monoid (Monoid, ) +import Data.Tuple.HT (mapFst, mapSnd, mapPair, )+ import Prelude hiding    (mapM, foldr, span, ) @@ -35,6 +37,12 @@ toPairList :: T time body -> [(body, time)] toPairList = Disp.toPairList . decons ++concatMapMonoid :: Monoid m =>+   (time -> m) -> (body -> m) ->+   T time body -> m+concatMapMonoid f g =+   Disp.concatMapMonoid g f . decons  mapM :: Monad m =>    (time0 -> m time1) -> (body0 -> m body1) ->

@@ -32,7 +32,7 @@  -- import Data.AlternatingList.List.Mixed ((/.), (./)) -import Data.EventList.Utility (mapSnd)+import Data.Tuple.HT (mapSnd, )   consBody, (./) :: body -> TimeBodyList.T time body -> BodyBodyList.T time body

@@ -31,7 +31,7 @@  -- import Data.AlternatingList.List.Mixed ((/.), (./)) -import Data.EventList.Utility (mapSnd)+import Data.Tuple.HT (mapSnd, )  import Prelude hiding    (null, foldr, map, filter, concat, cycle, sequence, sequence_, mapM, mapM_)

@@ -25,7 +25,7 @@     fromPairList, toPairList,     getTimes, getBodies, duration,     mapBody, mapTime,-    mapM, mapM_, mapBodyM, mapTimeM,+    concatMapMonoid, mapM, mapM_, mapBodyM, mapTimeM,     foldr, foldrPair,     merge, mergeBy, insert, insertBy,     moveForward,@@ -51,11 +51,16 @@ import qualified Data.List as List import qualified Data.EventList.Utility as Utility +import Data.Monoid (Monoid, )+ import qualified Numeric.NonNegative.Class as NonNeg-import Data.EventList.Utility (floorDiff, mapFst, mapSnd, toMaybe, isMonotonic, beforeBy)-import Control.Monad.Trans.State (evalState, modify, get, put)+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_, null, foldr, filter, concat, cycle, span, )   @@ -119,6 +124,12 @@   +concatMapMonoid :: Monoid m =>+   (time -> m) -> (body -> m) ->+   T time body -> m+concatMapMonoid f g =+   Disp.concatMapMonoid f g . decons+ mapM :: Monad m =>    (time0 -> m time1) -> (body0 -> m body1) ->    T time0 body0 -> m (T time1 body1)@@ -235,7 +246,7 @@   span :: (body -> Bool) -> T time body -> (T time body, T time body)-span p = Utility.mapPair (Cons, Cons) . Disp.spanSecond p . decons+span p = mapPair (Cons, Cons) . Disp.spanSecond p . decons   {- |@@ -287,7 +298,7 @@ isNormalized :: (NonNeg.C time, Ord body) =>    T time body -> Bool isNormalized =-   all isMonotonic . getBodies . collectCoincident+   all isAscending . getBodies . collectCoincident   

@@ -16,7 +16,7 @@  import qualified Control.Monad as Monad -import Data.EventList.Utility (mapSnd)+import Data.Tuple.HT (mapSnd, )  import Test.QuickCheck (Arbitrary(..)) 

@@ -38,7 +38,7 @@ -- import Data.AlternatingList.List.Mixed ((/.), (./))  import qualified Numeric.NonNegative.Class as NonNeg-import Data.EventList.Utility (mapFst, mapPair)+import Data.Tuple.HT (mapFst, mapPair, )   snocBody :: TimeTimeList.T time body -> body -> TimeBodyList.T time body

@@ -10,6 +10,7 @@ module Data.EventList.Relative.TimeTime    (T,     mapBody, mapTime,+    concatMapMonoid,     mapM, mapM_, mapBodyM, mapTimeM,     getTimes, getBodies, duration,     merge, mergeBy, insert, {- insertBy, -} pad,@@ -43,8 +44,13 @@ import qualified Data.List as List import qualified Data.EventList.Utility as Utility +import Data.Monoid (Monoid, )+ import qualified Numeric.NonNegative.Class as NonNeg-import Data.EventList.Utility (floorDiff, mapPair, mapFst, mapSnd, toMaybe, isMonotonic)+import Data.Tuple.HT (mapFst, mapSnd, mapPair, )+import Data.Maybe.HT (toMaybe, )+import Data.List.HT (isAscending, )+import Data.EventList.Utility (floorDiff, ) import Control.Monad.Trans.State (evalState, modify, get, gets, put, ) import Control.Monad (liftM2, ) @@ -111,6 +117,11 @@   +concatMapMonoid :: Monoid m =>+   (time -> m) -> (body -> m) ->+   T time body -> m+concatMapMonoid f g = Uniform.concatMapMonoid g f . decons+ mapM :: Monad m =>    (time0 -> m time1) -> (body0 -> m body1) ->    T time0 body0 -> m (T time1 body1)@@ -142,7 +153,7 @@ isNormalized :: (NonNeg.C time, Ord body) =>    T time body -> Bool isNormalized =-   all isMonotonic . getBodies . collectCoincident+   all isAscending . getBodies . collectCoincident   {- |

@@ -17,7 +17,7 @@ import qualified Data.AlternatingList.List.Uniform as Uniform import qualified Data.AlternatingList.List.Mixed as Mixed -import Data.EventList.Utility (mapFst, mapSnd)+import Data.Tuple.HT (mapFst, mapSnd, )  import qualified Control.Monad as Monad 

@@ -3,6 +3,7 @@ -- State monad could be avoided by mapAccumL import Control.Monad.Trans.State (State, state, modify, gets, ) import qualified Data.List as List+import Data.Tuple.HT (mapPair, )  {- | Given the time fraction that remains from the preceding event@@ -33,42 +34,7 @@       modify (subtract (fromIntegral n))       return n --- Control.Arrow.***-mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)-mapPair ~(f,g) ~(x,y) = (f x, g y) --- Control.Arrow.first-mapFst :: (a -> c) -> (a,b) -> (c,b)-mapFst f ~(x,y) = (f x, y)---- Control.Arrow.second-mapSnd :: (b -> d) -> (a,b) -> (a,d)-mapSnd g ~(x,y) = (x, g y)---toMaybe :: Bool -> a -> Maybe a-toMaybe False _ = Nothing-toMaybe True  x = Just x---{-|-Given two lists that are ordered-(i.e. @p x y@ holds for subsequent @x@ and @y@)-'mergeBy' them into a list that is ordered, again.--This used for merging event lists with absolute time stamps.--}--mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]-mergeBy p =-   let recourse xl@(x:xs) yl@(y:ys) =-         if p x y then x : recourse xs yl-                  else y : recourse xl ys-       recourse [] yl = yl-       recourse xl [] = xl-   in  recourse-- beforeBy :: (Ord time) =>    (body -> body -> Bool) ->    (time, body) -> (time, body) ->  Bool@@ -77,52 +43,6 @@       LT -> True       EQ -> before me0 me1       GT -> False---{- |-This is a combination of 'init' and 'last'-which avoids memoizing the list-if the last element is accessed after the initial ones.--> let a = [0..10000000::Int] in (last (init a), last a)-> let a = [0..10000000::Int]; (bs,b)=splitInit a in (last bs, b)--}-splitInit :: [a] -> ([a], a)-splitInit (x:xs) =-   if null xs-     then ([], x)-     else mapFst (x:) (splitInit xs)-splitInit [] = error "splitInit: empty list"--propSplitInit :: Eq a => [a] -> Bool-propSplitInit xs =-   splitInit xs  ==  (init xs, last xs)---viewR :: [a] -> Maybe ([a], a)-viewR =-   foldr (\x mxs -> Just (maybe ([],x) (mapFst (x:)) mxs)) Nothing--propViewR :: Eq a => [a] -> Bool-propViewR xs =-   maybe True-      ((init xs, last xs) == )-      (viewR xs)---composeDouble :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)-composeDouble g f x y = g (f x) (f y)--equalField :: Eq b => (a -> b) -> a -> a -> Bool-equalField = composeDouble (==)---isMonotonic :: (Ord a) => [a] -> Bool-isMonotonic = and . isMonotonicLazy--isMonotonicLazy :: (Ord a) => [a] -> [Bool]-isMonotonicLazy xs = zipWith (<=) xs (tail xs)-   slice :: (Eq a) =>

@@ -22,10 +22,8 @@ import System.Random (Random, randomR, mkStdGen) import Control.Monad (liftM) -import qualified Data.EventList.Utility as Utility- import qualified Numeric.NonNegative.Class as NonNeg-import Data.EventList.Utility (mapFst, mapSnd, mapPair)+import Data.Tuple.HT (mapFst, mapSnd, mapPair, ) import qualified Control.Monad as Monad import Control.Monad.Trans.State (state, evalState, ) 

@@ -22,10 +22,8 @@ import System.Random (Random, randomR, mkStdGen) import Control.Monad (liftM) -import qualified Data.EventList.Utility as Utility- import qualified Numeric.NonNegative.Class as NonNeg-import Data.EventList.Utility (mapFst, mapSnd, mapPair)+import Data.Tuple.HT (mapFst, mapSnd, mapPair, ) import qualified Control.Monad as Monad import Control.Monad.Trans.State (state, evalState) 

@@ -25,8 +25,8 @@ import Numeric.NonNegative.Class ((-|)) import Data.EventList.Relative.TimeBody (isNormalized) -import Data.EventList.Utility (mapPair, mapFst, )-import System.Random (Random, randomR, mkStdGen)+import Data.Tuple.HT (mapFst, mapPair, )+import System.Random (Random, randomR, mkStdGen, ) import Control.Monad.Trans.State (state, evalState, gets, modify, ) import Control.Monad (liftM2) import Data.Maybe (isJust)

@@ -32,7 +32,7 @@ import System.Random (Random, randomR, mkStdGen, ) import Control.Monad.Trans.State (state, evalState, gets, modify, ) import Control.Monad (liftM2, )-import Data.EventList.Utility (mapFst, )+import Data.Tuple.HT (mapFst, ) import qualified Data.List as List