module Data.EventList.Utility where

-- State monad could be avoided by mapAccumL
import Control.Monad.Trans.State (State, state, modify, gets, )
import qualified Data.List as List
import Data.Tuple.HT (mapPair, )

{- |
Given the time fraction that remains from the preceding event
and the current time difference,
evaluate an integer time difference and
the remaining fractional part.
If we would simply map Time to integer values
with respect to the sampling rate,
then rounding errors would accumulate.
-}

roundDiff' :: (RealFrac t, Integral i) => t -> t -> (i, t)
roundDiff' :: forall t i. (RealFrac t, Integral i) => t -> t -> (i, t)
roundDiff' t
time t
frac =
   let x :: t
x = t
timet -> t -> t
forall a. Num a => a -> a -> a
+t
frac
       n :: i
n = t -> i
forall b. Integral b => t -> b
forall a b. (RealFrac a, Integral b) => a -> b
round t
x
   in  (i
n, t
x t -> t -> t
forall a. Num a => a -> a -> a
- i -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n)

roundDiff :: (RealFrac t, Integral i) => t -> State t i
roundDiff :: forall t i. (RealFrac t, Integral i) => t -> State t i
roundDiff = (t -> (i, t)) -> StateT t Identity i
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((t -> (i, t)) -> StateT t Identity i)
-> (t -> t -> (i, t)) -> t -> StateT t Identity i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t -> (i, t)
forall t i. (RealFrac t, Integral i) => t -> t -> (i, t)
roundDiff'

{-
We could use 'properFraction' but this is inconsistent for negative values.
-}
floorDiff :: (RealFrac t, Integral i) => t -> State t i
floorDiff :: forall t i. (RealFrac t, Integral i) => t -> State t i
floorDiff t
t =
   do (t -> t) -> StateT t Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (t
tt -> t -> t
forall a. Num a => a -> a -> a
+)
      i
n <- (t -> i) -> State t i
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets t -> i
forall b. Integral b => t -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor
      (t -> t) -> StateT t Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (t -> t -> t
forall a. Num a => a -> a -> a
subtract (i -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n))
      i -> State t i
forall a. a -> StateT t Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return i
n


beforeBy :: (Ord time) =>
   (body -> body -> Bool) ->
   (time, body) -> (time, body) -> Bool
beforeBy :: forall time body.
Ord time =>
(body -> body -> Bool) -> (time, body) -> (time, body) -> Bool
beforeBy body -> body -> Bool
before (time
t0, body
me0) (time
t1, body
me1) =
   case time -> time -> Ordering
forall a. Ord a => a -> a -> Ordering
compare time
t0 time
t1 of
      Ordering
LT -> Bool
True
      Ordering
EQ -> body -> body -> Bool
before body
me0 body
me1
      Ordering
GT -> Bool
False


slice :: (Eq a) =>
   (eventlist -> Maybe body) ->
   ((body -> Bool) -> eventlist -> (eventlist, eventlist)) ->
   (body -> a) -> eventlist -> [(a, eventlist)]
slice :: forall a eventlist body.
Eq a =>
(eventlist -> Maybe body)
-> ((body -> Bool) -> eventlist -> (eventlist, eventlist))
-> (body -> a)
-> eventlist
-> [(a, eventlist)]
slice eventlist -> Maybe body
hd (body -> Bool) -> eventlist -> (eventlist, eventlist)
partition body -> a
f =
   (eventlist -> Maybe ((a, eventlist), eventlist))
-> eventlist -> [(a, eventlist)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr (\ eventlist
pf ->
      (body -> ((a, eventlist), eventlist))
-> Maybe body -> Maybe ((a, eventlist), eventlist)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
         ((\ a
i ->
            (eventlist -> (a, eventlist), eventlist -> eventlist)
-> (eventlist, eventlist) -> ((a, eventlist), eventlist)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair
               ((,) a
i, eventlist -> eventlist
forall a. a -> a
id)
               ((body -> Bool) -> eventlist -> (eventlist, eventlist)
partition ((a
ia -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) (a -> Bool) -> (body -> a) -> body -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. body -> a
f) eventlist
pf)) (a -> ((a, eventlist), eventlist))
-> (body -> a) -> body -> ((a, eventlist), eventlist)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. body -> a
f)
         (eventlist -> Maybe body
hd eventlist
pf))