{- | Copyright : (c) Henning Thielemann 2007 Maintainer : haskell@henning-thielemann.de Stability : stable Portability : Haskell 98 -} module Test.Data.EventList.Absolute.BodyEnd (tests) where import Test.Utility import Test.QuickCheck (test) import qualified Data.EventList.Absolute.TimeBody as AbsBody import qualified Data.EventList.Absolute.TimeBodyPrivate as AbsBodyPriv import qualified Data.EventList.Relative.TimeBody as RelBody import qualified Data.AlternatingList.List.Disparate as Disp -- for testing in GHCi -- import Data.AlternatingList.List.Disparate (empty) -- import Data.AlternatingList.List.Uniform ((/.), (./)) import qualified Data.Char as Char 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 qualified Control.Monad as Monad import Control.Monad.State (State(State), evalState) import Prelude hiding (filter, concat) infixl 5 $~ ($~) :: Num time => (AbsBody.T time body -> a) -> (RelBody.T time body -> a) ($~) f = f . RelBody.toAbsoluteEventList 0 infixl 4 ==~ (==~) :: (Eq body, 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 xs = AbsBody.duration $~ xs == RelBody.duration xs mapBody :: (Eq body1, Num time) => (body0 -> body1) -> RelBody.T time body0 -> Bool mapBody f xs = AbsBody.mapBody f $~ xs ==~ RelBody.mapBody f xs mapBodyM :: (Monad m, Eq body1, NonNeg.C time) => (m (AbsBody.T time body1) -> AbsBody.T time body1) -> (body0 -> m body1) -> RelBody.T time body0 -> Bool mapBodyM run f xs = run (AbsBody.mapBodyM f $~ xs) == run (liftM (RelBody.toAbsoluteEventList 0) (RelBody.mapBodyM f xs)) mapBodyMRandom :: (NonNeg.C time, Random body, Eq body) => Int -> RelBody.T time (body, body) -> Bool mapBodyMRandom seed = mapBodyM (flip evalState (mkStdGen seed)) (State . randomR) filter :: (Eq body, Num time) => (body -> Bool) -> RelBody.T time body -> Bool filter p xs = AbsBody.filter p $~ xs ==~ RelBody.filter p xs {- mapMaybe :: (Num time) => (body0 -> Maybe body1) -> RelBody.T time body0 -> RelBody.T time body1 mapMaybe f = catMaybes . mapBody f -} catMaybes :: (Eq body, Num time) => RelBody.T time (Maybe body) -> Bool catMaybes xs = AbsBody.catMaybes $~ xs ==~ RelBody.catMaybes xs {- Could be implemented more easily in terms of Uniform.partition -} partition :: (Eq body, Num time) => (body -> Bool) -> RelBody.T time body -> Bool partition p xs = AbsBody.partition p $~ xs == -- mapPair (RelBody.toAbsoluteEventList 0, RelBody.toAbsoluteEventList 0) (uncurry $ \ys zs -> (,) $~ ys $~ zs) (RelBody.partition p xs) {- | 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) => (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) => RelBody.T time body -> Bool collectCoincident xs = AbsBody.collectCoincident $~ xs ==~ RelBody.collectCoincident xs collectCoincidentFoldr :: (NonNeg.C time, Eq body) => RelBody.T time body -> Bool collectCoincidentFoldr xs = AbsBody.collectCoincident $~ xs == AbsBody.collectCoincidentFoldr $~ xs collectCoincidentNonLazy :: (NonNeg.C time, Eq body) => RelBody.T time body -> Bool collectCoincidentNonLazy xs = AbsBody.collectCoincident $~ xs == AbsBody.collectCoincidentNonLazy $~ xs collectCoincidentInfinite :: (NonNeg.C time, Eq body) => NonEmptyList time body -> Bool collectCoincidentInfinite = checkInfinite . AbsBody.collectCoincident . makeUncollapsedInfiniteEventList flatten :: (NonNeg.C time, Eq body) => RelBody.T time [body] -> Bool flatten xs = AbsBody.flatten $~ xs ==~ RelBody.flatten xs normalize :: (NonNeg.C time, Ord body) => RelBody.T time body -> Bool normalize xs = AbsBody.normalize $~ xs ==~ RelBody.normalize xs merge :: (NonNeg.C time, Ord body) => 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) => 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) => 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) => [RelBody.T time body] -> Bool concat xs = AbsBody.concat (map (RelBody.toAbsoluteEventList 0) xs) ==~ RelBody.concat xs {- cycle :: (NonNeg.C time) => RelBody.T time body -> RelBody.T time body cycle = concat . List.repeat -} decreaseStart :: (NonNeg.C time, Eq body) => time -> time -> RelBody.T time body -> Bool decreaseStart dif0 dif1 xs0 = let difA = min dif0 dif1 difB = max dif0 dif1 xs = RelBody.delay difB xs0 in AbsBody.decreaseStart difA $~ xs ==~ RelBody.decreaseStart difA xs delay :: (NonNeg.C time, Eq body) => time -> RelBody.T time body -> Bool delay dif xs = AbsBody.delay dif $~ xs ==~ RelBody.delay dif xs {- resample :: (Integral time, Eq body) => time -> RelBody.T (time, time) body -> Bool resample rateInt xs0 = let xs = RelBody.mapTime (\(n,d) -> n % (d+1)) xs0 rate = rateInt % 1 in AbsBody.resample rate $~ xs ==~ (RelBody.resample rate xs `asTypeOf` AbsBody.singleton (undefined::Int) undefined) -} resample :: (Eq body) => TimeDiff -> RelBody.T (TimeDiff, TimeDiff) body -> Bool resample rateInt xs0 = let {- 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. -} xs = RelBody.mapTime ((1e-6 +) . makeFracTime) xs0 rate = timeToDouble rateInt + 1 in AbsBody.resample rate $~ xs ==~ (RelBody.resample rate xs `asTypeOf` RelBody.singleton (undefined::TimeDiff) undefined) resampleInfinite :: (Eq body) => TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) body -> Bool resampleInfinite rateInt = let rate = timeToDouble rateInt + 1 in checkInfinite . (`asTypeOf` AbsBody.singleton (undefined::TimeDiff) undefined) . AbsBody.resample rate . makeInfiniteEventList . mapPair (mapFst makeFracTime, RelBody.mapTime makeFracTime) type NonEmptyList time body = ((time, body), RelBody.T time body) makeUncollapsedInfiniteEventList :: (NonNeg.C time) => NonEmptyList time body -> AbsBody.T time body makeUncollapsedInfiniteEventList = makeInfiniteEventList . mapFst (mapFst (1+)) makeInfiniteEventList :: (NonNeg.C time) => NonEmptyList time body -> AbsBody.T time body makeInfiniteEventList = RelBody.toAbsoluteEventList 0 . RelBody.cycle . makeNonEmptyEventList makeNonEmptyEventList :: (NonNeg.C time) => NonEmptyList time body -> RelBody.T time body makeNonEmptyEventList (p, evs) = uncurry RelBody.cons p evs {- | Pick an arbitrary element from an infinite list and check if it can be evaluated. -} checkInfinite :: (Eq time, Eq body) => AbsBody.T time body -> Bool checkInfinite xs0 = let x = maybe (error "BodyEnd.checkInfinite: empty list") fst $ AbsBody.viewL $ AbsBodyPriv.lift (Disp.drop 100) xs0 in x == x tests :: [(String, IO ())] tests = ("duration", test (duration :: RelBody.T TimeDiff Char -> Bool)) : ("mapBody", test (mapBody Char.toUpper :: RelBody.T TimeDiff Char -> Bool)) : ("mapBodyM", test (mapBodyMRandom :: Int -> RelBody.T TimeDiff (Char, Char) -> Bool)) : ("filter", test (\c -> filter (c<) :: RelBody.T TimeDiff Char -> Bool)) : ("catMaybes", test (catMaybes :: RelBody.T TimeDiff (Maybe Char) -> Bool)) : ("partition", test (\c -> partition (c<) :: RelBody.T TimeDiff Char -> Bool)) : ("slice", test (slice fst :: RelBody.T TimeDiff (Char,Char) -> Bool)) : ("collectCoincident", test (collectCoincident :: RelBody.T TimeDiff Char -> Bool)) : ("collectCoincidentFoldr", test (collectCoincidentFoldr :: RelBody.T TimeDiff Char -> Bool)) : ("collectCoincidentNonLazy", test (collectCoincidentNonLazy :: RelBody.T TimeDiff Char -> Bool)) : ("collectCoincidentInfinite", test (collectCoincidentInfinite :: NonEmptyList TimeDiff Char -> Bool)) : ("flatten", test (flatten :: RelBody.T TimeDiff [Char] -> Bool)) : ("normalize", test (normalize :: RelBody.T TimeDiff Char -> Bool)) : ("merge", test (merge :: RelBody.T TimeDiff Char -> RelBody.T TimeDiff Char -> Bool)) : ("insert", test (insert :: TimeDiff -> Char -> RelBody.T TimeDiff Char -> Bool)) : ("append", test (append :: RelBody.T TimeDiff Char -> RelBody.T TimeDiff Char -> Bool)) : ("concat", test (concat :: [RelBody.T TimeDiff Char] -> Bool)) : ("decreaseStart", test (decreaseStart :: TimeDiff -> TimeDiff -> RelBody.T TimeDiff Char -> Bool)) : ("delay", test (delay :: TimeDiff -> RelBody.T TimeDiff Char -> Bool)) : ("resample", test (resample :: TimeDiff -> RelBody.T (TimeDiff, TimeDiff) Char -> Bool)) : ("resampleInfinite", test (resampleInfinite :: TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) Char -> Bool)) : []