packages feed

event-list 0.0.7 → 0.0.8

raw patch · 22 files changed

+705/−410 lines, 22 filesdep +transformersdep −mtldep ~QuickCheckdep ~randomPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

Dependencies removed: mtl

Dependency ranges changed: QuickCheck, random

API changes (from Hackage documentation)

+ Data.EventList.Absolute.TimeBody: switchL :: c -> ((time, body) -> T time body -> c) -> T time body -> c
+ Data.EventList.Absolute.TimeBody: switchR :: c -> (T time body -> (time, body) -> c) -> T time body -> c
+ Data.EventList.Absolute.TimeMixed: switchBodyR :: a -> (T time body -> body -> a) -> T time body -> a
+ Data.EventList.Absolute.TimeMixed: switchTimeR :: (T time body -> time -> a) -> T time body -> a
+ Data.EventList.Absolute.TimeTime: switchL :: (time -> a) -> ((time, body) -> T time body -> a) -> T time body -> a
+ Data.EventList.Relative.BodyTime: foldr :: (body -> a -> b) -> (time -> b -> a) -> b -> T time body -> b
+ Data.EventList.Relative.BodyTime: foldrPair :: (body -> time -> a -> a) -> a -> T time body -> a
+ Data.EventList.Relative.BodyTime: span :: (body -> Bool) -> T time body -> (T time body, T time body)
+ Data.EventList.Relative.BodyTime: switchL :: c -> (body -> time -> T time body -> c) -> T time body -> c
+ Data.EventList.Relative.BodyTime: switchR :: c -> (T time body -> body -> time -> c) -> T time body -> c
+ Data.EventList.Relative.MixedBody: switchBodyL :: (body -> T time body -> a) -> T time body -> a
+ Data.EventList.Relative.MixedBody: switchTimeL :: a -> (time -> T time body -> a) -> T time body -> a
+ Data.EventList.Relative.MixedTime: switchBodyL :: a -> (body -> T time body -> a) -> T time body -> a
+ Data.EventList.Relative.MixedTime: switchTimeL :: (time -> T time body -> a) -> T time body -> a
+ Data.EventList.Relative.TimeBody: switchL :: c -> ((time, body) -> T time body -> c) -> T time body -> c
+ Data.EventList.Relative.TimeBody: switchR :: c -> (T time body -> (time, body) -> c) -> T time body -> c
+ Data.EventList.Relative.TimeMixed: switchBodyR :: a -> (T time body -> body -> a) -> T time body -> a
+ Data.EventList.Relative.TimeMixed: switchTimeR :: (T time body -> time -> a) -> T time body -> a
+ Data.EventList.Relative.TimeTime: catMaybesR :: (Num time) => T time (Maybe body) -> T time body
+ Data.EventList.Relative.TimeTime: switchL :: (time -> a) -> ((time, body) -> T time body -> a) -> T time body -> a
+ Data.EventList.Relative.TimeTime: switchR :: (time -> a) -> (T time body -> body -> time -> a) -> T time body -> a

Files

event-list.cabal view
@@ -1,5 +1,5 @@ Name:             event-list-Version:          0.0.7+Version:          0.0.8 License:          GPL License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -29,15 +29,11 @@  Library   Build-Depends: non-negative>=0.0 && <0.1-  Build-Depends: mtl >=1 && <2, QuickCheck >=1 && <2+  Build-Depends: transformers >=0.0.1 && <0.2   If flag(splitBase)-    Build-Depends: base >= 2, random-    -- random is needed for the Test+    Build-Depends: base >= 2   Else     Build-Depends: base >= 1.0 && < 2-    -- From the Monad Template Library we only need the State monad.-    -- If your compiler does not support functional dependencies,-    -- it would be easy to replace that by mapAccumL.    GHC-Options:      -Wall   Hs-Source-Dirs:   src@@ -69,15 +65,16 @@   If !flag(buildTests)     Buildable:         False +  -- QuickCheck 1.1 has Maybe instance which we need+  Build-Depends: QuickCheck >=1.1 && <2   If flag(splitBase)-    Hs-source-dirs:   src, src-2-  Else-    Hs-source-dirs:   src, src-1+    Build-Depends: random >=1.0 && <2.0    GHC-Options:      -Wall+  Hs-Source-Dirs:   src   Main-Is:          Test/Main.hs+  Extensions:       GeneralizedNewtypeDeriving   Other-Modules:-    Test.Instances     Test.Utility     Test.Data.EventList.Absolute.BodyEnd     Test.Data.EventList.Absolute.TimeEnd
− src-2/Test/Instances.hs 
@@ -1,11 +0,0 @@-module Test.Instances where--import Test.QuickCheck (Arbitrary(..))--import Control.Monad (liftM)-import Data.Char (chr)---instance Arbitrary Char where-   arbitrary = liftM (chr . (32+) . flip mod 96) arbitrary-   coarbitrary = undefined
src/Data/AlternatingList/List/Disparate.hs view
@@ -17,7 +17,7 @@     mapM, mapM_, mapFirstM, mapSecondM,     getFirsts, getSeconds, length, genericLength,     empty, singleton, null,-    cons, snoc, viewL, viewR, mapHead, mapLast,+    cons, snoc, viewL, viewR, switchL, switchR, mapHead, mapLast,     foldr, foldrPair,     format,     append, concat, cycle,@@ -29,7 +29,7 @@  import qualified Data.EventList.Utility as Utility -import Data.EventList.Utility (mapPair, mapFst, mapSnd)+import Data.EventList.Utility (mapPair, mapSnd, )  import qualified Data.List as List import qualified Control.Monad as Monad@@ -85,18 +85,23 @@ lift :: ([Pair a0 b0] -> [Pair a1 b1]) -> (T a0 b0 -> T a1 b1) lift f = Cons . f . decons +{-# INLINE mapPairFirst #-} mapPairFirst :: (a0 -> a1) -> Pair a0 b -> Pair a1 b mapPairFirst f e = e{pairFirst = f (pairFirst e)} +{-# INLINE mapPairSecond #-} mapPairSecond :: (b0 -> b1) -> Pair a b0 -> Pair a b1 mapPairSecond f e = e{pairSecond = f (pairSecond e)} +{-# INLINE map #-} map :: (a0 -> a1) -> (b0 -> b1) -> T a0 b0 -> T a1 b1 map f g = lift (List.map (mapPairFirst f . mapPairSecond g)) +{-# INLINE mapFirst #-} mapFirst :: (a0 -> a1) -> T a0 b -> T a1 b mapFirst f = lift (List.map (mapPairFirst f)) +{-# INLINE mapSecond #-} mapSecond :: (b0 -> b1) -> T a b0 -> T a b1 mapSecond g = lift (List.map (mapPairSecond g)) @@ -170,14 +175,21 @@   viewL :: T a b -> Maybe ((a, b), T a b)-viewL (Cons ys) =+viewL =+   switchL Nothing (\a b xs -> Just ((a, b), xs))++{-# INLINE switchL #-}+switchL :: c -> (a -> b -> T a b -> c) -> T a b -> c+switchL f g (Cons ys) =    case ys of-      (Pair a b : xs) -> Just ((a, b), Cons xs)-      [] -> Nothing+      (Pair a b : xs) -> g a b (Cons xs)+      [] -> f +{-# INLINE mapHead #-} mapHead :: ((a,b) -> (a,b)) -> T a b -> T a b mapHead f =-   maybe empty (uncurry (uncurry cons) . mapFst f) . viewL+   switchL empty (curry (uncurry cons . f))+--   maybe empty (uncurry (uncurry cons) . mapFst f) . viewL   viewR :: T a b -> Maybe (T a b, (a, b))@@ -185,6 +197,13 @@    fmap (mapPair (Cons, \ ~(Pair a b) -> (a, b))) .    Utility.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++{-# INLINE mapLast #-} mapLast :: ((a,b) -> (a,b)) -> T a b -> T a b mapLast f =    maybe empty (uncurry (uncurry . snoc) . mapSnd f) . viewR
src/Data/AlternatingList/List/Mixed.hs view
@@ -12,7 +12,10 @@ module Data.AlternatingList.List.Mixed (     consFirst, consSecond, (./), (/.),     snocFirst, snocSecond,-    viewL, viewR, viewFirstL, viewFirstR, viewSecondL, viewSecondR,+    viewL, viewFirstL, viewSecondL,+    viewR, viewFirstR, viewSecondR,+    switchL, switchFirstL, switchSecondL,+    switchR, switchFirstR, switchSecondR,     mapFirstL,  mapFirstHead,  mapFirstTail,     mapSecondL, mapSecondHead, mapSecondTail,     mapFirstR,  mapFirstLast,  mapFirstInit,@@ -77,24 +80,60 @@  viewR :: Uniform.T a b -> (Maybe (Uniform.T a b, a), b) viewR (Uniform.Cons b0 xs0) =-   maybe-     (Nothing, b0)-     (\ (xs, ~(a,b)) -> (Just (consSecond b0 xs, a), b)) $-     Disp.viewR xs0+   Disp.switchR+      (Nothing, b0)+      (\ xs a b -> (Just (consSecond b0 xs, a), b))+      xs0  viewFirstR :: Disp.T b a -> Maybe (Uniform.T a b, a) viewFirstR =    Monad.liftM (\ (xs, ~(a,b)) -> (snocSecond xs a, b)) .    Disp.viewR +{-+TODO:+Must be more lazy in case of+@viewSecondR (2 /. 'a' ./ 3 /. 'b' ./ 4 /. undefined)@.+It must also return the @'b'@ but it does not.+-} viewSecondR :: Uniform.T a b -> (Disp.T b a, b) viewSecondR (Uniform.Cons b0 xs0) =-   maybe+   Disp.switchR       (Disp.empty, b0)-      (\ (xs, ~(a,b)) -> (consFirst b0 (snocSecond xs a), b))-      (Disp.viewR xs0)+      (\ xs a b -> (consFirst b0 (snocSecond xs a), b))+      xs0  +{-# INLINE switchL #-}+switchL :: (b -> c) -> (b -> a -> Uniform.T a b -> c) -> Uniform.T a b -> c+switchL f g =+   switchSecondL (\x -> switchFirstL (f x) (g x))++{-# INLINE switchFirstL #-}+switchFirstL :: c -> (a -> Uniform.T a b -> c) -> Disp.T a b -> c+switchFirstL f g =+   Disp.switchL f (\ a b xs -> g a (consSecond b xs))++{-# INLINE switchSecondL #-}+switchSecondL :: (b -> Disp.T a b -> c) -> Uniform.T a b -> c+switchSecondL f (Uniform.Cons b xs) = f b xs+++{-# INLINE switchR #-}+switchR :: (b -> c) -> (Uniform.T a b -> a -> b -> c) -> Uniform.T a b -> c+switchR f g =+   switchSecondR (\xs b -> switchFirstR (f b) (\ys a -> g ys a b) xs)++{-# INLINE switchFirstR #-}+switchFirstR :: c -> (Uniform.T a b -> a -> c) -> Disp.T b a -> c+switchFirstR f g =+   maybe f (uncurry g) . viewFirstR++{-# INLINE switchSecondR #-}+switchSecondR :: (Disp.T b a -> b -> c) -> Uniform.T a b -> c+switchSecondR f = uncurry f . viewSecondR++ -- could also be in ListDisparate mapFirstL ::    (a -> a, Uniform.T a b0 -> Uniform.T a b1) ->@@ -186,8 +225,8 @@  concatUniform :: Uniform.T (Uniform.T b a) (Uniform.T a b) -> Uniform.T a b concatUniform =-   (\(b,xs) -> appendUniformDisparate b (concatDisparate xs)) .-   viewSecondL+   switchSecondL+   (\ b xs -> appendUniformDisparate b (concatDisparate xs))   @@ -230,8 +269,8 @@ dropUniform :: Int -> Uniform.T a b -> Uniform.T a b dropUniform 0 = id dropUniform n =-   maybe (error "dropUniform: empty list") snd .-   viewFirstL . dropDisparate (pred n)+   switchFirstL (error "dropUniform: empty list") (flip const) .+   dropDisparate (pred n)   {-@@ -242,14 +281,14 @@ breakUniformFirst :: (a -> Bool) ->    Uniform.T a b -> (Uniform.T a b, Disp.T a b) breakUniformFirst p =-   let recurse xs0 =+   let recourse xs0 =           (\(b,xs) ->               if p b                 then (empty, xs0)                 else                   maybe                      (\(a,ys) ->)-                  let (as,) = recurse  xs+                  let (as,) = recourse  xs                   in  ) $           viewSecondL xs0 -}
src/Data/AlternatingList/List/Uniform.hs view
@@ -172,7 +172,7 @@   mapSecondHead :: (b -> b) -> T a b -> T a b-mapSecondHead f (Cons b xs) = Cons (f b) xs+mapSecondHead f ~(Cons b xs) = Cons (f b) xs
src/Data/EventList/Absolute/TimeBody.hs view
@@ -8,7 +8,7 @@ module Data.EventList.Absolute.TimeBody    (T,     empty, singleton, null,-    viewL, viewR, cons, snoc,+    viewL, viewR, switchL, switchR, cons, snoc,     fromPairList, toPairList,     getTimes, getBodies, duration,     mapBody, mapTime,@@ -39,7 +39,7 @@ import Data.EventList.Utility    (mapFst, mapSnd, toMaybe, isMonotonic, isMonotonicLazy, beforeBy) import qualified Control.Monad as Monad-import Control.Monad.State (State(State), evalState)+import Control.Monad.Trans.State (state, evalState)  import Prelude hiding (mapM, mapM_, null, foldr, filter, concat, cycle) @@ -70,6 +70,15 @@ 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 @@ -87,7 +96,7 @@ However, I'm not sure if this is sound. -} duration :: Num time => T time body -> time-duration = maybe 0 (fst . snd) . viewR+duration = switchR 0 (const fst)   @@ -186,16 +195,15 @@ collectCoincident :: Eq time => T time body -> T time [body] collectCoincident =    Cons .-   maybe+   Mixed.switchFirstL       Disp.empty-      (uncurry $ \ t0 ->+      (\ t0 ->          Mixed.consFirst t0 .          Uniform.catMaybesFirst .          flip evalState (Just t0) .-         Uniform.mapFirstM (\time -> State $ \ oldTime ->+         Uniform.mapFirstM (\time -> state $ \ oldTime ->             (Monad.guard (time /= oldTime) >> time, time)) .          Uniform.mapFirst Just) .-   Mixed.viewFirstL .    decons  collectCoincidentFoldr :: Eq time => T time body -> T time [body]@@ -204,13 +212,13 @@    foldrPair       (\t0 b0 xs ->           Mixed.consFirst t0 $-          maybe+          Disp.switchL              (Uniform.singleton [b0])-             (\((t1,bs),ys) ->+             (\t1 bs ys ->                  if t0 == t1                    then Mixed.consSecond (b0:bs) ys-                   else Mixed.consSecond [b0] xs) $-             Disp.viewL xs)+                   else Mixed.consSecond [b0] xs)+             xs)       Disp.empty  {- |@@ -221,13 +229,13 @@    Cons .    foldrPair       (\t0 b0 xs ->-          maybe+          Disp.switchL              (Disp.singleton t0 [b0])-             (\((t1,bs),ys) ->+             (\t1 bs ys ->                  if t0 == t1                    then Disp.cons t0 (b0:bs) ys-                   else Disp.cons t0 [b0] xs) $-             Disp.viewL xs)+                   else Disp.cons t0 [b0] xs)+             xs)       Disp.empty  @@ -291,7 +299,7 @@    (body -> body -> Bool) ->    T time body -> T time body -> T time body mergeBy before =-   let recurse xs0 ys0 =+   let recourse xs0 ys0 =           case (viewL xs0, viewL ys0) of              (Nothing, _) -> ys0              (_, Nothing) -> xs0@@ -299,7 +307,7 @@                 if beforeBy before x y                   then uncurry cons x $ mergeBy before xs ys0                   else uncurry cons y $ mergeBy before ys xs0-   in  recurse+   in  recourse  {- | The final critical function is @insert@,@@ -319,13 +327,13 @@    time -> body -> T time body -> T time body insertBy before t0 me0 mevs1 =    let mev0 = (t0, me0)-   in  maybe+   in  switchL           (uncurry singleton mev0)-          (\(mev1, mevs) ->+          (\mev1 mevs ->               if beforeBy before mev0 mev1                 then uncurry cons mev0 $ mevs1-                else uncurry cons mev1 $ uncurry (insertBy before) mev0 mevs) $-       viewL mevs1+                else uncurry cons mev1 $ uncurry (insertBy before) mev0 mevs)+          mevs1   {- |@@ -386,15 +394,14 @@ decreaseStart :: (Ord time, Num time) =>    time -> T time body -> T time body decreaseStart dif =-   maybe+   switchL       empty-      (\((t, b), xs) ->+      (\(t, b) xs ->          cons             (if t>=dif                then t-dif                else error "decreaseStart: difference too big") b-            (mapTime (subtract dif) xs)) .-      viewL+            (mapTime (subtract dif) xs))  delay :: (Ord time, Num time) =>    time -> T time body -> T time body
src/Data/EventList/Absolute/TimeMixed.hs view
@@ -7,7 +7,8 @@ -} module Data.EventList.Absolute.TimeMixed    (snocBody, snocTime, -- (/.), (./),-    viewTimeR, viewBodyR,+    viewTimeR,   viewBodyR,+    switchTimeR, switchBodyR,     mapTimeInit,     ) where
src/Data/EventList/Absolute/TimeTime.hs view
@@ -10,7 +10,7 @@ module Data.EventList.Absolute.TimeTime    (T,     pause, isPause,-    viewL, cons, snoc,+    viewL, switchL, cons, snoc,     mapBody, mapTime,     mapM, mapM_, mapBodyM, mapTimeM,     getTimes, getBodies, duration,@@ -38,7 +38,7 @@  import Data.EventList.Utility (mapPair, mapSnd, toMaybe, isMonotonic) import qualified Control.Monad as Monad-import Control.Monad.State (State(State), evalState)+import Control.Monad.Trans.State (state, evalState)  import Data.Maybe (fromMaybe) @@ -81,7 +81,13 @@    Mixed.viewSecondL .    decons +{-# INLINE switchL #-}+switchL :: (time -> a) -> ((time, body) -> T time body -> a) -> T time body -> a+switchL f g =+   Mixed.switchL f (\t b -> g (t,b) . Cons) .+   decons + mapBody :: (body0 -> body1) -> T time body0 -> T time body1 mapBody = lift . Uniform.mapFirst @@ -135,11 +141,11 @@ partition ::    (body -> Bool) -> T time body -> (T time body, T time body) partition p =-   (\(xs,t) ->+   switchTimeR+   (\ xs t ->       mapPair          (flip snocTime t, flip snocTime t)-         (TimeBodyList.partition p xs)) .-   viewTimeR+         (TimeBodyList.partition p xs))  slice :: (Eq a, Num time) =>    (body -> a) -> T time body -> [(a, T time body)]@@ -152,15 +158,15 @@ collectCoincident :: Eq time => T time body -> T time [body] collectCoincident =    Cons .-   (uncurry $ \ t0 ->+   Mixed.switchSecondL+   (\ t0 ->       Mixed.consSecond t0 .       Mixed.mapFirstInit          (Uniform.catMaybesFirst .           flip evalState (Just t0) .-          Uniform.mapFirstM (\time -> State $ \ oldTime ->+          Uniform.mapFirstM (\time -> state $ \ oldTime ->              (Monad.guard (time /= oldTime) >> time, time)) .           Uniform.mapFirst Just)) .-   Mixed.viewSecondL .    decons  @@ -217,15 +223,13 @@    time -> body -> T time body -> T time body insertBy before t0 me0 mevs1 =    let mev0 = (t0, me0)-       (t1,mxs) = viewL mevs1-   in  maybe-          (uncurry cons mev0 $ pause (max t0 t1))-          (\(ev1, mevs) ->-              let mev1 = (t1,ev1)-              in  if Utility.beforeBy before mev0 mev1-                    then uncurry cons mev0 $ mevs1-                    else uncurry cons mev1 $ uncurry (insertBy before) mev0 mevs)-          mxs+   in  switchL+          (\t1 -> uncurry cons mev0 $ pause (max t0 t1))+          (\mev1 mevs ->+              if Utility.beforeBy before mev0 mev1+                then uncurry cons mev0 $ mevs1+                else uncurry cons mev1 $ uncurry (insertBy before) mev0 mevs)+          mevs1   @@ -244,8 +248,8 @@ append :: (Ord time, Num time) =>    T time body -> T time body -> T time body append =-   (\(xs, t) -> lift (Mixed.appendDisparateUniform $~ xs) . delay t) .-   viewTimeR+   switchTimeR+   (\xs t -> lift (Mixed.appendDisparateUniform $~ xs) . delay t)  concat :: (Ord time, Num time) =>    [T time body] -> T time body@@ -269,13 +273,13 @@    time -> T time body -> T time body decreaseStart dif =    Cons .-   (\(t, xs) ->+   Mixed.switchSecondL+   (\ t xs ->       Mixed.consSecond          (if t>=dif             then t-dif             else error "decreaseStart: difference too big")          (Disp.mapSecond (subtract dif) xs)) .-   Mixed.viewSecondL .    decons  delay :: (Ord time, Num time) =>
src/Data/EventList/Absolute/TimeTimePrivate.hs view
@@ -58,6 +58,17 @@    fmap (mapFst Cons) . Mixed.viewFirstR . TimeBodyList.decons  +{-# INLINE switchTimeR #-}+switchTimeR :: (TimeBodyList.T time body -> time -> a) -> T time body -> a+switchTimeR f =+   Mixed.switchSecondR (f . TimeBodyList.Cons) . decons++{-# INLINE switchBodyR #-}+switchBodyR :: a -> (T time body -> body -> a) -> TimeBodyList.T time body -> a+switchBodyR f g =+   Mixed.switchFirstR f (g . Cons) . TimeBodyList.decons++ mapTimeInit ::    (TimeBodyList.T time body0 -> TimeBodyList.T time body1) ->    T time body0 -> T time body1
src/Data/EventList/Relative/BodyTime.hs view
@@ -10,9 +10,12 @@  -} module Data.EventList.Relative.BodyTime-   (T, mapM, empty,+   (T, empty,     fromPairList, toPairList,-    cons, snoc, viewL, viewR,+    mapM,+    foldr, foldrPair,+    cons, snoc, viewL, viewR, switchL, switchR,+    span,    ) where  import Data.EventList.Relative.BodyTimePrivate@@ -20,12 +23,19 @@ import qualified Data.AlternatingList.List.Disparate as Disp -- import qualified Data.AlternatingList.List.Uniform as Uniform -import Data.EventList.Utility (mapFst, mapSnd, )+import Data.EventList.Utility (mapPair, mapFst, mapSnd, )  import Prelude hiding-   (mapM)+   (mapM, foldr, span, )  +fromPairList :: [(body, time)] -> T time body+fromPairList = Cons . Disp.fromPairList++toPairList :: T time body -> [(body, time)]+toPairList = Disp.toPairList . decons++ mapM :: Monad m =>    (time0 -> m time1) -> (body0 -> m body1) ->    T time0 body0 -> m (T time1 body1)@@ -33,11 +43,11 @@    liftM (Disp.mapM bodyAction timeAction)  -fromPairList :: [(body, time)] -> T time body-fromPairList = Cons . Disp.fromPairList+foldr :: (body -> a -> b) -> (time -> b -> a) -> b -> T time body -> b+foldr f g x = Disp.foldr f g x . decons -toPairList :: T time body -> [(body, time)]-toPairList = Disp.toPairList . decons+foldrPair :: (body -> time -> a -> a) -> a -> T time body -> a+foldrPair f x = Disp.foldrPair f x . decons   empty :: T time body@@ -57,3 +67,16 @@  viewR :: T time body -> Maybe (T time body, (body, time)) viewR = fmap (mapFst Cons) . Disp.viewR . decons+++{-# INLINE switchL #-}+switchL :: c -> (body -> time -> T time body -> c) -> T time body -> c+switchL f g = Disp.switchL f (\ b t  -> g b t . Cons) . decons++{-# INLINE switchR #-}+switchR :: c -> (T time body -> body -> time -> c) -> T time body -> c+switchR f g = Disp.switchR f (\xs b t -> g (Cons xs) b t) . decons+++span :: (body -> Bool) -> T time body -> (T time body, T time body)+span p = mapPair (Cons, Cons) . Disp.spanFirst p . decons
src/Data/EventList/Relative/MixedBody.hs view
@@ -11,7 +11,8 @@ -} module Data.EventList.Relative.MixedBody    (consBody, consTime, (/.), (./), empty,-    viewTimeL, viewBodyL,+    viewTimeL,   viewBodyL,+    switchTimeL, switchBodyL,     mapTimeL, mapTimeHead, mapTimeTail,    ) where @@ -53,3 +54,13 @@ viewBodyL :: BodyBodyList.T time body -> (body, TimeBodyList.T time body) viewBodyL = mapSnd TimeBodyPriv.Cons . Mixed.viewSecondL . BodyBodyPriv.decons ++{-# INLINE switchTimeL #-}+switchTimeL :: a -> (time -> BodyBodyList.T time body -> a) -> TimeBodyList.T time body -> a+switchTimeL f g =+   Mixed.switchFirstL f (\t -> g t . BodyBodyPriv.Cons) . TimeBodyPriv.decons++{-# INLINE switchBodyL #-}+switchBodyL :: (body -> TimeBodyList.T time body -> a) -> BodyBodyList.T time body -> a+switchBodyL f =+   Mixed.switchSecondL (\b -> f b . TimeBodyPriv.Cons) . BodyBodyPriv.decons
src/Data/EventList/Relative/MixedTime.hs view
@@ -11,7 +11,8 @@ -} module Data.EventList.Relative.MixedTime    (consBody, consTime, (/.), (./), empty,-    viewTimeL, viewBodyL,+    viewTimeL,   viewBodyL,+    switchTimeL, switchBodyL,     mapTimeL, mapTimeHead, mapTimeTail,     mapBodyL, mapBodyHead, mapBodyTail,    ) where
src/Data/EventList/Relative/TimeBody.hs view
@@ -21,7 +21,7 @@ module Data.EventList.Relative.TimeBody    (T,     empty, singleton, null,-    viewL, viewR, cons, snoc,+    viewL, viewR, switchL, switchR, cons, snoc,     fromPairList, toPairList,     getTimes, getBodies, duration,     mapBody, mapTime,@@ -53,7 +53,7 @@  import qualified Numeric.NonNegative.Class as NonNeg import Data.EventList.Utility (floorDiff, mapFst, mapSnd, toMaybe, isMonotonic, beforeBy)-import Control.Monad.State (evalState, modify, get, put)+import Control.Monad.Trans.State (evalState, modify, get, put)  import Prelude hiding (mapM, mapM_, null, foldr, filter, concat, cycle, span) @@ -84,7 +84,16 @@ 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 @@ -152,6 +161,10 @@    T time body0 -> T time body1 mapMaybe f = catMaybes . mapBody f +{- |+Adds times in a left-associative fashion.+Use this if the time is a strict data type.+-} catMaybes :: (Num time) =>    T time (Maybe body) -> T time body catMaybes =@@ -200,17 +213,16 @@    (body -> Bool) -> time -> time ->        T time body -> (T time body, T time body) partitionRec p =-   let recurse t0 t1 =-          maybe+   let recourse t0 t1 =+          switchL              (empty, empty)-             (\ ((t, b), es) ->+             (\ (t, b) es ->                 let t0' = t0 + t                     t1' = t1 + t                 in  if p b-                      then mapFst (cons t0' b) (recurse 0 t1' es)-                      else mapSnd (cons t1' b) (recurse t0' 0 es)) .-          viewL-   in  recurse+                      then mapFst (cons t0' b) (recourse 0 t1' es)+                      else mapSnd (cons t1' b) (recourse t0' 0 es))+   in  recourse  {- | Using a classification function@@ -243,9 +255,9 @@ flatten :: (NonNeg.C time) => T time [body] -> T time body flatten =    Cons .-   maybe+   Mixed.switchFirstL       Disp.empty-      (uncurry $ \time ->+      (\time ->          unlift (delay time) .          fst . Mixed.viewSecondR .          Uniform.foldr@@ -253,7 +265,6 @@             Mixed.consSecond Disp.empty .          Uniform.mapSecond sum .          Uniform.filterSecond (not . List.null)) .-   Mixed.viewFirstL .    decons  @@ -316,14 +327,13 @@ insert :: (NonNeg.C time, Ord body) =>    time -> body -> T time body -> T time body insert t0 me0 =-   maybe+   switchL       (singleton t0 me0)-      (\(mev1@(t1, me1), mevs) ->+      (\ mev1@(t1, me1) mevs ->           let mev0 = (t0, me0)           in  if mev0 < mev1                 then uncurry cons mev0 $ cons   (t1-t0) me1 mevs                 else uncurry cons mev1 $ insert (t0-t1) me0 mevs)-    . viewL   @@ -331,13 +341,12 @@    (body -> body -> Bool) ->    time -> body -> T time body -> T time body insertBy before t0 me0 =-   maybe+   switchL       (singleton t0 me0)-      (\(mev1@(t1, me1), mevs) ->+      (\ 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)-    . viewL   {- |
src/Data/EventList/Relative/TimeMixed.hs view
@@ -12,7 +12,8 @@ module Data.EventList.Relative.TimeMixed    (snocBody, snocTime, --    (/.), (./),-    viewTimeR, viewBodyR,+    viewTimeR,   viewBodyR,+    switchTimeR, switchBodyR,     mapTimeR, mapTimeLast, mapTimeInit,     mapBodyR, mapBodyLast, mapBodyInit,     appendBodyEnd, prependBodyEnd,@@ -27,7 +28,8 @@ -- import Data.EventList.Relative.TimeBodyPrivate (($~*))  import Data.EventList.Relative.TimeTimePrivate-   (viewTimeR, viewBodyR, mapTimeR, mapTimeLast, mapTimeInit)+   (viewTimeR, viewBodyR, switchTimeR, switchBodyR,+    mapTimeR, mapTimeLast, mapTimeInit)  import qualified Data.AlternatingList.List.Disparate as Disp import qualified Data.AlternatingList.List.Uniform as Uniform@@ -75,8 +77,8 @@ appendBodyEnd :: (NonNeg.C time) =>    TimeTimeList.T time body -> TimeBodyList.T time body -> TimeBodyList.T time body appendBodyEnd =-   (\ ~(xs, t) -> TimeBodyList.append xs . TimeBodyList.delay t) .-   viewTimeR+   switchTimeR+   (\ xs t -> TimeBodyList.append xs . TimeBodyList.delay t)  {- | This is not a good name, expect a change.@@ -92,15 +94,15 @@    time -> Disp.T time body ->    (Uniform.T body time, Disp.T time body) splitAtTimeAux t0 =-   maybe+   Mixed.switchFirstL       (Uniform.singleton 0, Disp.empty)-      (\(t1,xs) ->+      (\t1 xs ->           if t0<=t1             then (Uniform.singleton t0, Mixed.consFirst (t1-t0) xs)             else-               (\(b,ys) -> mapFst (Uniform.cons t1 b) (splitAtTimeAux (t0-t1) ys))-               (Mixed.viewSecondL xs)) .-   Mixed.viewFirstL+               Mixed.switchSecondL+                  (\b ys -> mapFst (Uniform.cons t1 b) (splitAtTimeAux (t0-t1) ys))+                  xs)  splitAtTime :: (NonNeg.C time) =>    time -> TimeBodyList.T time body ->
src/Data/EventList/Relative/TimeTime.hs view
@@ -17,8 +17,8 @@     moveForwardRestrictedBy,     moveForwardRestrictedByQueue, moveForwardRestrictedByStrict,     decreaseStart, delay, filter, partition, slice, foldr,-    pause, isPause, cons, snoc, viewL, viewR,-    mapMaybe, catMaybes,+    pause, isPause, cons, snoc, viewL, viewR, switchL, switchR,+    mapMaybe, catMaybes, catMaybesR,     append, concat, concatNaive, cycle, cycleNaive,     splitAtTime, takeTime, dropTime,     discretize, resample,@@ -45,8 +45,8 @@  import qualified Numeric.NonNegative.Class as NonNeg import Data.EventList.Utility (floorDiff, mapPair, mapFst, mapSnd, toMaybe, isMonotonic)-import qualified Control.Monad.State as Monad-import Control.Monad.State (evalState, modify, get, gets, put, liftM2, )+import Control.Monad.Trans.State (evalState, modify, get, gets, put, )+import Control.Monad (liftM2, )  import Prelude hiding    (null, foldr, map, filter, concat, cycle, sequence, sequence_, mapM, mapM_)@@ -86,11 +86,23 @@    Mixed.viewL .    decons +{-# INLINE switchL #-}+switchL :: (time -> a) -> ((time, body) -> T time body -> a) -> T time body -> a+switchL f g =+   Mixed.switchL f (\t b -> g (t,b) . Cons) .+   decons+ viewR :: T time body -> (Maybe (T time body, body), time) viewR =    mapFst (fmap (mapFst Cons)) . Mixed.viewR . decons +{-# INLINE switchR #-}+switchR :: (time -> a) -> (T time body -> body -> time -> a) -> T time body -> a+switchR f g =+   Mixed.switchR f (g . Cons) .+   decons + mapBody :: (body0 -> body1) -> T time body0 -> T time body1 mapBody = lift . Uniform.mapFirst @@ -162,7 +174,7 @@                 (Just (b0,xs1), Just (b1,ys1)) ->                    {- do not insert both b0 and b1 immediately,                       because the later one of b0 and b1 may be pushed even further,-                      thus recurse with 'mergeBy' on xs or ys -}+                      thus recourse with 'mergeBy' on xs or ys -}                    if before b0 b1                      then consBody b0 $ mergeBy before xs1 $ consTime 0 ys                      else consBody b1 $ mergeBy before ys1 $ consTime 0 xs@@ -174,11 +186,11 @@ mergeFirstBy before xs0 ys0 =    let (xt,xs) = viewTimeL xs0        (yt,ys) = viewTimeL ys0-   in  maybe+   in  switchBodyL           ys0-          (\(b,xs1) ->+          (\ b xs1 ->               consTime xt $ consBody b $ mergeBy before xs1 $ consTime (yt-xt) ys)-          (viewBodyL xs)+          xs   {- |@@ -206,20 +218,18 @@    time -> body -> T time body -> T time body insertBy before t0 me0 =    let recurseTime t =-          (\ (t1,xs) ->+          switchTimeL (\ t1 xs ->              if t<t1                then cons t me0 (consTime (t1-t) xs)                else recurseBody t1 t xs)-            . viewTimeL        recurseBody t1 t =-          maybe+          switchBodyL              (cons t me0 $ pause 0)-             (\(me1,xs) ->+             (\ me1 xs ->                  consTime t1 $                     if t==t1 && before me0 me1                       then consBody me0 (cons 0 me1 xs)                       else consBody me1 (recurseTime (t-t1) xs))-            . viewBodyL    in   recurseTime t0  @@ -352,11 +362,14 @@       (pause 0)  +{-+not lazy enough for @append (2 /. 'a' ./ 4 /. 'b' ./ 2 /. undefined) undefined@+-} append :: (NonNeg.C time) =>    T time body -> T time body -> T time body append =-   (\(xs, t) -> lift (Mixed.appendDisparateUniform $~* xs) . delay t) .-   viewTimeR+   switchTimeR+   (\ xs t -> lift (Mixed.appendDisparateUniform $~* xs) . delay t)  concat :: (NonNeg.C time) =>    [T time body] -> T time body@@ -384,11 +397,11 @@ cycle :: (NonNeg.C time) =>    T time body -> T time body cycle =-   (\(t0,xs) ->+   switchTimeL+   (\t0 xs ->        consTime t0 $        BodyTimePriv.cycle $-       BodyTimePriv.mapTimeLast (+t0) xs) .-   viewTimeL+       BodyTimePriv.mapTimeLast (+t0) xs)   cycleNaive :: (NonNeg.C time) =>@@ -412,15 +425,15 @@ splitAtTime :: (NonNeg.C time) =>    time -> T time body -> (T time body, T time body) splitAtTime t0 =-   (\(t1,xs) ->+   switchTimeL+   (\t1 xs ->         if t0<=t1           then (pause t0, consTime (t1-t0) xs)           else-             maybe+             switchBodyL                 (pause t1, pause 0)-                (\(b,ys) -> mapFst (cons t1 b) (splitAtTime (t0-t1) ys))-                (viewBodyL xs)) .-   viewTimeL+                (\ b -> mapFst (cons t1 b) . splitAtTime (t0-t1))+                xs)  takeTime :: (NonNeg.C time) =>    time -> T time body -> T time body@@ -487,9 +500,26 @@    T time body0 -> T time body1 mapMaybe f = catMaybes . mapBody f +{- |+Adds times in a left-associative fashion.+Use this if the time is a strict data type.+-} catMaybes :: (Num time) =>    T time (Maybe body) -> T time body catMaybes = mapTime sum . lift Uniform.catMaybesFirst++{- |+Adds times in a right-associative fashion.+Use this if the time is a data type like lazy Peano numbers+or "Numeric.NonNegative.Chunky".+-}+catMaybesR :: (Num time) =>+   T time (Maybe body) -> T time body+catMaybesR =+   foldr+      (mapTimeHead . (+))+      (maybe id (cons 0))+      (pause 0)  partition :: (Num time) =>    (body -> Bool) ->
src/Data/EventList/Relative/TimeTimePrivate.hs view
@@ -68,6 +68,7 @@ consTime :: time -> BodyTimeList.T time body -> T time body consTime t = Cons . Mixed.consSecond t . BodyTimePriv.decons + viewTimeL :: T time body -> (time, BodyTimeList.T time body) viewTimeL = mapSnd BodyTimePriv.Cons . Mixed.viewSecondL . decons @@ -80,6 +81,26 @@  viewBodyR :: TimeBodyList.T time body -> Maybe (T time body, body) viewBodyR = fmap (mapFst Cons) . Mixed.viewFirstR . TimeBodyPriv.decons+++{-# INLINE switchTimeL #-}+switchTimeL :: (time -> BodyTimeList.T time body -> a) -> T time body -> a+switchTimeL f =+   Mixed.switchSecondL (\b -> f b . BodyTimePriv.Cons) . decons++{-# INLINE switchBodyL #-}+switchBodyL :: a -> (body -> T time body -> a) -> BodyTimeList.T time body -> a+switchBodyL f g =+   Mixed.switchFirstL f (\t -> g t . Cons) . BodyTimePriv.decons+++{-# INLINE switchTimeR #-}+switchTimeR :: (TimeBodyList.T time body -> time -> a) -> T time body -> a+switchTimeR f = Mixed.switchSecondR (f . TimeBodyPriv.Cons) . decons++{-# INLINE switchBodyR #-}+switchBodyR :: a -> (T time body -> body -> a) -> TimeBodyList.T time body -> a+switchBodyR f g = Mixed.switchFirstR f (g . Cons) . TimeBodyPriv.decons   mapTimeL ::
src/Data/EventList/Utility.hs view
@@ -1,7 +1,7 @@ module Data.EventList.Utility where  -- State monad could be avoided by mapAccumL-import Control.Monad.State (State(State), modify, gets)+import Control.Monad.Trans.State (State, state, modify, gets, ) import qualified Data.List as List  {- |@@ -21,7 +21,7 @@    in  (n, x - fromIntegral n)  roundDiff :: (RealFrac t, Integral i) => t -> State t i-roundDiff = State . roundDiff'+roundDiff = state . roundDiff'  {- We could use 'properFraction' but this is inconsistent for negative values.@@ -61,12 +61,12 @@  mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] mergeBy p =-   let recurse xl@(x:xs) yl@(y:ys) =-         if p x y then x : recurse xs yl-                  else y : recurse xl ys-       recurse [] yl = yl-       recurse xl [] = xl-   in  recurse+   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) =>
src/Test/Data/EventList/Absolute/BodyEnd.hs view
@@ -18,7 +18,6 @@ -- 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)@@ -28,7 +27,7 @@ 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 Control.Monad.Trans.State (state, evalState, )  import Prelude hiding (filter, concat) @@ -74,7 +73,7 @@ mapBodyMRandom seed =    mapBodyM        (flip evalState (mkStdGen seed))-      (State . randomR)+      (state . randomR)   filter :: (Eq body, Num time) =>@@ -269,9 +268,9 @@ 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+   let x = AbsBody.switchL+              (error "BodyEnd.checkInfinite: empty list") const $+              AbsBodyPriv.lift (Disp.drop 100) xs0    in  x == x  @@ -281,45 +280,45 @@ tests :: [(String, IO ())] tests =    ("duration",-     test (duration :: RelBody.T TimeDiff Char -> Bool)) :+     test (duration :: RelBody.T TimeDiff ArbChar -> Bool)) :    ("mapBody",-     test (mapBody Char.toUpper :: RelBody.T TimeDiff Char -> Bool)) :+     test (mapBody toUpper :: RelBody.T TimeDiff ArbChar -> Bool)) :    ("mapBodyM",-     test (mapBodyMRandom :: Int -> RelBody.T TimeDiff (Char, Char) -> Bool)) :+     test (mapBodyMRandom :: Int -> RelBody.T TimeDiff (ArbChar, ArbChar) -> Bool)) :    ("filter",-     test (\c -> filter (c<) :: RelBody.T TimeDiff Char -> Bool)) :+     test (\c -> filter (c<) :: RelBody.T TimeDiff ArbChar -> Bool)) :    ("catMaybes",-     test (catMaybes :: RelBody.T TimeDiff (Maybe Char) -> Bool)) :+     test (catMaybes :: RelBody.T TimeDiff (Maybe ArbChar) -> Bool)) :    ("partition",-     test (\c -> partition (c<) :: RelBody.T TimeDiff Char -> Bool)) :+     test (\c -> partition (c<) :: RelBody.T TimeDiff ArbChar -> Bool)) :    ("slice",-     test (slice fst :: RelBody.T TimeDiff (Char,Char) -> Bool)) :+     test (slice fst :: RelBody.T TimeDiff (ArbChar,ArbChar) -> Bool)) :    ("collectCoincident",-     test (collectCoincident :: RelBody.T TimeDiff Char -> Bool)) :+     test (collectCoincident :: RelBody.T TimeDiff ArbChar -> Bool)) :    ("collectCoincidentFoldr",-     test (collectCoincidentFoldr :: RelBody.T TimeDiff Char -> Bool)) :+     test (collectCoincidentFoldr :: RelBody.T TimeDiff ArbChar -> Bool)) :    ("collectCoincidentNonLazy",-     test (collectCoincidentNonLazy :: RelBody.T TimeDiff Char -> Bool)) :+     test (collectCoincidentNonLazy :: RelBody.T TimeDiff ArbChar -> Bool)) :    ("collectCoincidentInfinite",-     test (collectCoincidentInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+     test (collectCoincidentInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("flatten",-     test (flatten :: RelBody.T TimeDiff [Char] -> Bool)) :+     test (flatten :: RelBody.T TimeDiff [ArbChar] -> Bool)) :    ("normalize",-     test (normalize :: RelBody.T TimeDiff Char -> Bool)) :+     test (normalize :: RelBody.T TimeDiff ArbChar -> Bool)) :    ("merge",-     test (merge :: RelBody.T TimeDiff Char -> RelBody.T TimeDiff Char -> Bool)) :+     test (merge :: RelBody.T TimeDiff ArbChar -> RelBody.T TimeDiff ArbChar -> Bool)) :    ("insert",-     test (insert :: TimeDiff -> Char -> RelBody.T TimeDiff Char -> Bool)) :+     test (insert :: TimeDiff -> ArbChar -> RelBody.T TimeDiff ArbChar -> Bool)) :    ("append",-     test (append :: RelBody.T TimeDiff Char -> RelBody.T TimeDiff Char -> Bool)) :+     test (append :: RelBody.T TimeDiff ArbChar -> RelBody.T TimeDiff ArbChar -> Bool)) :    ("concat",-     test (concat :: [RelBody.T TimeDiff Char] -> Bool)) :+     test (concat :: [RelBody.T TimeDiff ArbChar] -> Bool)) :    ("decreaseStart",-     test (decreaseStart :: TimeDiff -> TimeDiff -> RelBody.T TimeDiff Char -> Bool)) :+     test (decreaseStart :: TimeDiff -> TimeDiff -> RelBody.T TimeDiff ArbChar -> Bool)) :    ("delay",-     test (delay :: TimeDiff -> RelBody.T TimeDiff Char -> Bool)) :+     test (delay :: TimeDiff -> RelBody.T TimeDiff ArbChar -> Bool)) :    ("resample",-     test (resample :: TimeDiff -> RelBody.T (TimeDiff, TimeDiff) Char -> Bool)) :+     test (resample :: TimeDiff -> RelBody.T (TimeDiff, TimeDiff) ArbChar -> Bool)) :    ("resampleInfinite",-     test (resampleInfinite :: TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) Char -> Bool)) :+     test (resampleInfinite :: TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) ArbChar -> Bool)) :    []
src/Test/Data/EventList/Absolute/TimeEnd.hs view
@@ -18,7 +18,6 @@ -- 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)@@ -28,7 +27,7 @@ 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 Control.Monad.Trans.State (state, evalState)  import Prelude hiding (filter, concat) @@ -74,7 +73,7 @@ mapBodyMRandom seed =    mapBodyM        (flip evalState (mkStdGen seed))-      (State . randomR)+      (state . randomR)   filter :: (Eq body, Num time) =>@@ -258,41 +257,41 @@ tests :: [(String, IO ())] tests =    ("duration",-     test (duration :: RelTime.T TimeDiff Char -> Bool)) :+     test (duration :: RelTime.T TimeDiff ArbChar -> Bool)) :    ("mapBody",-     test (mapBody Char.toUpper :: RelTime.T TimeDiff Char -> Bool)) :+     test (mapBody toUpper :: RelTime.T TimeDiff ArbChar -> Bool)) :    ("mapBodyM",-     test (mapBodyMRandom :: Int -> RelTime.T TimeDiff (Char, Char) -> Bool)) :+     test (mapBodyMRandom :: Int -> RelTime.T TimeDiff (ArbChar, ArbChar) -> Bool)) :    ("filter",-     test (\c -> filter (c<) :: RelTime.T TimeDiff Char -> Bool)) :+     test (\c -> filter (c<) :: RelTime.T TimeDiff ArbChar -> Bool)) :    ("catMaybes",-     test (catMaybes :: RelTime.T TimeDiff (Maybe Char) -> Bool)) :+     test (catMaybes :: RelTime.T TimeDiff (Maybe ArbChar) -> Bool)) :    ("partition",-     test (\c -> partition (c<) :: RelTime.T TimeDiff Char -> Bool)) :+     test (\c -> partition (c<) :: RelTime.T TimeDiff ArbChar -> Bool)) :    ("slice",-     test (slice fst :: RelTime.T TimeDiff (Char,Char) -> Bool)) :+     test (slice fst :: RelTime.T TimeDiff (ArbChar,ArbChar) -> Bool)) :    ("collectCoincident",-     test (collectCoincident :: RelTime.T TimeDiff Char -> Bool)) :+     test (collectCoincident :: RelTime.T TimeDiff ArbChar -> Bool)) :    ("collectCoincidentInfinite",-     test (collectCoincidentInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+     test (collectCoincidentInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("flatten",-     test (flatten :: RelTime.T TimeDiff [Char] -> Bool)) :+     test (flatten :: RelTime.T TimeDiff [ArbChar] -> Bool)) :    ("normalize",-     test (normalize :: RelTime.T TimeDiff Char -> Bool)) :+     test (normalize :: RelTime.T TimeDiff ArbChar -> Bool)) :    ("merge",-     test (merge :: RelTime.T TimeDiff Char -> RelTime.T TimeDiff Char -> Bool)) :+     test (merge :: RelTime.T TimeDiff ArbChar -> RelTime.T TimeDiff ArbChar -> Bool)) :    ("insert",-     test (insert :: TimeDiff -> Char -> RelTime.T TimeDiff Char -> Bool)) :+     test (insert :: TimeDiff -> ArbChar -> RelTime.T TimeDiff ArbChar -> Bool)) :    ("append",-     test (append :: RelTime.T TimeDiff Char -> RelTime.T TimeDiff Char -> Bool)) :+     test (append :: RelTime.T TimeDiff ArbChar -> RelTime.T TimeDiff ArbChar -> Bool)) :    ("concat",-     test (concat :: [RelTime.T TimeDiff Char] -> Bool)) :+     test (concat :: [RelTime.T TimeDiff ArbChar] -> Bool)) :    ("decreaseStart",-     test (decreaseStart :: TimeDiff -> TimeDiff -> RelTime.T TimeDiff Char -> Bool)) :+     test (decreaseStart :: TimeDiff -> TimeDiff -> RelTime.T TimeDiff ArbChar -> Bool)) :    ("delay",-     test (delay :: TimeDiff -> RelTime.T TimeDiff Char -> Bool)) :+     test (delay :: TimeDiff -> RelTime.T TimeDiff ArbChar -> Bool)) :    ("resample",-     test (resample :: TimeDiff -> RelTime.T (TimeDiff, TimeDiff) Char -> Bool)) :+     test (resample :: TimeDiff -> RelTime.T (TimeDiff, TimeDiff) ArbChar -> Bool)) :    ("resampleInfinite",-     test (resampleInfinite :: TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) Char -> Bool)) :+     test (resampleInfinite :: TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) ArbChar -> Bool)) :    []
src/Test/Data/EventList/Relative/BodyEnd.hs view
@@ -27,11 +27,10 @@  import Data.EventList.Utility (mapPair, mapFst, ) import System.Random (Random, randomR, mkStdGen)-import Control.Monad.State (State(State), evalState, gets, modify, )+import Control.Monad.Trans.State (state, evalState, gets, modify, ) import Control.Monad (liftM2) import Data.Maybe (isJust) import qualified Data.List as List-import qualified Data.Char as Char   @@ -46,8 +45,8 @@    xs == uncurry MixedBodyList.consBody (MixedBodyList.viewBodyL xs)  --viewLInfinite :: (NonNeg.C time, Eq body) => NonEmptyList time body -> Bool+viewLInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> Bool viewLInfinite =    checkInfinite .    maybe (error "viewBodyL: empty list") snd .@@ -55,6 +54,25 @@    makeInfiniteEventList  +switchLConsTime :: (Eq body, Eq time) =>+   TimeBodyList.T time body -> Bool+switchLConsTime xs =+   xs == MixedBodyList.switchTimeL TimeBodyList.empty MixedBodyList.consTime xs++switchLConsBody :: (Eq body, Eq time) =>+   BodyBodyList.T time body -> Bool+switchLConsBody xs =+   xs == MixedBodyList.switchBodyL MixedBodyList.consBody xs+++switchLInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> Bool+switchLInfinite =+   checkInfinite .+   TimeBodyList.switchL (error "switchBodyL: empty list") (flip const) .+   makeInfiniteEventList++ consInfinite :: (NonNeg.C time, Eq body) =>    time -> body -> NonEmptyList time body -> Bool consInfinite time body =@@ -577,7 +595,7 @@    uncurry (&&) .    mapPair      (all p . TimeBodyList.getBodies,-      maybe True (not . p . snd . fst) . TimeBodyList.viewL) .+      TimeBodyList.switchL True (const . not . p . snd)) .    TimeBodyList.span p  spanAppend :: (NonNeg.C time, Eq body) =>@@ -649,7 +667,7 @@ mapBodyMAppendRandom seed =    mapBodyMAppend       (flip evalState (mkStdGen seed))-      (State . randomR)+      (state . randomR)   mapBodyMInfinite ::@@ -658,7 +676,7 @@ mapBodyMInfinite seed =    checkInfinite .    flip evalState (mkStdGen seed) .-   TimeBodyList.mapM return (State . randomR) .+   TimeBodyList.mapM return (state . randomR) .    makeInfiniteEventList  @@ -772,9 +790,9 @@ checkInfinite :: (Eq time, Eq body) =>    TimeBodyList.T time body -> Bool checkInfinite xs0 =-   let x = maybe-              (error "BodyEnd.checkInfinite: empty list") fst $-              TimeBodyList.viewL $ TimeBodyPriv.lift (Disp.drop 100) xs0+   let x = TimeBodyList.switchL+              (error "BodyEnd.checkInfinite: empty list") const $+              TimeBodyPriv.lift (Disp.drop 100) xs0    in  x == x  @@ -782,203 +800,209 @@ tests :: [(String, IO ())] tests =    ("viewTimeL consTime",-     test (viewLConsTime :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (viewLConsTime :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("viewBodyL consBody",-     test (viewLConsBody :: BodyBodyList.T TimeDiff Char -> Bool)) :+     test (viewLConsBody :: BodyBodyList.T TimeDiff ArbChar -> Bool)) :+   ("switchTimeL consTime",+     test (switchLConsTime :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :+   ("switchBodyL consBody",+     test (switchLConsBody :: BodyBodyList.T TimeDiff ArbChar -> Bool)) :     ("viewLInfinite",-     test (viewLInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+     test (viewLInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :+   ("switchLInfinite",+     test (switchLInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("consInfinite",-     test (consInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (consInfinite :: TimeDiff -> ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("consTimeBodyInfinite",-     test (consTimeBodyInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (consTimeBodyInfinite :: TimeDiff -> ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("snocInfinite",-     test (snocInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (snocInfinite :: TimeDiff -> ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("consInfix",-     test (consInfix :: TimeDiff -> Char -> TimeDiff -> Char -> Bool)) :+     test (consInfix :: TimeDiff -> ArbChar -> TimeDiff -> ArbChar -> Bool)) :      ("map body composition",-     test (mapBodyComposition Char.toUpper Char.toLower-               :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mapBodyComposition toUpper toLower+               :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("map time composition",      test ((\dt0 dt1 -> mapTimeComposition (dt0+) (dt1+))-               :: TimeDiff -> TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+               :: TimeDiff -> TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("map time body commutative",-     test ((\dt -> mapTimeBodyCommutative (dt+) Char.toUpper)-               :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test ((\dt -> mapTimeBodyCommutative (dt+) toUpper)+               :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :     ("mapBodyInfinite",-     test (mapBodyInfinite Char.toUpper-               :: NonEmptyList TimeDiff Char -> Bool)) :+     test (mapBodyInfinite toUpper+               :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("mapTimeInfinite",      test (\dt -> mapTimeInfinite (dt+)-               :: NonEmptyList TimeDiff Char -> Bool)) :+               :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("mapNormalize",      test (mapNormalize succ-               :: TimeBodyList.T TimeDiff Char -> Bool)) :+               :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :     ("append left identity",-     test (appendLeftIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (appendLeftIdentity :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("append right identity",-     test (appendRightIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (appendRightIdentity :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("append associative",      test (appendAssociative-              :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char ->-                 TimeBodyList.T TimeDiff Char -> Bool)) :+              :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar ->+                 TimeBodyList.T TimeDiff ArbChar -> Bool)) :     ("appendCons",-     test (appendCons :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (appendCons :: TimeDiff -> ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("mapBodyAppend",-     test (mapBodyAppend Char.toUpper-               :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mapBodyAppend toUpper+               :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("appendSplitAtTime",-     test (appendSplitAtTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (appendSplitAtTime :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("appendFirstInfinite",-     test (appendFirstInfinite :: NonEmptyList TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (appendFirstInfinite :: NonEmptyList TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("appendSecondInfinite",-     test (appendSecondInfinite :: TimeBodyList.T TimeDiff Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (appendSecondInfinite :: TimeBodyList.T TimeDiff ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("cycleInfinite",-     test (cycleInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+     test (cycleInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("decreaseStart delay",-     test (decreaseStartDelay :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (decreaseStartDelay :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("decreaseStartInfinite",-     test (decreaseStartInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+     test (decreaseStartInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :     ("delay additive",-     test (delayAdditive :: TimeDiff -> TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (delayAdditive :: TimeDiff -> TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("delay append pause",-     test (delayAppendPause :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (delayAppendPause :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("delayInfinite",-     test (delayInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+     test (delayInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :     ("splitAtTakeDropTime",-     test (splitAtTakeDropTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (splitAtTakeDropTime :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("takeTimeEndPause",-     test (takeTimeEndPause :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (takeTimeEndPause :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("takeTimeAppendFirst",-     test (takeTimeAppendFirst :: TimeDiff -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (takeTimeAppendFirst :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("takeTimeAppendSecond",-     test (takeTimeAppendSecond :: TimeDiff -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (takeTimeAppendSecond :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("takeTimeNormalize",-     test (takeTimeNormalize :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (takeTimeNormalize :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("dropTimeNormalize",-     test (dropTimeNormalize :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (dropTimeNormalize :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("takeTimeInfinite",-     test (takeTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+     test (takeTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("dropTimeInfinite",-     test (dropTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+     test (dropTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :     ("duration pause",      test (durationPause :: TimeDiff -> Bool)) :    ("duration append",-     test (durationAppend :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (durationAppend :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("duration merge",-     test (durationMerge :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (durationMerge :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("durationTakeTime",-     test (durationTakeTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (durationTakeTime :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("durationDropTime",-     test (durationDropTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (durationDropTime :: TimeDiff -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :     ("filterSatisfy",-     test (\c -> filterSatisfy (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (\c -> filterSatisfy (c<) :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("filterProjection",-     test (\c -> filterProjection (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (\c -> filterProjection (c<) :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("filterCommutative",-     test (\c0 c1 -> filterCommutative (c0<) (c1>) :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (\c0 c1 -> filterCommutative (c0<) (c1>) :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("filterComposition",-     test (\c0 c1 -> filterComposition (c0<) (c1>) :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (\c0 c1 -> filterComposition (c0<) (c1>) :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("filterNormalize",-     test (\c -> filterNormalize (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (\c -> filterNormalize (c<) :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("filterAppend",-     test (\c -> filterAppend (c<) :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (\c -> filterAppend (c<) :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("filterDuration",-     test (\c -> filterDuration (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (\c -> filterDuration (c<) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("filterPartition",-     test (\c -> filterPartition (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (\c -> filterPartition (c<) :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("filterInfinite",-     test (\c -> filterInfinite (c<) :: NonEmptyList TimeDiff Char -> Bool)) :+     test (\c -> filterInfinite (c<) :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("catMaybesAppend",-     test (catMaybesAppend :: TimeBodyList.T TimeDiff (Maybe Char) -> TimeBodyList.T TimeDiff (Maybe Char) -> Bool)) :+     test (catMaybesAppend :: TimeBodyList.T TimeDiff (Maybe ArbChar) -> TimeBodyList.T TimeDiff (Maybe ArbChar) -> Bool)) :     ("mergeNormalize",-     test (mergeNormalize :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mergeNormalize :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("merge left identity",-     test (mergeLeftIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mergeLeftIdentity :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("merge right identity",-     test (mergeRightIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mergeRightIdentity :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("merge commutative",-     test (mergeCommutative :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mergeCommutative :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("merge associative",-     test (mergeAssociative :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mergeAssociative :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("merge append",-     test (mergeAppend :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mergeAppend :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("mergeMap",-     test (mergeMap succ :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mergeMap succ :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("mergeFilter",      test (\c -> mergeFilter (c>)-             :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+             :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("mergePartition",-     test (\c -> mergePartition (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (\c -> mergePartition (c<) :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("mergeEitherMapMaybe",      test (mergeEitherMapMaybe-         :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+         :: TimeBodyList.T TimeDiff ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("mergeInfinite",      test (mergeInfinite-         :: NonEmptyList TimeDiff Char -> NonEmptyList TimeDiff Char -> Bool)) :+         :: NonEmptyList TimeDiff ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :     ("insert commutative",-     test (insertCommutative :: (TimeDiff, Char) -> (TimeDiff, Char) -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (insertCommutative :: (TimeDiff, ArbChar) -> (TimeDiff, ArbChar) -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("insert merge",-     test (insertMerge :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (insertMerge :: TimeDiff -> ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("insertNormalize",-     test (insertNormalize :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (insertNormalize :: TimeDiff -> ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("insertSplitAtTime",-     test (insertSplitAtTime :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+     test (insertSplitAtTime :: TimeDiff -> ArbChar -> TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("insertInfinite",-     test (insertInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (insertInfinite :: TimeDiff -> ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :     ("moveForwardIdentity",-     test (moveForwardIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (moveForwardIdentity :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("moveForwardAdditive",-     test (moveForwardAdditive :: TimeBodyList.T TimeDiff ((TimeDiff,TimeDiff),Char) -> Bool)) :+     test (moveForwardAdditive :: TimeBodyList.T TimeDiff ((TimeDiff,TimeDiff),ArbChar) -> Bool)) :    ("moveForwardCommutative",-     test (moveForwardCommutative :: TimeBodyList.T TimeDiff ((TimeDiff,TimeDiff),Char) -> Bool)) :+     test (moveForwardCommutative :: TimeBodyList.T TimeDiff ((TimeDiff,TimeDiff),ArbChar) -> Bool)) : {-    ("moveForwardRestricted",-     test (moveForwardRestricted :: TimeDiff -> TimeBodyList.T TimeDiff (TimeDiff,Char) -> Bool)) :+     test (moveForwardRestricted :: TimeDiff -> TimeBodyList.T TimeDiff (TimeDiff,ArbChar) -> Bool)) :    ("moveForwardRestrictedInfinity",-     test (moveForwardRestrictedInfinity :: TimeDiff -> NonEmptyList TimeDiff (TimeDiff,Char) -> Bool)) :+     test (moveForwardRestrictedInfinity :: TimeDiff -> NonEmptyList TimeDiff (TimeDiff,ArbChar) -> Bool)) : -}     ("spanSatisfy",-     test (\c -> spanSatisfy (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (\c -> spanSatisfy (c<) :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("spanAppend",-     test (\c -> spanAppend (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (\c -> spanAppend (c<) :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("spanInfinite",-     test (\c -> spanInfinite (c<) :: NonEmptyList TimeDiff Char -> Bool)) :+     test (\c -> spanInfinite (c<) :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("coincidentFlatten",-     test (coincidentFlatten :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (coincidentFlatten :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("collectCoincidentGaps",-     test (collectCoincidentGaps :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (collectCoincidentGaps :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("collectCoincidentNonEmpty",-     test (collectCoincidentNonEmpty :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (collectCoincidentNonEmpty :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("collectCoincidentInfinite",-     test (collectCoincidentInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+     test (collectCoincidentInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("mapCoincidentMap",-     test (mapCoincidentMap Char.toUpper :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mapCoincidentMap toUpper :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("mapCoincidentComposition",-     test (mapCoincidentComposition reverse reverse :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mapCoincidentComposition reverse reverse :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :    ("mapCoincidentReverse",-     test (mapCoincidentReverse :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (mapCoincidentReverse :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :     ("mapBodyMAppendRandom",-     test (mapBodyMAppendRandom :: Int -> TimeBodyList.T TimeDiff (Char,Char) -> TimeBodyList.T TimeDiff (Char,Char) -> Bool)) :+     test (mapBodyMAppendRandom :: Int -> TimeBodyList.T TimeDiff (ArbChar,ArbChar) -> TimeBodyList.T TimeDiff (ArbChar,ArbChar) -> Bool)) :    ("mapBodyMInfinite",-     test (mapBodyMInfinite :: Int -> NonEmptyList TimeDiff (Char,Char) -> Bool)) :+     test (mapBodyMInfinite :: Int -> NonEmptyList TimeDiff (ArbChar,ArbChar) -> Bool)) :     []
src/Test/Data/EventList/Relative/TimeEnd.hs view
@@ -24,16 +24,16 @@  import Data.EventList.Relative.TimeTimePrivate (($~~), lift) -import qualified Numeric.NonNegative.Class as NonNeg+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 System.Random (Random, randomR, mkStdGen, )-import Control.Monad.State (State(State), evalState, gets, modify, )+import Control.Monad.Trans.State (state, evalState, gets, modify, ) import Control.Monad (liftM2, ) import Data.EventList.Utility (mapFst, ) import qualified Data.List as List-import qualified Data.Char as Char   @@ -47,6 +47,8 @@ viewLConsBody xs =    xs == maybe BodyTimeList.empty (uncurry MixedTimeList.consBody) (MixedTimeList.viewBodyL xs) ++ viewRSnocTime :: (Eq body, Eq time) =>    TimeTimeList.T time body -> Bool viewRSnocTime xs =@@ -59,7 +61,6 @@   - viewLInfinite :: (NonNeg.C time, Eq body) => NonEmptyList time body -> Bool viewLInfinite =    checkInfinite .@@ -75,6 +76,45 @@    makeInfiniteEventList  +switchLConsTime :: (Eq body, Eq time) =>+   TimeTimeList.T time body -> Bool+switchLConsTime xs =+   xs == MixedTimeList.switchTimeL MixedTimeList.consTime xs++switchLConsBody :: (Eq body, Eq time) =>+   BodyTimeList.T time body -> Bool+switchLConsBody xs =+   xs == MixedTimeList.switchBodyL BodyTimeList.empty MixedTimeList.consBody xs++++switchRSnocTime :: (Eq body, Eq time) =>+   TimeTimeList.T time body -> Bool+switchRSnocTime xs =+   xs == TimeMixedList.switchTimeR TimeMixedList.snocTime xs++switchRSnocBody :: (Eq body, Eq time) =>+   TimeBodyList.T time body -> Bool+switchRSnocBody xs =+   xs == TimeMixedList.switchBodyR TimeBodyList.empty TimeMixedList.snocBody xs++++switchLInfinite :: (NonNeg.C time, Eq body) => NonEmptyList time body -> Bool+switchLInfinite =+   checkInfinite .+   MixedTimeList.switchBodyL (error "switchBodyL: empty list") (flip const) .+   MixedTimeList.switchTimeL (flip const) .+   makeInfiniteEventList++switchRInfinite :: (NonNeg.C time, Eq body) => NonEmptyList time body -> Bool+switchRInfinite =+   checkInfinite .+   TimeMixedList.switchBodyR (error "switchBodyR: empty list") const .+   TimeMixedList.switchTimeR const .+   makeInfiniteEventList++ consInfinite :: (NonNeg.C time, Eq body) =>    time -> body -> NonEmptyList time body -> Bool consInfinite time body =@@ -423,6 +463,35 @@    TimeTimeList.append (TimeTimeList.catMaybes xs) (TimeTimeList.catMaybes ys)  +catMaybesRInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time (Maybe body) -> Bool+catMaybesRInfinite xs =+   {-+   @(1+) is needed in order to assert that the accumulated time is infinite+   and can be clipped by @min 100@.+   -}+   let t =+         min 100 $+         List.foldr (+) 0 $+         TimeTimeList.getTimes $+         TimeTimeList.catMaybesR $+         TimeTimeList.mapTime (NonNegChunky.fromNumber . (1+)) $+         makeInfiniteEventList xs+   in  t == t++catMaybesRInitInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> Bool+catMaybesRInitInfinite xs =+   let t =+         min 100 $+         MixedTimeList.switchTimeL const $+         TimeTimeList.catMaybesR $+         TimeTimeList.mapBody (const (Nothing::Maybe())) $+         TimeTimeList.mapTime (NonNegChunky.fromNumber . (1+)) $+         makeInfiniteEventList xs+   in  t == t++ {- | 'TimeTimeList.merge' preserves normalization of its operands. -}@@ -775,7 +844,7 @@ mapBodyMAppendRandom seed =    mapBodyMAppend       (flip evalState (mkStdGen seed))-      (State . randomR)+      (state . randomR)   mapBodyMInfinite ::@@ -784,7 +853,7 @@ mapBodyMInfinite seed =    checkInfinite .    flip evalState (mkStdGen seed) .-   TimeTimeList.mapM return (State . randomR) .+   TimeTimeList.mapM return (state . randomR) .    makeInfiniteEventList  @@ -899,10 +968,9 @@    TimeTimeList.T time body -> Bool checkInfinite xs0 =    let (x,xs) = MixedTimeList.viewTimeL (lift (Mixed.dropUniform 100) xs0)-       y = maybe+       y = MixedTimeList.switchBodyL               (error "checkInfinite: finite list")-              fst-              (MixedTimeList.viewBodyL xs)+              const xs    in  x == x && y == y  @@ -910,226 +978,245 @@ tests :: [(String, IO ())] tests =    ("viewTimeL consTime",-     test (viewLConsTime :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (viewLConsTime :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("viewBodyL consBody",-     test (viewLConsBody :: BodyTimeList.T TimeDiff Char -> Bool)) :+     test (viewLConsBody :: BodyTimeList.T TimeDiff ArbChar -> Bool)) :    ("viewTimeR snocTime",-     test (viewRSnocTime :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (viewRSnocTime :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("viewBodyR snocBody",-     test (viewRSnocBody :: TimeBodyList.T TimeDiff Char -> Bool)) :+     test (viewRSnocBody :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :     ("viewLInfinite",-     test (viewLInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+     test (viewLInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("viewRInfinite",-     test (viewRInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+     test (viewRInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :++   ("switchTimeL consTime",+     test (switchLConsTime :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :+   ("switchBodyL consBody",+     test (switchLConsBody :: BodyTimeList.T TimeDiff ArbChar -> Bool)) :+   ("switchTimeR snocTime",+     test (switchRSnocTime :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :+   ("switchBodyR snocBody",+     test (switchRSnocBody :: TimeBodyList.T TimeDiff ArbChar -> Bool)) :++   ("switchLInfinite",+     test (switchLInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :+   ("switchRInfinite",+     test (switchRInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :+    ("consInfinite",-     test (consInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (consInfinite :: TimeDiff -> ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("consTimeBodyInfinite",-     test (consTimeBodyInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (consTimeBodyInfinite :: TimeDiff -> ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("snocInfinite",-     test (snocInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (snocInfinite :: TimeDiff -> ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("snocTimeBodyInfinite",-     test (snocTimeBodyInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (snocTimeBodyInfinite :: TimeDiff -> ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("consInfix",-     test (consInfix :: TimeDiff -> Char -> TimeDiff -> TimeDiff -> Char -> TimeDiff -> Bool)) :+     test (consInfix :: TimeDiff -> ArbChar -> TimeDiff -> TimeDiff -> ArbChar -> TimeDiff -> Bool)) :      ("map body composition",-     test (mapBodyComposition Char.toUpper Char.toLower-               :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mapBodyComposition toUpper toLower+               :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("map time composition",      test ((\dt0 dt1 -> mapTimeComposition (dt0+) (dt1+))-               :: TimeDiff -> TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+               :: TimeDiff -> TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("map time body commutative",-     test ((\dt -> mapTimeBodyCommutative (dt+) Char.toUpper)-               :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test ((\dt -> mapTimeBodyCommutative (dt+) toUpper)+               :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :     ("mapBodyInfinite",-     test (mapBodyInfinite Char.toUpper-               :: NonEmptyList TimeDiff Char -> Bool)) :+     test (mapBodyInfinite toUpper+               :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("mapTimeInfinite",      test (\dt -> mapTimeInfinite (dt+)-               :: NonEmptyList TimeDiff Char -> Bool)) :+               :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("mapNormalize",      test (mapNormalize succ-               :: TimeTimeList.T TimeDiff Char -> Bool)) :+               :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :     ("append left identity",-     test (appendLeftIdentity :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (appendLeftIdentity :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("append right identity",-     test (appendRightIdentity :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (appendRightIdentity :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("append associative",      test (appendAssociative-              :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char ->-                 TimeTimeList.T TimeDiff Char -> Bool)) :+              :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar ->+                 TimeTimeList.T TimeDiff ArbChar -> Bool)) :     ("appendCons",-     test (appendCons :: TimeDiff -> Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (appendCons :: TimeDiff -> ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("mapBodyAppend",-     test (mapBodyAppend Char.toUpper-               :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mapBodyAppend toUpper+               :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("appendSplitAtTime",-     test (appendSplitAtTime :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (appendSplitAtTime :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("appendFirstInfinite",-     test (appendFirstInfinite :: NonEmptyList TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (appendFirstInfinite :: NonEmptyList TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("appendSecondInfinite",-     test (appendSecondInfinite :: TimeTimeList.T TimeDiff Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (appendSecondInfinite :: TimeTimeList.T TimeDiff ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("concatNaive",-     test (concatNaive :: [TimeTimeList.T TimeDiff Char] -> Bool)) :+     test (concatNaive :: [TimeTimeList.T TimeDiff ArbChar] -> Bool)) :    ("cycleNaive",-     test (cycleNaive :: NonEmptyList TimeDiff Char -> Bool)) :+     test (cycleNaive :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("cycleInfinite",-     test (cycleInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+     test (cycleInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("decreaseStart delay",-     test (decreaseStartDelay :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (decreaseStartDelay :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("decreaseStartInfinite",-     test (decreaseStartInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+     test (decreaseStartInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :     ("delay additive",-     test (delayAdditive :: TimeDiff -> TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (delayAdditive :: TimeDiff -> TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("delay pause",      test (delayPause :: TimeDiff -> TimeDiff -> Bool)) :    ("delay append pause",-     test (delayAppendPause :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (delayAppendPause :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("delayInfinite",-     test (delayInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+     test (delayInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :     ("splitAtTakeDropTime",-     test (splitAtTakeDropTime :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (splitAtTakeDropTime :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("takeTimeEndPause",-     test (takeTimeEndPause :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (takeTimeEndPause :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("takeTimeAppendFirst",-     test (takeTimeAppendFirst :: TimeDiff -> TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (takeTimeAppendFirst :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("takeTimeAppendSecond",-     test (takeTimeAppendSecond :: TimeDiff -> TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (takeTimeAppendSecond :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("takeTimeNormalize",-     test (takeTimeNormalize :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (takeTimeNormalize :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("dropTimeNormalize",-     test (dropTimeNormalize :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (dropTimeNormalize :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("takeTimeInfinite",-     test (takeTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+     test (takeTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("dropTimeInfinite",-     test (dropTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+     test (dropTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :     ("duration pause",      test (durationPause :: TimeDiff -> Bool)) :    ("duration append",-     test (durationAppend :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (durationAppend :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("duration merge",-     test (durationMerge :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (durationMerge :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("durationTakeTime",-     test (durationTakeTime :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (durationTakeTime :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("durationDropTime",-     test (durationDropTime :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (durationDropTime :: TimeDiff -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :     ("filterSatisfy",-     test (\c -> filterSatisfy (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (\c -> filterSatisfy (c<) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("filterProjection",-     test (\c -> filterProjection (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (\c -> filterProjection (c<) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("filterCommutative",-     test (\c0 c1 -> filterCommutative (c0<) (c1>) :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (\c0 c1 -> filterCommutative (c0<) (c1>) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("filterComposition",-     test (\c0 c1 -> filterComposition (c0<) (c1>) :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (\c0 c1 -> filterComposition (c0<) (c1>) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("filterNormalize",-     test (\c -> filterNormalize (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (\c -> filterNormalize (c<) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("filterAppend",-     test (\c -> filterAppend (c<) :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (\c -> filterAppend (c<) :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("filterDuration",-     test (\c -> filterDuration (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (\c -> filterDuration (c<) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("filterPartition",-     test (\c -> filterPartition (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (\c -> filterPartition (c<) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("filterInfinite",-     test (\c -> filterInfinite (c<) :: NonEmptyList TimeDiff Char -> Bool)) :+     test (\c -> filterInfinite (c<) :: NonEmptyList TimeDiff ArbChar -> Bool)) :    ("catMaybesAppend",-     test (catMaybesAppend :: TimeTimeList.T TimeDiff (Maybe Char) -> TimeTimeList.T TimeDiff (Maybe Char) -> Bool)) :+     test (catMaybesAppend :: TimeTimeList.T TimeDiff (Maybe ArbChar) -> TimeTimeList.T TimeDiff (Maybe ArbChar) -> Bool)) :+   ("catMaybesRInfinite",+     test (catMaybesRInfinite :: NonEmptyList TimeDiff (Maybe ArbChar) -> Bool)) :+   ("catMaybesRInitInfinite",+     test (catMaybesRInitInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("mergeNormalize",-     test (mergeNormalize :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mergeNormalize :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("merge left identity",-     test (mergeLeftIdentity :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mergeLeftIdentity :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("merge right identity",-     test (mergeRightIdentity :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mergeRightIdentity :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("merge commutative",-     test (mergeCommutative :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mergeCommutative :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("merge associative",-     test (mergeAssociative :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mergeAssociative :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("merge append",-     test (mergeAppend :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mergeAppend :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("appendByMerge",-     test (appendByMerge :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (appendByMerge :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("mergeMap",-     test (mergeMap succ :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mergeMap succ :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("mergeFilter",      test (\c -> mergeFilter (c>)-             :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+             :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("mergePartition",-     test (\c -> mergePartition (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (\c -> mergePartition (c<) :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("mergeEitherMapMaybe",      test (mergeEitherMapMaybe-         :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+         :: TimeTimeList.T TimeDiff ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("mergeInfinite",      test (mergeInfinite-         :: NonEmptyList TimeDiff Char -> NonEmptyList TimeDiff Char -> Bool)) :+         :: NonEmptyList TimeDiff ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :     ("insertCommutative",-     test (insertCommutative :: (TimeDiff, Char) -> (TimeDiff, Char) -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (insertCommutative :: (TimeDiff, ArbChar) -> (TimeDiff, ArbChar) -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("insertMerge",-     test (insertMerge :: TimeDiff -> Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (insertMerge :: TimeDiff -> ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("insertNormalize",-     test (insertNormalize :: TimeDiff -> Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (insertNormalize :: TimeDiff -> ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("insertSplitAtTime",-     test (insertSplitAtTime :: TimeDiff -> Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+     test (insertSplitAtTime :: TimeDiff -> ArbChar -> TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("insertInfinite",-     test (insertInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+     test (insertInfinite :: TimeDiff -> ArbChar -> NonEmptyList TimeDiff ArbChar -> Bool)) :     ("moveForwardIdentity",-     test (moveForwardIdentity :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (moveForwardIdentity :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("moveForwardAdditive",-     test (moveForwardAdditive :: TimeTimeList.T TimeDiff ((TimeDiff,TimeDiff),Char) -> Bool)) :+     test (moveForwardAdditive :: TimeTimeList.T TimeDiff ((TimeDiff,TimeDiff),ArbChar) -> Bool)) :    ("moveForwardCommutative",-     test (moveForwardCommutative :: TimeTimeList.T TimeDiff ((TimeDiff,TimeDiff),Char) -> Bool)) :+     test (moveForwardCommutative :: TimeTimeList.T TimeDiff ((TimeDiff,TimeDiff),ArbChar) -> Bool)) :    ("moveForwardRestricted",-     test (moveForwardRestricted :: TimeDiff -> TimeTimeList.T TimeDiff (TimeDiff,Char) -> Bool)) :+     test (moveForwardRestricted :: TimeDiff -> TimeTimeList.T TimeDiff (TimeDiff,ArbChar) -> Bool)) :    ("moveForwardRestrictedInfinity",-     test (moveForwardRestrictedInfinity :: TimeDiff -> NonEmptyList TimeDiff (TimeDiff,Char) -> Bool)) :+     test (moveForwardRestrictedInfinity :: TimeDiff -> NonEmptyList TimeDiff (TimeDiff,ArbChar) -> Bool)) :     ("arrangeSingletons",      test (arrangeSingletons ::-        TimeTimeList.T TimeDiff Char -> Bool)) :+        TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("arrangeDelay",      test (arrangeDelay ::-        TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+        TimeDiff -> NonEmptyList TimeDiff ArbChar -> Bool)) :    ("arrangeSimple",      test (arrangeSimple ::-        TimeTimeList.T TimeDiff (TimeTimeList.T TimeDiff Char) -> Bool)) :+        TimeTimeList.T TimeDiff (TimeTimeList.T TimeDiff ArbChar) -> Bool)) :    ("arrangeAbsolute",      test (arrangeAbsolute ::-        TimeTimeList.T TimeDiff (TimeTimeList.T TimeDiff Char) -> Bool)) :+        TimeTimeList.T TimeDiff (TimeTimeList.T TimeDiff ArbChar) -> Bool)) :    ("arrangeInfinity",      test (arrangeInfinity ::-        NonEmptyList TimeDiff (NonEmptyList TimeDiff Char) -> Bool)) :+        NonEmptyList TimeDiff (NonEmptyList TimeDiff ArbChar) -> Bool)) :     ("coincidentFlatten",-     test (coincidentFlatten :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (coincidentFlatten :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("collectCoincidentGaps",-     test (collectCoincidentGaps :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (collectCoincidentGaps :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("collectCoincidentNonEmpty",-     test (collectCoincidentNonEmpty :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (collectCoincidentNonEmpty :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("collectCoincidentInfinite",-     test (collectCoincidentInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+     test (collectCoincidentInfinite :: NonEmptyList TimeDiff ArbChar -> Bool)) :     ("mapCoincidentMap",-     test (mapCoincidentMap Char.toUpper :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mapCoincidentMap toUpper :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("mapCoincidentComposition",-     test (mapCoincidentComposition reverse reverse :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mapCoincidentComposition reverse reverse :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :    ("mapCoincidentReverse",-     test (mapCoincidentReverse :: TimeTimeList.T TimeDiff Char -> Bool)) :+     test (mapCoincidentReverse :: TimeTimeList.T TimeDiff ArbChar -> Bool)) :     ("mapBodyMAppendRandom",-     test (mapBodyMAppendRandom :: Int -> TimeTimeList.T TimeDiff (Char,Char) -> TimeTimeList.T TimeDiff (Char,Char) -> Bool)) :+     test (mapBodyMAppendRandom :: Int -> TimeTimeList.T TimeDiff (ArbChar,ArbChar) -> TimeTimeList.T TimeDiff (ArbChar,ArbChar) -> Bool)) :    ("mapBodyMInfinite",-     test (mapBodyMInfinite :: Int -> NonEmptyList TimeDiff (Char,Char) -> Bool)) :+     test (mapBodyMInfinite :: Int -> NonEmptyList TimeDiff (ArbChar,ArbChar) -> Bool)) :     []
src/Test/Utility.hs view
@@ -2,7 +2,29 @@  import qualified Numeric.NonNegative.Wrapper as NonNeg -import Test.Instances ()+import Test.QuickCheck (Arbitrary(..))++import qualified Data.Char as Char+import System.Random (Random, )+import Control.Monad (liftM, )+++newtype ArbChar = ArbChar Char+   deriving (Eq, Ord, Enum, Random)++instance Show ArbChar where+   showsPrec n (ArbChar c) = showsPrec n c++instance Arbitrary ArbChar where+   arbitrary = liftM (ArbChar . Char.chr . (32+) . flip mod 96) arbitrary+   coarbitrary = undefined++toLower :: ArbChar -> ArbChar+toLower (ArbChar c) = ArbChar (Char.toLower c)++toUpper :: ArbChar -> ArbChar+toUpper (ArbChar c) = ArbChar (Char.toUpper c)+   type TimeDiff = NonNeg.Int