event-list-0.0.5: Test/Data/EventList/Relative/BodyEnd.hs

module Test.Data.EventList.Relative.BodyEnd (tests) where

import Test.Utility
import Test.QuickCheck (test)

import qualified Data.EventList.Relative.TimeBody as TimeBodyList
import qualified Data.EventList.Relative.TimeTime as TimeTimeList
import qualified Data.EventList.Relative.TimeMixed as TimeMixedList
import qualified Data.EventList.Relative.MixedBody as MixedBodyList
import qualified Data.EventList.Relative.BodyBody as BodyBodyList
import qualified Data.AlternatingList.List.Disparate as Disp

import qualified Data.EventList.Relative.TimeBodyPrivate as TimeBodyPriv

import Data.EventList.Relative.MixedBody ((/.), (./), empty)

import qualified Numeric.NonNegative.Class as NonNeg
import Numeric.NonNegative.Class ((-|))
import Data.EventList.Relative.TimeBody (isNormalized)

import Data.EventList.Utility (mapPair)
import System.Random (Random, randomR, mkStdGen)
import Control.Monad.State (State(State), evalState)
import Control.Monad (liftM2)
import Data.Maybe (isJust)
import qualified Data.List as List
import qualified Data.Char as Char



viewLConsTime :: (Eq body, Eq time) =>
   TimeBodyList.T time body -> Bool
viewLConsTime xs =
   xs == maybe TimeBodyList.empty (uncurry MixedBodyList.consTime) (MixedBodyList.viewTimeL xs)

viewLConsBody :: (Eq body, Eq time) =>
   BodyBodyList.T time body -> Bool
viewLConsBody xs =
   xs == uncurry MixedBodyList.consBody (MixedBodyList.viewBodyL xs)



viewLInfinite :: (NonNeg.C time, Eq body) => NonEmptyList time body -> Bool
viewLInfinite =
   checkInfinite .
   maybe (error "viewBodyL: empty list") snd .
   TimeBodyList.viewL .
   makeInfiniteEventList


consInfinite :: (NonNeg.C time, Eq body) =>
   time -> body -> NonEmptyList time body -> Bool
consInfinite time body =
   checkInfinite .
   TimeBodyList.cons time body .
   makeInfiniteEventList

consTimeBodyInfinite :: (NonNeg.C time, Eq body) =>
   time -> body -> NonEmptyList time body -> Bool
consTimeBodyInfinite time body =
   checkInfinite .
   MixedBodyList.consTime time .
   MixedBodyList.consBody body .
   makeInfiniteEventList


snocInfinite :: (NonNeg.C time, Eq body) =>
   time -> body -> NonEmptyList time body -> Bool
snocInfinite time body =
   checkInfinite .
   flip (flip TimeBodyList.snoc time) body .
   makeInfiniteEventList


consInfix :: (NonNeg.C time, Eq body) =>
   time -> body -> time -> body -> Bool
consInfix t0 b0 t1 b1 =
   TimeBodyList.append (t0 /. b0 ./ empty) (t1 /. b1 ./ empty)
      == (t0 /. b0 ./ t1 /. b1 ./ empty)


mapBodyComposition :: (Eq body2, Eq time) =>
   (body0 -> body1) -> (body1 -> body2) -> TimeBodyList.T time body0 -> Bool
mapBodyComposition f g evs =
   TimeBodyList.mapBody (g . f) evs  ==
   TimeBodyList.mapBody g (TimeBodyList.mapBody f evs)

mapTimeComposition :: (Eq body, Eq time2) =>
   (time0 -> time1) -> (time1 -> time2) -> TimeBodyList.T time0 body -> Bool
mapTimeComposition f g evs =
   TimeBodyList.mapTime (g . f) evs  ==
   TimeBodyList.mapTime g (TimeBodyList.mapTime f evs)


mapTimeBodyCommutative :: (Eq body1, Eq time1) =>
   (time0 -> time1) -> (body0 -> body1) -> TimeBodyList.T time0 body0 -> Bool
mapTimeBodyCommutative f g evs =
   TimeBodyList.mapBody g (TimeBodyList.mapTime f evs)  ==
   TimeBodyList.mapTime f (TimeBodyList.mapBody g evs)



mapBodyInfinite :: (NonNeg.C time, Eq body1) =>
   (body0 -> body1) -> NonEmptyList time body0 -> Bool
mapBodyInfinite f =
   checkInfinite . TimeBodyList.mapBody f . makeInfiniteEventList

mapTimeInfinite :: (NonNeg.C time0, Eq time1, Eq body) =>
   (time0 -> time1) -> NonEmptyList time0 body -> Bool
mapTimeInfinite f =
   checkInfinite . TimeBodyList.mapTime f . makeInfiniteEventList



{- |
Does only hold for monotonic functions.
-}
mapNormalize :: (NonNeg.C time, Ord body0, Ord body1) =>
   (body0 -> body1) -> TimeBodyList.T time body0 -> Bool
mapNormalize f =
   isNormalized . TimeBodyList.mapBody f . TimeBodyList.normalize



appendLeftIdentity :: (NonNeg.C time, Eq body) =>
   TimeBodyList.T time body -> Bool
appendLeftIdentity xs =
   TimeBodyList.append TimeBodyList.empty xs  ==  xs

appendRightIdentity :: (NonNeg.C time, Eq body) =>
   TimeBodyList.T time body -> Bool
appendRightIdentity xs =
   TimeBodyList.append xs TimeBodyList.empty  ==  xs

appendAssociative :: (NonNeg.C time, Eq body) =>
   TimeBodyList.T time body -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
appendAssociative xs ys zs =
   TimeBodyList.append xs (TimeBodyList.append ys zs)  ==
   TimeBodyList.append (TimeBodyList.append xs ys) zs

appendCons :: (NonNeg.C time, Eq body) =>
   time -> body -> TimeBodyList.T time body -> Bool
appendCons time body xs =
   TimeBodyList.cons time body xs  ==
   TimeBodyList.append (TimeBodyList.cons time body TimeBodyList.empty) xs

appendSplitAtTime :: (NonNeg.C time, Eq body) =>
   time -> TimeBodyList.T time body -> Bool
appendSplitAtTime t xs =
   xs == uncurry TimeMixedList.appendBodyEnd (TimeMixedList.splitAtTime t xs)

mapBodyAppend :: (Eq body1, NonNeg.C time) =>
   (body0 -> body1) -> TimeBodyList.T time body0 -> TimeBodyList.T time body0 -> Bool
mapBodyAppend f xs ys =
   TimeBodyList.mapBody f (TimeBodyList.append xs ys)  ==
   TimeBodyList.append (TimeBodyList.mapBody f xs) (TimeBodyList.mapBody f ys)


appendFirstInfinite :: (NonNeg.C time, Eq body) =>
   NonEmptyList time body -> TimeBodyList.T time body -> Bool
appendFirstInfinite xs =
   checkInfinite . TimeBodyList.append (makeInfiniteEventList xs)

appendSecondInfinite :: (NonNeg.C time, Eq body) =>
   TimeBodyList.T time body -> NonEmptyList time body -> Bool
appendSecondInfinite xs =
   checkInfinite . TimeBodyList.append xs . makeInfiniteEventList


decreaseStartDelay :: (NonNeg.C time, Eq body) =>
   time -> TimeBodyList.T time body -> Bool
decreaseStartDelay dif xs =
   xs == TimeBodyList.decreaseStart dif (TimeBodyList.delay dif xs)

decreaseStartInfinite :: (NonNeg.C time, Eq body) =>
   time -> NonEmptyList time body -> Bool
decreaseStartInfinite dif =
   checkInfinite .
   TimeBodyList.decreaseStart dif .
   TimeBodyList.delay dif .
   makeInfiniteEventList

delayAdditive :: (NonNeg.C time, Eq body) =>
   time -> time -> TimeBodyList.T time body -> Bool
delayAdditive dif0 dif1 xs =
   TimeBodyList.delay (dif0+dif1) xs ==
   TimeBodyList.delay dif0 (TimeBodyList.delay dif1 xs)

delayAppendPause :: (NonNeg.C time, Eq body) =>
   time -> TimeBodyList.T time body -> Bool
delayAppendPause dif xs =
   TimeBodyList.delay dif xs == TimeMixedList.appendBodyEnd (TimeTimeList.pause dif) xs

delayInfinite :: (NonNeg.C time, Eq body) =>
   time -> NonEmptyList time body -> Bool
delayInfinite dif =
   checkInfinite .
   TimeBodyList.delay dif .
   makeInfiniteEventList



splitAtTakeDropTime :: (NonNeg.C time, Eq body) =>
   time -> TimeBodyList.T time body -> Bool
splitAtTakeDropTime t xs =
   (TimeMixedList.takeTime t xs, TimeMixedList.dropTime t xs) ==
   TimeMixedList.splitAtTime t xs

takeTimeEndPause :: (NonNeg.C time, Ord body) =>
   time -> TimeBodyList.T time body -> Bool
takeTimeEndPause t xs =
   t == 0 ||
   t >= TimeBodyList.duration xs ||
   0 <  snd (TimeMixedList.viewTimeR (TimeMixedList.takeTime t xs))

takeTimeAppendFirst :: (NonNeg.C time, Eq body) =>
   time -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
takeTimeAppendFirst t xs ys =
   TimeMixedList.takeTime t (TimeBodyList.append xs ys) ==
   TimeTimeList.append
      (TimeMixedList.takeTime t xs)
      (TimeMixedList.takeTime (t -| TimeBodyList.duration xs) ys)

takeTimeAppendSecond :: (NonNeg.C time, Eq body) =>
   time -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
takeTimeAppendSecond t xs ys0 =
   -- the second list must not start with a zero pause
   let ys = TimeBodyList.delay 1 ys0
       t1 = t+1
   in  TimeMixedList.takeTime (TimeBodyList.duration xs + t1) (TimeBodyList.append xs ys) ==
       TimeMixedList.prependBodyEnd xs (TimeMixedList.takeTime t1 ys)

takeTimeNormalize :: (NonNeg.C time, Ord body) =>
   time -> TimeBodyList.T time body -> Bool
takeTimeNormalize t =
   TimeTimeList.isNormalized . TimeMixedList.takeTime t . TimeBodyList.normalize

dropTimeNormalize :: (NonNeg.C time, Ord body) =>
   time -> TimeBodyList.T time body -> Bool
dropTimeNormalize t =
   isNormalized . TimeMixedList.dropTime t . TimeBodyList.normalize

takeTimeInfinite :: (NonNeg.C time, Ord body) =>
   time -> NonEmptyList time body -> Bool
takeTimeInfinite t =
   (t == ) . TimeTimeList.duration .
   TimeMixedList.takeTime t . makeUncollapsedInfiniteEventList

dropTimeInfinite :: (NonNeg.C time, Ord body) =>
   time -> NonEmptyList time body -> Bool
dropTimeInfinite t =
   checkInfinite . TimeMixedList.dropTime t . makeUncollapsedInfiniteEventList




durationPause :: (NonNeg.C time) =>
   time -> Bool
durationPause t =
   t == TimeBodyList.duration (TimeBodyList.singleton t (error "durationPause: no need to access body"))

durationAppend :: (NonNeg.C time) =>
   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
durationAppend xs ys =
   TimeBodyList.duration (TimeBodyList.append xs ys)  ==
   TimeBodyList.duration xs + TimeBodyList.duration ys

durationMerge :: (NonNeg.C time, Ord body) =>
   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
durationMerge xs ys =
   TimeBodyList.duration (TimeBodyList.merge xs ys)  ==
   max (TimeBodyList.duration xs) (TimeBodyList.duration ys)

durationTakeTime :: (NonNeg.C time, Eq body) =>
   time -> TimeBodyList.T time body -> Bool
durationTakeTime t xs =
   min (TimeBodyList.duration xs) t ==
   TimeTimeList.duration (TimeMixedList.takeTime t xs)

durationDropTime :: (NonNeg.C time, Eq body) =>
   time -> TimeBodyList.T time body -> Bool
durationDropTime t xs =
   TimeBodyList.duration xs -| t ==
   TimeBodyList.duration (TimeMixedList.dropTime t xs)



equalPrefix :: (Eq time, Eq body) =>
   Int -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
equalPrefix n xs ys =
   TimeBodyPriv.lift (Disp.take n) xs ==
   TimeBodyPriv.lift (Disp.take n) ys

cycleInfinite :: (NonNeg.C time, Eq body) =>
   NonEmptyList time body -> Bool
cycleInfinite xs0 =
   let xs = makeInfiniteEventList xs0
   in  equalPrefix 100 xs (TimeBodyList.cycle xs)


filterSatisfy :: (Num time) =>
   (body -> Bool) ->
   TimeBodyList.T time body -> Bool
filterSatisfy p =
   all p . TimeBodyList.getBodies . TimeBodyList.filter p

filterProjection :: (Num time, Eq body) =>
   (body -> Bool) ->
   TimeBodyList.T time body -> Bool
filterProjection p xs =
   TimeBodyList.filter p xs ==
   TimeBodyList.filter p (TimeBodyList.filter p xs)

filterCommutative :: (Num time, Eq body) =>
   (body -> Bool) ->
   (body -> Bool) ->
   TimeBodyList.T time body -> Bool
filterCommutative p q xs =
   TimeBodyList.filter p (TimeBodyList.filter q xs) ==
   TimeBodyList.filter q (TimeBodyList.filter p xs)

filterComposition :: (Num time, Eq body) =>
   (body -> Bool) ->
   (body -> Bool) ->
   TimeBodyList.T time body -> Bool
filterComposition p q xs =
   TimeBodyList.filter p (TimeBodyList.filter q xs) ==
   TimeBodyList.filter (\b -> p b && q b) xs

filterNormalize :: (NonNeg.C time, Ord body) =>
   (body -> Bool) ->
   TimeBodyList.T time body -> Bool
filterNormalize p =
   isNormalized . TimeBodyList.filter p . TimeBodyList.normalize

filterAppend :: (NonNeg.C time, Eq body) =>
   (body -> Bool) ->
   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
filterAppend p xs0 ys =
   let xs = TimeBodyList.filter p xs0
   in  TimeBodyList.filter p (TimeBodyList.append xs ys)  ==
       TimeBodyList.append xs (TimeBodyList.filter p ys)

filterDuration :: (NonNeg.C time, Eq body) =>
   (body -> Bool) -> TimeTimeList.T time body -> Bool
filterDuration p xs =
   TimeTimeList.duration xs >= TimeTimeList.duration (TimeTimeList.filter p xs)

filterPartition :: (NonNeg.C time, Ord body) =>
   (body -> Bool) -> TimeBodyList.T time body -> Bool
filterPartition p xs =
   (TimeBodyList.filter p xs, TimeBodyList.filter (not . p) xs) ==
   TimeBodyList.partition p xs


filterInfinite :: (NonNeg.C time, Eq body) =>
   (body -> Bool) -> NonEmptyList time body -> Bool
filterInfinite p xs =
   null (TimeBodyList.getBodies (TimeBodyList.filter p (makeNonEmptyEventList xs)))
   ||
   (checkInfinite .
    TimeBodyList.filter p .
    makeInfiniteEventList) xs

catMaybesAppend :: (NonNeg.C time, Eq body) =>
   TimeBodyList.T time (Maybe body) -> TimeBodyList.T time (Maybe body) -> Bool
catMaybesAppend xs0 ys =
   let xs = TimeBodyList.filter isJust xs0
   in  TimeBodyList.catMaybes (TimeBodyList.append xs ys)  ==
       TimeBodyList.append (TimeBodyList.catMaybes xs) (TimeBodyList.catMaybes ys)


{- |
'TimeBodyList.merge' preserves normalization of its operands.
-}
mergeNormalize :: (NonNeg.C time, Ord body) =>
   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
mergeNormalize xs0 ys0 =
   let xs = TimeBodyList.normalize xs0
       ys = TimeBodyList.normalize ys0
   in  isNormalized $ TimeBodyList.merge xs ys

mergeLeftIdentity :: (NonNeg.C time, Ord body) =>
   TimeBodyList.T time body -> Bool
mergeLeftIdentity xs =
   TimeBodyList.merge TimeBodyList.empty xs  ==  xs

mergeRightIdentity :: (NonNeg.C time, Ord body) =>
   TimeBodyList.T time body -> Bool
mergeRightIdentity xs =
   TimeBodyList.merge xs TimeBodyList.empty  ==  xs

mergeCommutative :: (NonNeg.C time, Ord body) =>
   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
mergeCommutative xs0 ys0 =
   let xs = TimeBodyList.normalize xs0
       ys = TimeBodyList.normalize ys0
   in  TimeBodyList.merge xs ys  ==  TimeBodyList.merge ys xs

mergeAssociative :: (NonNeg.C time, Ord body) =>
   TimeBodyList.T time body -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
mergeAssociative xs0 ys0 zs0 =
   let xs = TimeBodyList.normalize xs0
       ys = TimeBodyList.normalize ys0
       zs = TimeBodyList.normalize zs0
   in  TimeBodyList.merge xs (TimeBodyList.merge ys zs)  ==
       TimeBodyList.merge (TimeBodyList.merge xs ys) zs

{-
Prior normalization is not enough,
because 'append' does not preserve normalization
if the first list ends with time difference 0
and the second one starts with time difference 0.
-}
mergeAppend :: (NonNeg.C time, Ord body) =>
   TimeBodyList.T time body -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
mergeAppend xs ys zs =
   TimeBodyList.normalize (TimeBodyList.append xs (TimeBodyList.merge ys zs))  ==
   TimeBodyList.normalize
      (TimeBodyList.merge (TimeBodyList.append xs ys)
          (TimeBodyList.delay (TimeBodyList.duration xs) zs))

{-
Normalization is important

does only hold for monotonic functions
toUpper and toLower are not monotonic
-}

mergeMap :: (NonNeg.C time, Ord body0 ,Ord body1) =>
   (body0 -> body1) -> TimeBodyList.T time body0 -> TimeBodyList.T time body0 -> Bool
mergeMap f xs0 ys0 =
   let xs = TimeBodyList.normalize xs0
       ys = TimeBodyList.normalize ys0
   in  TimeBodyList.mapBody f (TimeBodyList.merge xs ys)  ==
       TimeBodyList.merge (TimeBodyList.mapBody f xs) (TimeBodyList.mapBody f ys)

mergeFilter :: (NonNeg.C time, Ord body) =>
   (body -> Bool) -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
mergeFilter p xs0 ys0 =
   let xs = TimeBodyList.normalize xs0
       ys = TimeBodyList.normalize ys0
   in  TimeBodyList.filter p (TimeBodyList.merge xs ys)  ==
       TimeBodyList.merge (TimeBodyList.filter p xs) (TimeBodyList.filter p ys)

mergePartition :: (NonNeg.C time, Ord body) =>
   (body -> Bool) -> TimeBodyList.T time body -> Bool
mergePartition p xs0 =
   let xs = TimeBodyList.normalize xs0
   in  xs  ==  uncurry TimeBodyList.merge (TimeBodyList.partition p xs)

mergeEitherMapMaybe :: (NonNeg.C time, Ord body) =>
   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool
mergeEitherMapMaybe xs0 ys0 =
   let xs = TimeBodyList.normalize xs0
       ys = TimeBodyList.normalize ys0
       zs = TimeBodyList.merge
               (TimeBodyList.mapBody Left xs)
               (TimeBodyList.mapBody Right ys)
   in  xs  ==  TimeBodyList.mapMaybe (either Just (const Nothing)) zs
       &&
       ys  ==  TimeBodyList.mapMaybe (either (const Nothing) Just) zs


mergeInfinite :: (NonNeg.C time, Ord body) =>
   NonEmptyList time body ->
   NonEmptyList time body -> Bool
mergeInfinite xs0 ys0 =
   let xs = makeInfiniteEventList xs0
       ys = makeInfiniteEventList ys0
   in  checkInfinite (TimeBodyList.merge xs ys)



insertCommutative :: (NonNeg.C time, Ord body) =>
   (time, body) -> (time, body) -> TimeBodyList.T time body -> Bool
insertCommutative (time0, body0) (time1, body1) evs =
   TimeBodyList.insert time0 body0 (TimeBodyList.insert time1 body1 evs)  ==
   TimeBodyList.insert time1 body1 (TimeBodyList.insert time0 body0 evs)

insertMerge :: (NonNeg.C time, Ord body) =>
   time -> body -> TimeBodyList.T time body -> Bool
insertMerge time body evs =
   TimeBodyList.insert time body evs  ==
   TimeBodyList.merge (TimeBodyList.cons time body TimeBodyList.empty) evs

insertNormalize :: (NonNeg.C time, Ord body) =>
   time -> body -> TimeBodyList.T time body -> Bool
insertNormalize time body =
   isNormalized . TimeBodyList.insert time body . TimeBodyList.normalize

insertSplitAtTime :: (NonNeg.C time, Ord body) =>
   time -> body -> TimeBodyList.T time body -> Bool
insertSplitAtTime time body evs =
   TimeBodyList.insert
      (min time (TimeBodyList.duration evs)) body
      (TimeBodyList.normalize evs)
   ==
      let (prefix,suffix) = TimeMixedList.splitAtTime time evs
      in  TimeBodyList.normalize (TimeMixedList.appendBodyEnd prefix
             (MixedBodyList.consTime 0 (MixedBodyList.consBody body suffix)))

insertInfinite :: (NonNeg.C time, Ord body) =>
   time -> body -> NonEmptyList time body -> Bool
insertInfinite time body =
   checkInfinite . TimeBodyList.insert time body . makeInfiniteEventList



spanSatisfy :: (NonNeg.C time, Eq body) =>
   (body -> Bool) -> TimeBodyList.T time body -> Bool
spanSatisfy p =
   uncurry (&&) .
   mapPair
     (all p . TimeBodyList.getBodies,
      maybe True (not . p . snd . fst) . TimeBodyList.viewL) .
   TimeBodyList.span p

spanAppend :: (NonNeg.C time, Eq body) =>
   (body -> Bool) -> TimeBodyList.T time body -> Bool
spanAppend p xs =
   uncurry TimeBodyList.append (TimeBodyList.span p xs)  ==  xs

spanInfinite :: (NonNeg.C time, Ord body) =>
   (body -> Bool) -> NonEmptyList time body -> Bool
spanInfinite p =
   checkInfinite . uncurry TimeBodyList.append .
   TimeBodyList.span p . makeInfiniteEventList


coincidentFlatten :: (NonNeg.C time, Eq body) =>
   TimeBodyList.T time body -> Bool
coincidentFlatten xs =
   xs  ==  TimeBodyList.flatten (TimeBodyList.collectCoincident xs)

collectCoincidentGaps :: (NonNeg.C time, Eq body) =>
   TimeBodyList.T time body -> Bool
collectCoincidentGaps xs =
   let times = TimeBodyList.getTimes (TimeBodyList.collectCoincident xs)
   in  null times || all (0<) (tail times)

collectCoincidentNonEmpty :: (NonNeg.C time, Eq body) =>
   TimeBodyList.T time body -> Bool
collectCoincidentNonEmpty =
   all (not . null) . TimeBodyList.getBodies . TimeBodyList.collectCoincident

collectCoincidentInfinite :: (NonNeg.C time, Eq body) =>
   NonEmptyList time body -> Bool
collectCoincidentInfinite =
   checkInfinite .
   TimeBodyList.collectCoincident .
   makeUncollapsedInfiniteEventList


mapCoincidentMap :: (NonNeg.C time, Eq body1) =>
   (body0 -> body1) -> TimeBodyList.T time body0 -> Bool
mapCoincidentMap f xs =
   TimeBodyList.mapBody f xs  ==
   TimeBodyList.mapCoincident (map f) xs

mapCoincidentComposition :: (NonNeg.C time, Eq body2) =>
   ([body0] -> [body1]) -> ([body1] -> [body2]) -> TimeBodyList.T time body0 -> Bool
mapCoincidentComposition f g xs =
   TimeBodyList.mapCoincident (g . f) xs  ==
   (TimeBodyList.mapCoincident g . TimeBodyList.mapCoincident f) xs

mapCoincidentReverse :: (NonNeg.C time, Eq body) =>
   TimeBodyList.T time body -> Bool
mapCoincidentReverse xs =
   xs  ==  TimeBodyList.mapCoincident reverse (TimeBodyList.mapCoincident reverse xs)



mapBodyMAppend ::
   (Monad m, Eq body1, NonNeg.C time) =>
   (m (TimeBodyList.T time body1) -> TimeBodyList.T time body1) ->
   (body0 -> m body1) -> TimeBodyList.T time body0 -> TimeBodyList.T time body0 -> Bool
mapBodyMAppend run f xs ys =
   run (TimeBodyList.mapM return f (TimeBodyList.append xs ys))  ==
   run (liftM2 TimeBodyList.append (TimeBodyList.mapM return f xs) (TimeBodyList.mapM return f ys))

mapBodyMAppendRandom ::
   (Random body, NonNeg.C time, Eq body) =>
   Int -> TimeBodyList.T time (body,body) -> TimeBodyList.T time (body,body) -> Bool
mapBodyMAppendRandom seed =
   mapBodyMAppend
      (flip evalState (mkStdGen seed))
      (State . randomR)


mapBodyMInfinite ::
   (Random body, NonNeg.C time, Eq body) =>
   Int -> NonEmptyList time (body,body) -> Bool
mapBodyMInfinite seed =
   checkInfinite .
   flip evalState (mkStdGen seed) .
   TimeBodyList.mapM return (State . randomR) .
   makeInfiniteEventList


{-

mapM :: Monad m =>
   (time0 -> m time1) -> (body0 -> m body1) ->
   TimeBodyList.T time0 body0 -> m (TimeBodyList.T time1 body1)
mapM timeAction bodyAction =
   Uniform.mapM bodyAction timeAction

mapImmM :: Monad m =>
   (time0 -> m time1) -> (body0 -> m body1) ->
   Immediate time0 body0 -> m (Immediate time1 body1)
mapImmM timeAction bodyAction =
   Disp.mapM bodyAction timeAction


getBodies :: TimeBodyList.T time body -> [body]
getBodies = Uniform.getFirsts

getTimes :: TimeBodyList.T time body -> [time]
getTimes = Uniform.getSeconds


empty :: Immediate time body
empty = Disp.empty


cons :: time -> body -> TimeBodyList.T time body -> TimeBodyList.T time body
cons = Uniform.cons


snoc :: TimeBodyList.T time body -> body -> time -> TimeBodyList.T time body
snoc = Uniform.snoc


{-
propInsertPadded :: Event time body -> TimeBodyList.T time body -> Bool
propInsertPadded (Event time body) evs =
   EventList.insert time body (fst evs)  ==  fst (insert time body evs)
-}

appendSingle :: -- (Num time, Ord time, Ord body) =>
   body -> TimeBodyList.T time body -> EventList.T time body
appendSingle body xs =
   Disp.foldr EventList.consTime EventList.consBody EventList.empty $
   Uniform.snocFirst xs body

fromEventList :: time -> EventList.T time body -> TimeBodyList.T time body
fromEventList t =
   EventList.foldr consTime consBody (pause t)

toEventList :: TimeBodyList.T time body -> EventList.T time body
toEventList xs =
   zipWith EventList.Event (getTimes xs) (getBodies xs)

{- |

-}


discretize :: (RealFrac time, Integral i) =>
   TimeBodyList.T time body -> TimeBodyList.T i body
discretize es =
   evalState (Uniform.mapSecondM roundDiff es) 0

resample :: (RealFrac time, Integral i) =>
   time -> TimeBodyList.T time body -> TimeBodyList.T i body
resample rate es =
   discretize (mapTime (rate*) es)


toAbsoluteEventList :: (Num time) =>
   time -> TimeBodyList.T time body -> AbsoluteEventList.T time body
toAbsoluteEventList start xs =
   let ts = Uniform.getSeconds xs
       bs = Uniform.getFirsts  xs
       ats = List.scanl (+) start ts
   in  maybe
          (error "padded list always contains one time value")
          (\ ~(ats0,lt) -> (zip ats0 bs, lt))
          (viewR ats)
-}




type NonEmptyList time body = (time, body, TimeBodyList.T time body)

makeUncollapsedInfiniteEventList :: (NonNeg.C time) =>
   NonEmptyList time body -> TimeBodyList.T time body
makeUncollapsedInfiniteEventList =
   makeInfiniteEventList .
   (\(time,body,xs) -> (time+1,body,xs))

makeInfiniteEventList :: (NonNeg.C time) =>
   NonEmptyList time body -> TimeBodyList.T time body
makeInfiniteEventList =
   TimeBodyList.cycle . makeNonEmptyEventList

makeNonEmptyEventList :: (NonNeg.C time) =>
   NonEmptyList time body -> TimeBodyList.T time body
makeNonEmptyEventList (t, b, evs) =
   TimeBodyList.cons t b evs

{- |
Pick an arbitrary element from an infinite list
and check if it can be evaluated.
-}
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
   in  x == x



tests :: [(String, IO ())]
tests =
   ("viewTimeL consTime",
     test (viewLConsTime :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("viewBodyL consBody",
     test (viewLConsBody :: BodyBodyList.T TimeDiff Char -> Bool)) :

   ("viewLInfinite",
     test (viewLInfinite :: NonEmptyList TimeDiff Char -> Bool)) :
   ("consInfinite",
     test (consInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :
   ("consTimeBodyInfinite",
     test (consTimeBodyInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :
   ("snocInfinite",
     test (snocInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :
   ("consInfix",
     test (consInfix :: TimeDiff -> Char -> TimeDiff -> Char -> Bool)) :


   ("map body composition",
     test (mapBodyComposition Char.toUpper Char.toLower
               :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("map time composition",
     test ((\dt0 dt1 -> mapTimeComposition (dt0+) (dt1+))
               :: TimeDiff -> TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("map time body commutative",
     test ((\dt -> mapTimeBodyCommutative (dt+) Char.toUpper)
               :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :

   ("mapBodyInfinite",
     test (mapBodyInfinite Char.toUpper
               :: NonEmptyList TimeDiff Char -> Bool)) :
   ("mapTimeInfinite",
     test (\dt -> mapTimeInfinite (dt+)
               :: NonEmptyList TimeDiff Char -> Bool)) :

   ("mapNormalize",
     test (mapNormalize succ
               :: TimeBodyList.T TimeDiff Char -> Bool)) :

   ("append left identity",
     test (appendLeftIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("append right identity",
     test (appendRightIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("append associative",
     test (appendAssociative
              :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char ->
                 TimeBodyList.T TimeDiff Char -> Bool)) :

   ("appendCons",
     test (appendCons :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("mapBodyAppend",
     test (mapBodyAppend Char.toUpper
               :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("appendSplitAtTime",
     test (appendSplitAtTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("appendFirstInfinite",
     test (appendFirstInfinite :: NonEmptyList TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("appendSecondInfinite",
     test (appendSecondInfinite :: TimeBodyList.T TimeDiff Char -> NonEmptyList TimeDiff Char -> Bool)) :
   ("cycleInfinite",
     test (cycleInfinite :: NonEmptyList TimeDiff Char -> Bool)) :

   ("decreaseStart delay",
     test (decreaseStartDelay :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("decreaseStartInfinite",
     test (decreaseStartInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :

   ("delay additive",
     test (delayAdditive :: TimeDiff -> TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("delay append pause",
     test (delayAppendPause :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("delayInfinite",
     test (delayInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :

   ("splitAtTakeDropTime",
     test (splitAtTakeDropTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("takeTimeEndPause",
     test (takeTimeEndPause :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("takeTimeAppendFirst",
     test (takeTimeAppendFirst :: TimeDiff -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("takeTimeAppendSecond",
     test (takeTimeAppendSecond :: TimeDiff -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("takeTimeNormalize",
     test (takeTimeNormalize :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("dropTimeNormalize",
     test (dropTimeNormalize :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("takeTimeInfinite",
     test (takeTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :
   ("dropTimeInfinite",
     test (dropTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :

   ("duration pause",
     test (durationPause :: TimeDiff -> Bool)) :
   ("duration append",
     test (durationAppend :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("duration merge",
     test (durationMerge :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("durationTakeTime",
     test (durationTakeTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("durationDropTime",
     test (durationDropTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :

   ("filterSatisfy",
     test (\c -> filterSatisfy (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("filterProjection",
     test (\c -> filterProjection (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("filterCommutative",
     test (\c0 c1 -> filterCommutative (c0<) (c1>) :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("filterComposition",
     test (\c0 c1 -> filterComposition (c0<) (c1>) :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("filterNormalize",
     test (\c -> filterNormalize (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("filterAppend",
     test (\c -> filterAppend (c<) :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("filterDuration",
     test (\c -> filterDuration (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :
   ("filterPartition",
     test (\c -> filterPartition (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("filterInfinite",
     test (\c -> filterInfinite (c<) :: NonEmptyList TimeDiff Char -> Bool)) :
   ("catMaybesAppend",
     test (catMaybesAppend :: TimeBodyList.T TimeDiff (Maybe Char) -> TimeBodyList.T TimeDiff (Maybe Char) -> Bool)) :

   ("mergeNormalize",
     test (mergeNormalize :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("merge left identity",
     test (mergeLeftIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("merge right identity",
     test (mergeRightIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("merge commutative",
     test (mergeCommutative :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("merge associative",
     test (mergeAssociative :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("merge append",
     test (mergeAppend :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("mergeMap",
     test (mergeMap succ :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("mergeFilter",
     test (\c -> mergeFilter (c>)
             :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("mergePartition",
     test (\c -> mergePartition (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("mergeEitherMapMaybe",
     test (mergeEitherMapMaybe
         :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("mergeInfinite",
     test (mergeInfinite
         :: NonEmptyList TimeDiff Char -> NonEmptyList TimeDiff Char -> Bool)) :

   ("insert commutative",
     test (insertCommutative :: (TimeDiff, Char) -> (TimeDiff, Char) -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("insert merge",
     test (insertMerge :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("insertNormalize",
     test (insertNormalize :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("insertSplitAtTime",
     test (insertSplitAtTime :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :
   ("insertInfinite",
     test (insertInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :

   ("spanSatisfy",
     test (\c -> spanSatisfy (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("spanAppend",
     test (\c -> spanAppend (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("spanInfinite",
     test (\c -> spanInfinite (c<) :: NonEmptyList TimeDiff Char -> Bool)) :

   ("coincidentFlatten",
     test (coincidentFlatten :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("collectCoincidentGaps",
     test (collectCoincidentGaps :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("collectCoincidentNonEmpty",
     test (collectCoincidentNonEmpty :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("collectCoincidentInfinite",
     test (collectCoincidentInfinite :: NonEmptyList TimeDiff Char -> Bool)) :

   ("mapCoincidentMap",
     test (mapCoincidentMap Char.toUpper :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("mapCoincidentComposition",
     test (mapCoincidentComposition reverse reverse :: TimeBodyList.T TimeDiff Char -> Bool)) :
   ("mapCoincidentReverse",
     test (mapCoincidentReverse :: TimeBodyList.T TimeDiff Char -> Bool)) :

   ("mapBodyMAppendRandom",
     test (mapBodyMAppendRandom :: Int -> TimeBodyList.T TimeDiff (Char,Char) -> TimeBodyList.T TimeDiff (Char,Char) -> Bool)) :
   ("mapBodyMInfinite",
     test (mapBodyMInfinite :: Int -> NonEmptyList TimeDiff (Char,Char) -> Bool)) :

   []