diff --git a/event-list.cabal b/event-list.cabal --- a/event-list.cabal +++ b/event-list.cabal @@ -1,5 +1,5 @@ Name: event-list -Version: 0.1.0.2 +Version: 0.1.1 License: GPL License-File: LICENSE Author: Henning Thielemann @@ -17,7 +17,7 @@ The data structures can be used to represent MIDI files, OpenSoundControl message streams, music performances etc. Tested-With: GHC==6.4.1, GHC==6.6.1, GHC==6.8.2 -Cabal-Version: >=1.6 +Cabal-Version: >=1.10 Build-Type: Simple Source-Repository head type: darcs @@ -26,28 +26,25 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/event-list/ - tag: 0.1.0.2 + tag: 0.1.1 Flag splitBase description: Choose the new smaller, split-up base package. -Flag buildTests - description: Build test executables - default: False - Library Build-Depends: non-negative >=0.1 && <0.2, transformers >=0.1 && <0.4, - utility-ht >=0.0.3 && <0.1, - QuickCheck >=1.1 && <3 + utility-ht >=0.0.10 && <0.1, + QuickCheck >=2.1 && <3 If flag(splitBase) - Build-Depends: base >= 2 && <6 + Build-Depends: base >= 2 && <5 Else Build-Depends: special-functors >= 1.0 && <1.1, base >= 1.0 && < 2 + Default-Language: Haskell98 GHC-Options: -Wall Hs-Source-Dirs: src Exposed-Modules: @@ -74,17 +71,19 @@ Data.AlternatingList.List.Uniform Data.AlternatingList.List.Mixed -Executable test - If flag(buildTests) - -- QuickCheck 1.1 has Maybe instance which we need +Test-Suite test + Type: exitcode-stdio-1.0 + Build-Depends: + QuickCheck >=2.1 && <3, + transformers, + non-negative, + utility-ht, + base + If flag(splitBase) Build-Depends: - QuickCheck >=1.1 && <3 - If flag(splitBase) - Build-Depends: - random >=1.0 && <2.0 - Else - Buildable: False + random >=1.0 && <2.0 + Default-Language: Haskell98 GHC-Options: -Wall Hs-Source-Dirs: src Main-Is: Test/Main.hs diff --git a/src/Data/AlternatingList/List/Disparate.hs b/src/Data/AlternatingList/List/Disparate.hs --- a/src/Data/AlternatingList/List/Disparate.hs +++ b/src/Data/AlternatingList/List/Disparate.hs @@ -39,7 +39,7 @@ import Control.Applicative (Applicative, pure, ) import Data.Monoid (Monoid, mempty, mappend, ) -import Test.QuickCheck (Arbitrary, arbitrary, ) +import Test.QuickCheck (Arbitrary(arbitrary, shrink)) import Prelude hiding (null, foldr, foldl, map, concat, cycle, length, @@ -73,10 +73,12 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (Pair a b) where arbitrary = Monad.liftM2 Pair arbitrary arbitrary + shrink (Pair a b) = fmap (uncurry Pair) $ shrink (a,b) instance (Arbitrary a, Arbitrary b) => Arbitrary (T a b) where arbitrary = Monad.liftM Cons arbitrary + shrink (Cons xs) = fmap Cons $ shrink xs fromPairList :: [(a,b)] -> T a b diff --git a/src/Data/AlternatingList/List/Uniform.hs b/src/Data/AlternatingList/List/Uniform.hs --- a/src/Data/AlternatingList/List/Uniform.hs +++ b/src/Data/AlternatingList/List/Uniform.hs @@ -40,7 +40,7 @@ import Control.Applicative (Applicative, pure, ) import Data.Monoid (Monoid, mempty, mappend, ) -import Test.QuickCheck (Arbitrary, arbitrary, ) +import Test.QuickCheck (Arbitrary(arbitrary, shrink)) import Data.Tuple.HT (mapFst, mapSnd, mapPair, ) import Data.Maybe.HT (toMaybe, ) @@ -83,6 +83,7 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (T a b) where arbitrary = Monad.liftM2 Cons arbitrary arbitrary + shrink (Cons x xs) = fmap (uncurry Cons) $ shrink (x,xs) diff --git a/src/Data/EventList/Absolute/TimeBody.hs b/src/Data/EventList/Absolute/TimeBody.hs --- a/src/Data/EventList/Absolute/TimeBody.hs +++ b/src/Data/EventList/Absolute/TimeBody.hs @@ -264,7 +264,7 @@ Disp.empty -flatten :: (Ord time, Num time) => T time [body] -> T time body +flatten :: (Ord time) => T time [body] -> T time body flatten = foldrPair (\t bs xs -> List.foldr (cons t) xs bs) @@ -275,7 +275,7 @@ Apply a function to the lists of coincident events. -} -mapCoincident :: (Ord time, Num time) => +mapCoincident :: (Ord time) => ([a] -> [b]) -> T time a -> T time b mapCoincident f = flatten . mapBody f . collectCoincident diff --git a/src/Data/EventList/Absolute/TimeBodyPrivate.hs b/src/Data/EventList/Absolute/TimeBodyPrivate.hs --- a/src/Data/EventList/Absolute/TimeBodyPrivate.hs +++ b/src/Data/EventList/Absolute/TimeBodyPrivate.hs @@ -18,7 +18,7 @@ import Control.Applicative (Applicative, ) import Data.Monoid (Monoid, mempty, mappend, mconcat, ) -import Test.QuickCheck (Arbitrary(arbitrary)) +import Test.QuickCheck (Arbitrary(arbitrary, shrink)) import Prelude hiding (concat, cycle) @@ -30,6 +30,7 @@ instance (Arbitrary time, Arbitrary body) => Arbitrary (T time body) where arbitrary = Monad.liftM Cons arbitrary + shrink = liftM shrink instance (Num time, Ord time) => Monoid (T time body) where mempty = Cons Disp.empty diff --git a/src/Data/EventList/Absolute/TimeTime.hs b/src/Data/EventList/Absolute/TimeTime.hs --- a/src/Data/EventList/Absolute/TimeTime.hs +++ b/src/Data/EventList/Absolute/TimeTime.hs @@ -208,7 +208,7 @@ decons -flatten :: (Ord time, Num time) => T time [body] -> T time body +flatten :: (Ord time) => T time [body] -> T time body flatten = mapTimeInit TimeBodyList.flatten @@ -216,7 +216,7 @@ Apply a function to the lists of coincident events. -} -mapCoincident :: (Ord time, Num time) => +mapCoincident :: (Ord time) => ([a] -> [b]) -> T time a -> T time b mapCoincident f = flatten . mapBody f . collectCoincident diff --git a/src/Data/EventList/Relative/BodyBodyPrivate.hs b/src/Data/EventList/Relative/BodyBodyPrivate.hs --- a/src/Data/EventList/Relative/BodyBodyPrivate.hs +++ b/src/Data/EventList/Relative/BodyBodyPrivate.hs @@ -16,8 +16,7 @@ import qualified Data.Traversable as Trav import qualified Control.Applicative as App -import Test.QuickCheck (Arbitrary(arbitrary)) - +import Test.QuickCheck (Arbitrary(arbitrary, shrink)) newtype T time body = Cons {decons :: Uniform.T time body} @@ -30,6 +29,7 @@ instance (Arbitrary time, Arbitrary body) => Arbitrary (T time body) where arbitrary = Monad.liftM Cons arbitrary + shrink = liftM shrink {- diff --git a/src/Data/EventList/Relative/BodyTimePrivate.hs b/src/Data/EventList/Relative/BodyTimePrivate.hs --- a/src/Data/EventList/Relative/BodyTimePrivate.hs +++ b/src/Data/EventList/Relative/BodyTimePrivate.hs @@ -17,7 +17,7 @@ import qualified Control.Applicative as App import Data.Monoid (Monoid, mempty, mappend, ) -import Test.QuickCheck (Arbitrary(arbitrary)) +import Test.QuickCheck (Arbitrary(arbitrary, shrink)) @@ -31,6 +31,7 @@ instance (Arbitrary time, Arbitrary body) => Arbitrary (T time body) where arbitrary = Monad.liftM Cons arbitrary + shrink = liftM shrink instance Monoid (T time body) where mempty = Cons Disp.empty diff --git a/src/Data/EventList/Relative/TimeBody.hs b/src/Data/EventList/Relative/TimeBody.hs --- a/src/Data/EventList/Relative/TimeBody.hs +++ b/src/Data/EventList/Relative/TimeBody.hs @@ -39,6 +39,7 @@ append, concat, cycle, discretize, resample, toAbsoluteEventList, fromAbsoluteEventList, + toAbsoluteEventListGen, fromAbsoluteEventListGen, ) where import Data.EventList.Relative.TimeBodyPrivate @@ -538,15 +539,34 @@ -} toAbsoluteEventList :: (Num time) => time -> T time body -> AbsoluteEventList.T time body -toAbsoluteEventList start = - AbsoluteEventPriv.Cons . decons . - flip evalState start . - mapTimeM (\dur -> modify (dur+) >> get) +toAbsoluteEventList = toAbsoluteEventListGen (+) fromAbsoluteEventList :: (Num time) => AbsoluteEventList.T time body -> T time body -fromAbsoluteEventList = - flip evalState 0 . +fromAbsoluteEventList = fromAbsoluteEventListGen (-) 0 + +{- | +Convert from relative time stamps to absolute time stamps +using a custom accumulator function (like @(+)@). +-} +toAbsoluteEventListGen :: + (absTime -> relTime -> absTime) -> + absTime -> T relTime body -> AbsoluteEventList.T absTime body +toAbsoluteEventListGen accum start = + AbsoluteEventPriv.Cons . decons . + flip evalState start . + mapTimeM (\dur -> modify (flip accum dur) >> get) + +{- | +Convert from absolute time stamps to relative time stamps +using custom subtraction (like @(-)@) and zero. +-} +fromAbsoluteEventListGen :: + (absTime -> absTime -> relTime) -> + absTime -> + AbsoluteEventList.T absTime body -> T relTime body +fromAbsoluteEventListGen diff start = + flip evalState start . mapTimeM - (\time -> do lastTime <- get; put time; return (time-lastTime)) . + (\time -> do lastTime <- get; put time; return (diff time lastTime)) . Cons . AbsoluteEventPriv.decons diff --git a/src/Data/EventList/Relative/TimeBodyPrivate.hs b/src/Data/EventList/Relative/TimeBodyPrivate.hs --- a/src/Data/EventList/Relative/TimeBodyPrivate.hs +++ b/src/Data/EventList/Relative/TimeBodyPrivate.hs @@ -23,7 +23,7 @@ import Data.Tuple.HT (mapSnd, ) -import Test.QuickCheck (Arbitrary(arbitrary)) +import Test.QuickCheck (Arbitrary(arbitrary, shrink)) @@ -38,6 +38,7 @@ instance (Arbitrary time, Arbitrary body) => Arbitrary (T time body) where arbitrary = Monad.liftM Cons arbitrary + shrink = liftM shrink instance Monoid (T time body) where mempty = Cons Disp.empty diff --git a/src/Data/EventList/Relative/TimeTimePrivate.hs b/src/Data/EventList/Relative/TimeTimePrivate.hs --- a/src/Data/EventList/Relative/TimeTimePrivate.hs +++ b/src/Data/EventList/Relative/TimeTimePrivate.hs @@ -31,7 +31,7 @@ import Control.Applicative (Applicative, ) import Data.Monoid (Monoid, mempty, mappend, mconcat, ) -import Test.QuickCheck (Arbitrary(arbitrary)) +import Test.QuickCheck (Arbitrary(arbitrary, shrink)) import Prelude hiding (foldr, ) @@ -46,6 +46,7 @@ instance (Arbitrary time, Arbitrary body) => Arbitrary (T time body) where arbitrary = Monad.liftM Cons arbitrary + shrink = liftM shrink instance (NonNeg.C time) => Monoid (T time body) where diff --git a/src/Data/EventList/Utility.hs b/src/Data/EventList/Utility.hs --- a/src/Data/EventList/Utility.hs +++ b/src/Data/EventList/Utility.hs @@ -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 diff --git a/src/Test/Utility.hs b/src/Test/Utility.hs --- a/src/Test/Utility.hs +++ b/src/Test/Utility.hs @@ -3,7 +3,7 @@ import qualified Numeric.NonNegative.Wrapper as NonNeg -import Test.QuickCheck (Arbitrary(arbitrary)) +import Test.QuickCheck (Arbitrary(arbitrary, shrink)) import qualified Data.Char as Char import System.Random (Random, ) @@ -18,6 +18,7 @@ instance Arbitrary ArbChar where arbitrary = liftM (ArbChar . Char.chr . (32+) . flip mod 96) arbitrary + shrink (ArbChar c) = map ArbChar $ shrink c toLower :: ArbChar -> ArbChar toLower (ArbChar c) = ArbChar (Char.toLower c)