{- |
Copyright   :  (c) Henning Thielemann 2007-2009

Maintainer  :  haskell@henning-thielemann.de
Stability   :  stable
Portability :  Haskell 98
-}
module Data.EventList.Absolute.TimeBodyPrivate where

import qualified Data.AlternatingList.List.Disparate as Disp
-- import qualified Data.AlternatingList.List.Uniform as Uniform
-- import qualified Data.AlternatingList.List.Mixed as Mixed

import qualified Control.Monad as Monad
import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav
import qualified Control.Applicative as App
import Control.Applicative (Applicative, )
import Data.Monoid (Monoid, mempty, mappend, mconcat, )
import Data.Semigroup (Semigroup, (<>), )

import Test.QuickCheck (Arbitrary(arbitrary, shrink))

import Prelude hiding (concat, cycle)


newtype T time body = Cons {forall time body. T time body -> T time body
decons :: Disp.T time body}
   deriving (T time body -> T time body -> Bool
(T time body -> T time body -> Bool)
-> (T time body -> T time body -> Bool) -> Eq (T time body)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall time body.
(Eq time, Eq body) =>
T time body -> T time body -> Bool
$c== :: forall time body.
(Eq time, Eq body) =>
T time body -> T time body -> Bool
== :: T time body -> T time body -> Bool
$c/= :: forall time body.
(Eq time, Eq body) =>
T time body -> T time body -> Bool
/= :: T time body -> T time body -> Bool
Eq, Eq (T time body)
Eq (T time body) =>
(T time body -> T time body -> Ordering)
-> (T time body -> T time body -> Bool)
-> (T time body -> T time body -> Bool)
-> (T time body -> T time body -> Bool)
-> (T time body -> T time body -> Bool)
-> (T time body -> T time body -> T time body)
-> (T time body -> T time body -> T time body)
-> Ord (T time body)
T time body -> T time body -> Bool
T time body -> T time body -> Ordering
T time body -> T time body -> T time body
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall time body. (Ord time, Ord body) => Eq (T time body)
forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> Bool
forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> Ordering
forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> T time body
$ccompare :: forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> Ordering
compare :: T time body -> T time body -> Ordering
$c< :: forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> Bool
< :: T time body -> T time body -> Bool
$c<= :: forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> Bool
<= :: T time body -> T time body -> Bool
$c> :: forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> Bool
> :: T time body -> T time body -> Bool
$c>= :: forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> Bool
>= :: T time body -> T time body -> Bool
$cmax :: forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> T time body
max :: T time body -> T time body -> T time body
$cmin :: forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> T time body
min :: T time body -> T time body -> T time body
Ord, Int -> T time body -> ShowS
[T time body] -> ShowS
T time body -> String
(Int -> T time body -> ShowS)
-> (T time body -> String)
-> ([T time body] -> ShowS)
-> Show (T time body)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall time body.
(Show time, Show body) =>
Int -> T time body -> ShowS
forall time body. (Show time, Show body) => [T time body] -> ShowS
forall time body. (Show time, Show body) => T time body -> String
$cshowsPrec :: forall time body.
(Show time, Show body) =>
Int -> T time body -> ShowS
showsPrec :: Int -> T time body -> ShowS
$cshow :: forall time body. (Show time, Show body) => T time body -> String
show :: T time body -> String
$cshowList :: forall time body. (Show time, Show body) => [T time body] -> ShowS
showList :: [T time body] -> ShowS
Show)


instance (Arbitrary time, Arbitrary body) =>
             Arbitrary (T time body) where
   arbitrary :: Gen (T time body)
arbitrary = (T time body -> T time body)
-> Gen (T time body) -> Gen (T time body)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Monad.liftM T time body -> T time body
forall time body. T time body -> T time body
Cons Gen (T time body)
forall a. Arbitrary a => Gen a
arbitrary
   shrink :: T time body -> [T time body]
shrink = (T time body -> [T time body]) -> T time body -> [T time body]
forall (m :: * -> *) time0 body0 time1 body1.
Monad m =>
(T time0 body0 -> m (T time1 body1))
-> T time0 body0 -> m (T time1 body1)
liftM T time body -> [T time body]
forall a. Arbitrary a => a -> [a]
shrink

instance (Num time, Ord time) => Semigroup (T time body) where
   <> :: T time body -> T time body -> T time body
(<>) = T time body -> T time body -> T time body
forall time body.
(Ord time, Num time) =>
T time body -> T time body -> T time body
append

instance (Num time, Ord time) => Monoid (T time body) where
   mempty :: T time body
mempty = T time body -> T time body
forall time body. T time body -> T time body
Cons T time body
forall a b. T a b
Disp.empty
   mappend :: T time body -> T time body -> T time body
mappend = T time body -> T time body -> T time body
forall a. Semigroup a => a -> a -> a
(<>)
   mconcat :: [T time body] -> T time body
mconcat = [T time body] -> T time body
forall time body.
(Ord time, Num time) =>
[T time body] -> T time body
concat

instance Functor (T time) where
   fmap :: forall a b. (a -> b) -> T time a -> T time b
fmap a -> b
f (Cons T time a
x) = T time b -> T time b
forall time body. T time body -> T time body
Cons ((a -> b) -> T time a -> T time b
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
Disp.mapSecond a -> b
f T time a
x)

instance Fold.Foldable (T time) where
   foldMap :: forall m a. Monoid m => (a -> m) -> T time a -> m
foldMap = (a -> m) -> T time a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Trav.foldMapDefault

instance Trav.Traversable (T time) where
   traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> T time a -> f (T time b)
traverse a -> f b
f =
      (T time b -> T time b) -> f (T time b) -> f (T time b)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA T time b -> T time b
forall time body. T time body -> T time body
Cons (f (T time b) -> f (T time b))
-> (T time a -> f (T time b)) -> T time a -> f (T time b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time -> f time) -> (a -> f b) -> T time a -> f (T time b)
forall (m :: * -> *) a0 a1 b0 b1.
Applicative m =>
(a0 -> m a1) -> (b0 -> m b1) -> T a0 b0 -> m (T a1 b1)
Disp.traverse time -> f time
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
App.pure a -> f b
f (T time a -> f (T time b))
-> (T time a -> T time a) -> T time a -> f (T time b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time a -> T time a
forall time body. T time body -> T time body
decons


infixl 5 $~

($~) :: (Disp.T time body -> a) -> (T time body -> a)
$~ :: forall time body a. (T time body -> a) -> T time body -> a
($~) T time body -> a
f = T time body -> a
f (T time body -> a)
-> (T time body -> T time body) -> T time body -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T time body
forall time body. T time body -> T time body
decons


lift ::
   (Disp.T time0 body0 -> Disp.T time1 body1) ->
   (T time0 body0 -> T time1 body1)
lift :: forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift T time0 body0 -> T time1 body1
f = T time1 body1 -> T time1 body1
forall time body. T time body -> T time body
Cons (T time1 body1 -> T time1 body1)
-> (T time0 body0 -> T time1 body1)
-> T time0 body0
-> T time1 body1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> T time1 body1
f (T time0 body0 -> T time1 body1)
-> (T time0 body0 -> T time0 body0)
-> T time0 body0
-> T time1 body1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> T time0 body0
forall time body. T time body -> T time body
decons

liftA :: Applicative m =>
   (Disp.T time0 body0 -> m (Disp.T time1 body1)) ->
   (T time0 body0 -> m (T time1 body1))
liftA :: forall (m :: * -> *) time0 body0 time1 body1.
Applicative m =>
(T time0 body0 -> m (T time1 body1))
-> T time0 body0 -> m (T time1 body1)
liftA T time0 body0 -> m (T time1 body1)
f = (T time1 body1 -> T time1 body1)
-> m (T time1 body1) -> m (T time1 body1)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA T time1 body1 -> T time1 body1
forall time body. T time body -> T time body
Cons (m (T time1 body1) -> m (T time1 body1))
-> (T time0 body0 -> m (T time1 body1))
-> T time0 body0
-> m (T time1 body1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> m (T time1 body1)
f (T time0 body0 -> m (T time1 body1))
-> (T time0 body0 -> T time0 body0)
-> T time0 body0
-> m (T time1 body1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> T time0 body0
forall time body. T time body -> T time body
decons

liftM :: Monad m =>
   (Disp.T time0 body0 -> m (Disp.T time1 body1)) ->
   (T time0 body0 -> m (T time1 body1))
liftM :: forall (m :: * -> *) time0 body0 time1 body1.
Monad m =>
(T time0 body0 -> m (T time1 body1))
-> T time0 body0 -> m (T time1 body1)
liftM T time0 body0 -> m (T time1 body1)
f = (T time1 body1 -> T time1 body1)
-> m (T time1 body1) -> m (T time1 body1)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Monad.liftM T time1 body1 -> T time1 body1
forall time body. T time body -> T time body
Cons (m (T time1 body1) -> m (T time1 body1))
-> (T time0 body0 -> m (T time1 body1))
-> T time0 body0
-> m (T time1 body1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> m (T time1 body1)
f (T time0 body0 -> m (T time1 body1))
-> (T time0 body0 -> T time0 body0)
-> T time0 body0
-> m (T time1 body1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> T time0 body0
forall time body. T time body -> T time body
decons


{-# INLINE switchL #-}
switchL :: c -> ((time, body) -> T time body -> c) -> T time body -> c
switchL :: forall c time body.
c -> ((time, body) -> T time body -> c) -> T time body -> c
switchL c
f (time, body) -> T time body -> c
g = c -> (time -> body -> T time body -> c) -> T time body -> c
forall c a b. c -> (a -> b -> T a b -> c) -> T a b -> c
Disp.switchL c
f (\ time
t body
b  -> (time, body) -> T time body -> c
g (time
t,body
b) (T time body -> c)
-> (T time body -> T time body) -> T time body -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T time body
forall time body. T time body -> T time body
Cons) (T time body -> c)
-> (T time body -> T time body) -> T time body -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T time body
forall time body. T time body -> T time body
decons

{-# INLINE switchR #-}
switchR :: c -> (T time body -> (time, body) -> c) -> T time body -> c
switchR :: forall c time body.
c -> (T time body -> (time, body) -> c) -> T time body -> c
switchR c
f T time body -> (time, body) -> c
g = c -> (T time body -> time -> body -> c) -> T time body -> c
forall c a b. c -> (T a b -> a -> b -> c) -> T a b -> c
Disp.switchR c
f (\T time body
xs time
t body
b -> T time body -> (time, body) -> c
g (T time body -> T time body
forall time body. T time body -> T time body
Cons T time body
xs) (time
t,body
b)) (T time body -> c)
-> (T time body -> T time body) -> T time body -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> T time body
forall time body. T time body -> T time body
decons


mapBody :: (body0 -> body1) -> T time body0 -> T time body1
mapBody :: forall body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
mapBody body0 -> body1
f = (T time body0 -> T time body1) -> T time body0 -> T time body1
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift ((body0 -> body1) -> T time body0 -> T time body1
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
Disp.mapSecond body0 -> body1
f)

mapTime :: (time0 -> time1) -> T time0 body -> T time1 body
mapTime :: forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime time0 -> time1
f = (T time0 body -> T time1 body) -> T time0 body -> T time1 body
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift ((time0 -> time1) -> T time0 body -> T time1 body
forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
Disp.mapFirst time0 -> time1
f)


{- |
Duration of an empty event list is considered zero.
However, I'm not sure if this is sound.
-}
duration :: Num time => T time body -> time
duration :: forall time body. Num time => T time body -> time
duration = time
-> (T time body -> (time, body) -> time) -> T time body -> time
forall c time body.
c -> (T time body -> (time, body) -> c) -> T time body -> c
switchR time
0 (((time, body) -> time) -> T time body -> (time, body) -> time
forall a b. a -> b -> a
const (time, body) -> time
forall a b. (a, b) -> a
fst)

{-
Is it necessary to exclude negative delays?
Even negative time stamps should not hurt absolutely timestamped lists.
-}
delay :: (Ord time, Num time) =>
   time -> T time body -> T time body
delay :: forall time body.
(Ord time, Num time) =>
time -> T time body -> T time body
delay time
dif =
   if time
diftime -> time -> Bool
forall a. Ord a => a -> a -> Bool
>=time
0
     then (time -> time) -> T time body -> T time body
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime (time
diftime -> time -> time
forall a. Num a => a -> a -> a
+)
     else String -> T time body -> T time body
forall a. HasCallStack => String -> a
error String
"delay: negative delay"


append :: (Ord time, Num time) =>
   T time body -> T time body -> T time body
append :: forall time body.
(Ord time, Num time) =>
T time body -> T time body -> T time body
append T time body
xs = (T time body -> T time body) -> T time body -> T time body
forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift (T time body -> T time body -> T time body
forall a b. T a b -> T a b -> T a b
Disp.append (T time body -> T time body -> T time body)
-> T time body -> T time body -> T time body
forall time body a. (T time body -> a) -> T time body -> a
$~ T time body
xs) (T time body -> T time body)
-> (T time body -> T time body) -> T time body -> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> T time body -> T time body
forall time body.
(Ord time, Num time) =>
time -> T time body -> T time body
delay (T time body -> time
forall time body. Num time => T time body -> time
duration T time body
xs)

concat :: (Ord time, Num time) =>
   [T time body] -> T time body
concat :: forall time body.
(Ord time, Num time) =>
[T time body] -> T time body
concat [T time body]
xs =
   let ts :: [time]
ts = (time -> time -> time) -> time -> [time] -> [time]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl time -> time -> time
forall a. Num a => a -> a -> a
(+) time
0 ((T time body -> time) -> [T time body] -> [time]
forall a b. (a -> b) -> [a] -> [b]
map T time body -> time
forall time body. Num time => T time body -> time
duration [T time body]
xs)
   in  T time body -> T time body
forall time body. T time body -> T time body
Cons (T time body -> T time body) -> T time body -> T time body
forall a b. (a -> b) -> a -> b
$ [T time body] -> T time body
forall a b. [T a b] -> T a b
Disp.concat ([T time body] -> T time body) -> [T time body] -> T time body
forall a b. (a -> b) -> a -> b
$ (T time body -> T time body) -> [T time body] -> [T time body]
forall a b. (a -> b) -> [a] -> [b]
map T time body -> T time body
forall time body. T time body -> T time body
decons ([T time body] -> [T time body]) -> [T time body] -> [T time body]
forall a b. (a -> b) -> a -> b
$ (time -> T time body -> T time body)
-> [time] -> [T time body] -> [T time body]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith time -> T time body -> T time body
forall time body.
(Ord time, Num time) =>
time -> T time body -> T time body
delay [time]
ts [T time body]
xs

{-
Unfortunately in absolute lists we cannot use sharing as in List.cycle
since the start times of the later lists are greater.
-}
cycle :: (Ord time, Num time) =>
   T time body -> T time body
cycle :: forall time body.
(Ord time, Num time) =>
T time body -> T time body
cycle = [T time body] -> T time body
forall time body.
(Ord time, Num time) =>
[T time body] -> T time body
concat ([T time body] -> T time body)
-> (T time body -> [T time body]) -> T time body -> T time body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time body -> [T time body]
forall a. a -> [a]
repeat