module Data.EventList.Absolute.TimeBodyPrivate where
import qualified Data.AlternatingList.List.Disparate as Disp
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall time body.
(Eq time, Eq body) =>
T time body -> T time body -> Bool
Eq, 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
min :: 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
max :: T time body -> T time body -> T time body
$cmax :: forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> T time body
>= :: 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
$c< :: forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> Bool
compare :: T time body -> T time body -> Ordering
$ccompare :: forall time body.
(Ord time, Ord body) =>
T time body -> T time body -> Ordering
Ord, Int -> T time body -> ShowS
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
showList :: [T time body] -> ShowS
$cshowList :: forall time body. (Show time, Show body) => [T time body] -> ShowS
show :: T time body -> String
$cshow :: forall time body. (Show time, Show body) => T time body -> String
showsPrec :: Int -> T time body -> ShowS
$cshowsPrec :: forall time body.
(Show time, Show body) =>
Int -> T time body -> ShowS
Show)
instance (Arbitrary time, Arbitrary body) =>
Arbitrary (T time body) where
arbitrary :: Gen (T time body)
arbitrary = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Monad.liftM forall time body. T time body -> T time body
Cons forall a. Arbitrary a => Gen a
arbitrary
shrink :: T time body -> [T time body]
shrink = forall (m :: * -> *) time0 body0 time1 body1.
Monad m =>
(T time0 body0 -> m (T time1 body1))
-> T time0 body0 -> m (T time1 body1)
liftM 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
(<>) = 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 = forall time body. T time body -> T time body
Cons forall a b. T a b
Disp.empty
mappend :: T time body -> T time body -> T time body
mappend = forall a. Semigroup a => a -> a -> a
(<>)
mconcat :: [T time body] -> T time body
mconcat = 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) = forall time body. T time body -> T time body
Cons (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 = 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 =
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA forall time body. T time body -> T time body
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a0 a1 b0 b1.
Applicative m =>
(a0 -> m a1) -> (b0 -> m b1) -> T a0 b0 -> m (T a1 b1)
Disp.traverse forall (f :: * -> *) a. Applicative f => a -> f a
App.pure a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall time body. T time body -> T time body
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> T time1 body1
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA forall time body. T time body -> T time body
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> m (T time1 body1)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Monad.liftM forall time body. T time body -> T time body
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. T time0 body0 -> m (T time1 body1)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body. T time body -> T time body
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 (forall time body. T time body -> T time body
Cons T time body
xs) (time
t,body
b)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift (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 = forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift (forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
Disp.mapFirst time0 -> time1
f)
duration :: Num time => T time body -> time
duration :: forall time body. Num time => T time body -> time
duration = forall c time body.
c -> (T time body -> (time, body) -> c) -> T time body -> c
switchR time
0 (forall a b. a -> b -> a
const forall a b. (a, b) -> a
fst)
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
difforall a. Ord a => a -> a -> Bool
>=time
0
then forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
mapTime (time
difforall a. Num a => a -> a -> a
+)
else 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 = forall time0 body0 time1 body1.
(T time0 body0 -> T time1 body1) -> T time0 body0 -> T time1 body1
lift (forall a b. T a b -> T a b -> T a b
Disp.append forall time body a. (T time body -> a) -> T time body -> a
$~ T time body
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall time body.
(Ord time, Num time) =>
time -> T time body -> T time body
delay (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 = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) time
0 (forall a b. (a -> b) -> [a] -> [b]
map forall time body. Num time => T time body -> time
duration [T time body]
xs)
in forall time body. T time body -> T time body
Cons forall a b. (a -> b) -> a -> b
$ forall a b. [T a b] -> T a b
Disp.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall time body. T time body -> T time body
decons forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall time body.
(Ord time, Num time) =>
time -> T time body -> T time body
delay [time]
ts [T time body]
xs
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 = forall time body.
(Ord time, Num time) =>
[T time body] -> T time body
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a]
repeat