{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE RecordWildCards #-}

module Epidemic.Types.Time
  ( AbsoluteTime(..)
  , TimeDelta(..)
  , TimeInterval(..)
  , Timed(..)
  , TimeStamp(..)
  , allTimes
  , allValues
  , asConsecutiveIntervals1
  , asTimed
  , cadlagValue
  , diracDeltaValue
  , hasTime
  , inInterval
  , isAscending
  , maybeNextTimed
  , nextTime
  , timeAfterDelta
  , timeDelta
  , timeInterval1
  , timeInterval2
  ) where

import qualified Data.Aeson   as Json
import qualified Data.List    as List
import qualified Data.Maybe   as Maybe
import           GHC.Generics

-- | Absolute time.
newtype AbsoluteTime =
  AbsoluteTime Double
  deriving ((forall x. AbsoluteTime -> Rep AbsoluteTime x)
-> (forall x. Rep AbsoluteTime x -> AbsoluteTime)
-> Generic AbsoluteTime
forall x. Rep AbsoluteTime x -> AbsoluteTime
forall x. AbsoluteTime -> Rep AbsoluteTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbsoluteTime x -> AbsoluteTime
$cfrom :: forall x. AbsoluteTime -> Rep AbsoluteTime x
Generic, AbsoluteTime -> AbsoluteTime -> Bool
(AbsoluteTime -> AbsoluteTime -> Bool)
-> (AbsoluteTime -> AbsoluteTime -> Bool) -> Eq AbsoluteTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsoluteTime -> AbsoluteTime -> Bool
$c/= :: AbsoluteTime -> AbsoluteTime -> Bool
== :: AbsoluteTime -> AbsoluteTime -> Bool
$c== :: AbsoluteTime -> AbsoluteTime -> Bool
Eq, Int -> AbsoluteTime -> ShowS
[AbsoluteTime] -> ShowS
AbsoluteTime -> String
(Int -> AbsoluteTime -> ShowS)
-> (AbsoluteTime -> String)
-> ([AbsoluteTime] -> ShowS)
-> Show AbsoluteTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsoluteTime] -> ShowS
$cshowList :: [AbsoluteTime] -> ShowS
show :: AbsoluteTime -> String
$cshow :: AbsoluteTime -> String
showsPrec :: Int -> AbsoluteTime -> ShowS
$cshowsPrec :: Int -> AbsoluteTime -> ShowS
Show, Eq AbsoluteTime
Eq AbsoluteTime
-> (AbsoluteTime -> AbsoluteTime -> Ordering)
-> (AbsoluteTime -> AbsoluteTime -> Bool)
-> (AbsoluteTime -> AbsoluteTime -> Bool)
-> (AbsoluteTime -> AbsoluteTime -> Bool)
-> (AbsoluteTime -> AbsoluteTime -> Bool)
-> (AbsoluteTime -> AbsoluteTime -> AbsoluteTime)
-> (AbsoluteTime -> AbsoluteTime -> AbsoluteTime)
-> Ord AbsoluteTime
AbsoluteTime -> AbsoluteTime -> Bool
AbsoluteTime -> AbsoluteTime -> Ordering
AbsoluteTime -> AbsoluteTime -> AbsoluteTime
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
min :: AbsoluteTime -> AbsoluteTime -> AbsoluteTime
$cmin :: AbsoluteTime -> AbsoluteTime -> AbsoluteTime
max :: AbsoluteTime -> AbsoluteTime -> AbsoluteTime
$cmax :: AbsoluteTime -> AbsoluteTime -> AbsoluteTime
>= :: AbsoluteTime -> AbsoluteTime -> Bool
$c>= :: AbsoluteTime -> AbsoluteTime -> Bool
> :: AbsoluteTime -> AbsoluteTime -> Bool
$c> :: AbsoluteTime -> AbsoluteTime -> Bool
<= :: AbsoluteTime -> AbsoluteTime -> Bool
$c<= :: AbsoluteTime -> AbsoluteTime -> Bool
< :: AbsoluteTime -> AbsoluteTime -> Bool
$c< :: AbsoluteTime -> AbsoluteTime -> Bool
compare :: AbsoluteTime -> AbsoluteTime -> Ordering
$ccompare :: AbsoluteTime -> AbsoluteTime -> Ordering
$cp1Ord :: Eq AbsoluteTime
Ord)

instance Json.FromJSON AbsoluteTime

instance Json.ToJSON AbsoluteTime

-- | A type that has an absolute time associated with it and can be treated as
-- having a temporal ordering.
--
-- > a = AbsoluteTime 1
-- > b = AbsoluteTime 2
-- > a `isBefore` b
--
class TimeStamp a where
  absTime :: a -> AbsoluteTime

  isAfter :: a -> a -> Bool
  isAfter a
x a
y = a -> AbsoluteTime
forall a. TimeStamp a => a -> AbsoluteTime
absTime a
x AbsoluteTime -> AbsoluteTime -> Bool
forall a. Ord a => a -> a -> Bool
> a -> AbsoluteTime
forall a. TimeStamp a => a -> AbsoluteTime
absTime a
y

  isBefore :: a -> a -> Bool
  isBefore a
x a
y = a -> AbsoluteTime
forall a. TimeStamp a => a -> AbsoluteTime
absTime a
x AbsoluteTime -> AbsoluteTime -> Bool
forall a. Ord a => a -> a -> Bool
< a -> AbsoluteTime
forall a. TimeStamp a => a -> AbsoluteTime
absTime a
y

instance TimeStamp AbsoluteTime where
  absTime :: AbsoluteTime -> AbsoluteTime
absTime = AbsoluteTime -> AbsoluteTime
forall a. a -> a
id

-- | Duration of time between two absolute times.
newtype TimeDelta =
  TimeDelta Double
  deriving ((forall x. TimeDelta -> Rep TimeDelta x)
-> (forall x. Rep TimeDelta x -> TimeDelta) -> Generic TimeDelta
forall x. Rep TimeDelta x -> TimeDelta
forall x. TimeDelta -> Rep TimeDelta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeDelta x -> TimeDelta
$cfrom :: forall x. TimeDelta -> Rep TimeDelta x
Generic, TimeDelta -> TimeDelta -> Bool
(TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool) -> Eq TimeDelta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeDelta -> TimeDelta -> Bool
$c/= :: TimeDelta -> TimeDelta -> Bool
== :: TimeDelta -> TimeDelta -> Bool
$c== :: TimeDelta -> TimeDelta -> Bool
Eq, Int -> TimeDelta -> ShowS
[TimeDelta] -> ShowS
TimeDelta -> String
(Int -> TimeDelta -> ShowS)
-> (TimeDelta -> String)
-> ([TimeDelta] -> ShowS)
-> Show TimeDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeDelta] -> ShowS
$cshowList :: [TimeDelta] -> ShowS
show :: TimeDelta -> String
$cshow :: TimeDelta -> String
showsPrec :: Int -> TimeDelta -> ShowS
$cshowsPrec :: Int -> TimeDelta -> ShowS
Show, Eq TimeDelta
Eq TimeDelta
-> (TimeDelta -> TimeDelta -> Ordering)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> TimeDelta)
-> (TimeDelta -> TimeDelta -> TimeDelta)
-> Ord TimeDelta
TimeDelta -> TimeDelta -> Bool
TimeDelta -> TimeDelta -> Ordering
TimeDelta -> TimeDelta -> TimeDelta
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
min :: TimeDelta -> TimeDelta -> TimeDelta
$cmin :: TimeDelta -> TimeDelta -> TimeDelta
max :: TimeDelta -> TimeDelta -> TimeDelta
$cmax :: TimeDelta -> TimeDelta -> TimeDelta
>= :: TimeDelta -> TimeDelta -> Bool
$c>= :: TimeDelta -> TimeDelta -> Bool
> :: TimeDelta -> TimeDelta -> Bool
$c> :: TimeDelta -> TimeDelta -> Bool
<= :: TimeDelta -> TimeDelta -> Bool
$c<= :: TimeDelta -> TimeDelta -> Bool
< :: TimeDelta -> TimeDelta -> Bool
$c< :: TimeDelta -> TimeDelta -> Bool
compare :: TimeDelta -> TimeDelta -> Ordering
$ccompare :: TimeDelta -> TimeDelta -> Ordering
$cp1Ord :: Eq TimeDelta
Ord)

instance Json.FromJSON TimeDelta

instance Json.ToJSON TimeDelta

-- | An interval of time
data TimeInterval =
  TimeInterval
    { TimeInterval -> (AbsoluteTime, AbsoluteTime)
timeIntEndPoints :: (AbsoluteTime, AbsoluteTime)
    , TimeInterval -> TimeDelta
timeIntDuration  :: TimeDelta
    }
  deriving ((forall x. TimeInterval -> Rep TimeInterval x)
-> (forall x. Rep TimeInterval x -> TimeInterval)
-> Generic TimeInterval
forall x. Rep TimeInterval x -> TimeInterval
forall x. TimeInterval -> Rep TimeInterval x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeInterval x -> TimeInterval
$cfrom :: forall x. TimeInterval -> Rep TimeInterval x
Generic, TimeInterval -> TimeInterval -> Bool
(TimeInterval -> TimeInterval -> Bool)
-> (TimeInterval -> TimeInterval -> Bool) -> Eq TimeInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeInterval -> TimeInterval -> Bool
$c/= :: TimeInterval -> TimeInterval -> Bool
== :: TimeInterval -> TimeInterval -> Bool
$c== :: TimeInterval -> TimeInterval -> Bool
Eq, Int -> TimeInterval -> ShowS
[TimeInterval] -> ShowS
TimeInterval -> String
(Int -> TimeInterval -> ShowS)
-> (TimeInterval -> String)
-> ([TimeInterval] -> ShowS)
-> Show TimeInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeInterval] -> ShowS
$cshowList :: [TimeInterval] -> ShowS
show :: TimeInterval -> String
$cshow :: TimeInterval -> String
showsPrec :: Int -> TimeInterval -> ShowS
$cshowsPrec :: Int -> TimeInterval -> ShowS
Show)

instance Json.FromJSON TimeInterval

instance Json.ToJSON TimeInterval

-- | The duration of time between two absolute times
--
-- >>> timeDelta (AbsoluteTime 1) (AbsoluteTime 2.5)
-- TimeDelta 1.5
--
timeDelta ::
     AbsoluteTime -- ^ start
  -> AbsoluteTime -- ^ finish
  -> TimeDelta
timeDelta :: AbsoluteTime -> AbsoluteTime -> TimeDelta
timeDelta (AbsoluteTime Double
t0) (AbsoluteTime Double
t1) = Double -> TimeDelta
TimeDelta (Double
t1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0)

-- | The time after a given delay
--
-- >>> timeAfterDelta (AbsoluteTime 1) (TimeDelta 2.5)
-- AbsoluteTime 3.5
--
timeAfterDelta :: AbsoluteTime -> TimeDelta -> AbsoluteTime
timeAfterDelta :: AbsoluteTime -> TimeDelta -> AbsoluteTime
timeAfterDelta (AbsoluteTime Double
t0) (TimeDelta Double
d) = Double -> AbsoluteTime
AbsoluteTime (Double
t0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
d)

-- | Construct a 'TimeInterval' from the end points.
timeInterval1 :: AbsoluteTime -> AbsoluteTime -> TimeInterval
timeInterval1 :: AbsoluteTime -> AbsoluteTime -> TimeInterval
timeInterval1 AbsoluteTime
start AbsoluteTime
end = (AbsoluteTime, AbsoluteTime) -> TimeDelta -> TimeInterval
TimeInterval (AbsoluteTime
start, AbsoluteTime
end) (AbsoluteTime -> AbsoluteTime -> TimeDelta
timeDelta AbsoluteTime
start AbsoluteTime
end)

-- | Construct a 'TimeInterval' from the start time and the duration.
timeInterval2 :: AbsoluteTime -> TimeDelta -> TimeInterval
timeInterval2 :: AbsoluteTime -> TimeDelta -> TimeInterval
timeInterval2 AbsoluteTime
start TimeDelta
duration =
  (AbsoluteTime, AbsoluteTime) -> TimeDelta -> TimeInterval
TimeInterval (AbsoluteTime
start, AbsoluteTime -> TimeDelta -> AbsoluteTime
timeAfterDelta AbsoluteTime
start TimeDelta
duration) TimeDelta
duration

-- | Check if an 'AbsoluteTime' sits within a 'TimeInterval'.
inInterval :: TimeStamp a => TimeInterval -> a -> Bool
inInterval :: TimeInterval -> a -> Bool
inInterval TimeInterval {(AbsoluteTime, AbsoluteTime)
TimeDelta
timeIntDuration :: TimeDelta
timeIntEndPoints :: (AbsoluteTime, AbsoluteTime)
timeIntDuration :: TimeInterval -> TimeDelta
timeIntEndPoints :: TimeInterval -> (AbsoluteTime, AbsoluteTime)
..} a
x =
  let (AbsoluteTime
start, AbsoluteTime
end) = (AbsoluteTime, AbsoluteTime)
timeIntEndPoints
      absT :: AbsoluteTime
absT = a -> AbsoluteTime
forall a. TimeStamp a => a -> AbsoluteTime
absTime a
x
   in AbsoluteTime
start AbsoluteTime -> AbsoluteTime -> Bool
forall a. Ord a => a -> a -> Bool
<= AbsoluteTime
absT Bool -> Bool -> Bool
&& AbsoluteTime
absT AbsoluteTime -> AbsoluteTime -> Bool
forall a. Ord a => a -> a -> Bool
<= AbsoluteTime
end

-- | Construct a list of consecutive intervals divided by the given absolute
-- times.
asConsecutiveIntervals1 :: [AbsoluteTime] -> [TimeInterval]
asConsecutiveIntervals1 :: [AbsoluteTime] -> [TimeInterval]
asConsecutiveIntervals1 [AbsoluteTime]
absTimes =
  (AbsoluteTime -> AbsoluteTime -> TimeInterval)
-> [AbsoluteTime] -> [AbsoluteTime] -> [TimeInterval]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith AbsoluteTime -> AbsoluteTime -> TimeInterval
timeInterval1 ([AbsoluteTime] -> [AbsoluteTime]
forall a. [a] -> [a]
init [AbsoluteTime]
absTimes) ([AbsoluteTime] -> [AbsoluteTime]
forall a. [a] -> [a]
tail [AbsoluteTime]
absTimes)

-- | Type containing values at times. The times are increasing as required by
-- @asTimed@.
newtype Timed a =
  Timed [(AbsoluteTime, a)]
  deriving ((forall x. Timed a -> Rep (Timed a) x)
-> (forall x. Rep (Timed a) x -> Timed a) -> Generic (Timed a)
forall x. Rep (Timed a) x -> Timed a
forall x. Timed a -> Rep (Timed a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Timed a) x -> Timed a
forall a x. Timed a -> Rep (Timed a) x
$cto :: forall a x. Rep (Timed a) x -> Timed a
$cfrom :: forall a x. Timed a -> Rep (Timed a) x
Generic, Timed a -> Timed a -> Bool
(Timed a -> Timed a -> Bool)
-> (Timed a -> Timed a -> Bool) -> Eq (Timed a)
forall a. Eq a => Timed a -> Timed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timed a -> Timed a -> Bool
$c/= :: forall a. Eq a => Timed a -> Timed a -> Bool
== :: Timed a -> Timed a -> Bool
$c== :: forall a. Eq a => Timed a -> Timed a -> Bool
Eq, Int -> Timed a -> ShowS
[Timed a] -> ShowS
Timed a -> String
(Int -> Timed a -> ShowS)
-> (Timed a -> String) -> ([Timed a] -> ShowS) -> Show (Timed a)
forall a. Show a => Int -> Timed a -> ShowS
forall a. Show a => [Timed a] -> ShowS
forall a. Show a => Timed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timed a] -> ShowS
$cshowList :: forall a. Show a => [Timed a] -> ShowS
show :: Timed a -> String
$cshow :: forall a. Show a => Timed a -> String
showsPrec :: Int -> Timed a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Timed a -> ShowS
Show)

instance Json.FromJSON a => Json.FromJSON (Timed a)

instance Json.ToJSON a => Json.ToJSON (Timed a)

instance Semigroup (Timed a) where
  (Timed [(AbsoluteTime, a)]
x) <> :: Timed a -> Timed a -> Timed a
<> (Timed [(AbsoluteTime, a)]
y) = [(AbsoluteTime, a)] -> Timed a
forall a. [(AbsoluteTime, a)] -> Timed a
Timed ([(AbsoluteTime, a)] -> Timed a) -> [(AbsoluteTime, a)] -> Timed a
forall a b. (a -> b) -> a -> b
$ ((AbsoluteTime, a) -> AbsoluteTime)
-> [(AbsoluteTime, a)] -> [(AbsoluteTime, a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (AbsoluteTime, a) -> AbsoluteTime
forall a b. (a, b) -> a
fst ([(AbsoluteTime, a)]
x [(AbsoluteTime, a)] -> [(AbsoluteTime, a)] -> [(AbsoluteTime, a)]
forall a. [a] -> [a] -> [a]
++ [(AbsoluteTime, a)]
y)

-- | Construct a timed list if possible.
asTimed ::
     Num a
  => [(AbsoluteTime, a)] -- ^ list of ascending times and values
  -> Maybe (Timed a)
asTimed :: [(AbsoluteTime, a)] -> Maybe (Timed a)
asTimed [(AbsoluteTime, a)]
tas =
  if [AbsoluteTime] -> Bool
forall a. Ord a => [a] -> Bool
isAscending ([AbsoluteTime] -> Bool) -> [AbsoluteTime] -> Bool
forall a b. (a -> b) -> a -> b
$ ((AbsoluteTime, a) -> AbsoluteTime)
-> [(AbsoluteTime, a)] -> [AbsoluteTime]
forall a b. (a -> b) -> [a] -> [b]
map (AbsoluteTime, a) -> AbsoluteTime
forall a b. (a, b) -> a
fst [(AbsoluteTime, a)]
tas
    then Timed a -> Maybe (Timed a)
forall a. a -> Maybe a
Just ([(AbsoluteTime, a)] -> Timed a
forall a. [(AbsoluteTime, a)] -> Timed a
Timed ([(AbsoluteTime, a)] -> Timed a) -> [(AbsoluteTime, a)] -> Timed a
forall a b. (a -> b) -> a -> b
$ [(AbsoluteTime, a)]
tas [(AbsoluteTime, a)] -> [(AbsoluteTime, a)] -> [(AbsoluteTime, a)]
forall a. [a] -> [a] -> [a]
++ [(Double -> AbsoluteTime
AbsoluteTime (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0), -a
1)])
    else Maybe (Timed a)
forall a. Maybe a
Nothing

-- | Predicate to check if a list of orderable objects is in ascending order.
isAscending :: Ord a => [a] -> Bool
isAscending :: [a] -> Bool
isAscending [a]
xs =
  case [a]
xs of
    []        -> Bool
True
    [a
_]       -> Bool
True
    (a
x:a
y:[a]
xs') -> a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&& [a] -> Bool
forall a. Ord a => [a] -> Bool
isAscending (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs')

-- | Evaluate the timed object treating it as a cadlag function
cadlagValue :: Timed a -> AbsoluteTime -> Maybe a
cadlagValue :: Timed a -> AbsoluteTime -> Maybe a
cadlagValue (Timed [(AbsoluteTime, a)]
txs) = [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
cadlagValue' [(AbsoluteTime, a)]
txs

cadlagValue' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
cadlagValue' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
cadlagValue' [] AbsoluteTime
_ = Maybe a
forall a. Maybe a
Nothing
cadlagValue' ((AbsoluteTime
t, a
x):[(AbsoluteTime, a)]
txs) AbsoluteTime
q =
  if AbsoluteTime
q AbsoluteTime -> AbsoluteTime -> Bool
forall a. Ord a => a -> a -> Bool
< AbsoluteTime
t
    then Maybe a
forall a. Maybe a
Nothing
    else let nextCLV :: Maybe a
nextCLV = [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
cadlagValue' [(AbsoluteTime, a)]
txs AbsoluteTime
q
          in if Maybe a -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe a
nextCLV
               then a -> Maybe a
forall a. a -> Maybe a
Just a
x
               else Maybe a
nextCLV

-- | Evaluate the timed object treating it as a direct delta function
diracDeltaValue :: Timed a -> AbsoluteTime -> Maybe a
diracDeltaValue :: Timed a -> AbsoluteTime -> Maybe a
diracDeltaValue (Timed [(AbsoluteTime, a)]
txs) = [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
diracDeltaValue' [(AbsoluteTime, a)]
txs

diracDeltaValue' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
diracDeltaValue' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
diracDeltaValue' [(AbsoluteTime, a)]
txs AbsoluteTime
q =
  case [(AbsoluteTime, a)]
txs of
    ((AbsoluteTime
t, a
x):[(AbsoluteTime, a)]
txs') ->
      if AbsoluteTime
t AbsoluteTime -> AbsoluteTime -> Bool
forall a. Eq a => a -> a -> Bool
== AbsoluteTime
q
        then a -> Maybe a
forall a. a -> Maybe a
Just a
x
        else [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
diracDeltaValue' [(AbsoluteTime, a)]
txs' AbsoluteTime
q
    [] -> Maybe a
forall a. Maybe a
Nothing

-- | Check if there exists a pair with a particular time index.
hasTime :: Timed a -> AbsoluteTime -> Bool
hasTime :: Timed a -> AbsoluteTime -> Bool
hasTime Timed a
tx AbsoluteTime
absT = AbsoluteTime -> [AbsoluteTime] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem AbsoluteTime
absT ([AbsoluteTime] -> Bool) -> [AbsoluteTime] -> Bool
forall a b. (a -> b) -> a -> b
$ Timed a -> [AbsoluteTime]
forall a. Timed a -> [AbsoluteTime]
allTimes Timed a
tx

-- | Return the value of the next time if possible or an exact match if it
-- exists.
nextTime :: Timed a -> AbsoluteTime -> Maybe AbsoluteTime
nextTime :: Timed a -> AbsoluteTime -> Maybe AbsoluteTime
nextTime (Timed [(AbsoluteTime, a)]
txs) = [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
nextTime' [(AbsoluteTime, a)]
txs

nextTime' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
nextTime' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
nextTime' [(AbsoluteTime, a)]
txs AbsoluteTime
q =
  case [(AbsoluteTime, a)]
txs of
    ((AbsoluteTime
t, a
_):[(AbsoluteTime, a)]
txs') ->
      if AbsoluteTime
q AbsoluteTime -> AbsoluteTime -> Bool
forall a. Ord a => a -> a -> Bool
< AbsoluteTime
t
        then AbsoluteTime -> Maybe AbsoluteTime
forall a. a -> Maybe a
Just AbsoluteTime
t
        else [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
nextTime' [(AbsoluteTime, a)]
txs' AbsoluteTime
q
    [] -> Maybe AbsoluteTime
forall a. Maybe a
Nothing

-- | Return a list of the (finite) absolute times that the step function changes
-- value.
--
-- >>> let demoMaybeTimed = asTimed [(AbsoluteTime 1,2),(AbsoluteTime 1.5,1)]
-- >>> liftM allTimes demoMaybeTimed
-- Just [AbsoluteTime 1.0,AbsoluteTime 1.5]
--
allTimes :: Timed a -> [AbsoluteTime]
allTimes :: Timed a -> [AbsoluteTime]
allTimes (Timed [(AbsoluteTime, a)]
txs) = [AbsoluteTime
t | (AbsoluteTime
t, a
_) <- [(AbsoluteTime, a)]
txs, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AbsoluteTime -> Bool
isInfiniteAbsoluteTime AbsoluteTime
t]

-- | The values that the timed variable takes. NOTE that it is safe to use
-- 'fromJust' here because 'allTimes' only returns times for which there is a
-- cadlag value anyway.
--
-- >>> (Just tx) = asTimed [(AbsoluteTime 1,2),(AbsoluteTime 1.5,1)]
-- >>> allValues tx
-- [2,1]
--
allValues :: Timed a -> [a]
allValues :: Timed a -> [a]
allValues Timed a
timed = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust (Maybe a -> a) -> (AbsoluteTime -> Maybe a) -> AbsoluteTime -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed a -> AbsoluteTime -> Maybe a
forall a. Timed a -> AbsoluteTime -> Maybe a
cadlagValue Timed a
timed (AbsoluteTime -> a) -> [AbsoluteTime] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Timed a -> [AbsoluteTime]
forall a. Timed a -> [AbsoluteTime]
allTimes Timed a
timed

-- | Predicate for an infinite absolute time
isInfiniteAbsoluteTime :: AbsoluteTime -> Bool
isInfiniteAbsoluteTime :: AbsoluteTime -> Bool
isInfiniteAbsoluteTime (AbsoluteTime Double
t) = Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
t

-- | Look at both of the timed objects and, if possible, return the time that
-- the first one changes along with the value it changes to.
--
-- >>> (Just tA) = asTimed [(AbsoluteTime 1, (1.1 :: Double)), (AbsoluteTime 3, 2.3)]
-- >>> (Just tB) = asTimed [(AbsoluteTime 2, (1 :: Int))]
-- >>> maybeNextTimed tA tB (AbsoluteTime 0.5)
-- Just (AbsoluteTime 1.0,Left 1.1)
-- >>> maybeNextTimed tA tB (AbsoluteTime 1.5)
-- Just (AbsoluteTime 2.0,Right 1)
-- >>> maybeNextTimed tA tB (AbsoluteTime 3.5)
-- Nothing
--
maybeNextTimed :: Timed a
               -> Timed b
               -> AbsoluteTime
               -> Maybe (AbsoluteTime, Either a b)
maybeNextTimed :: Timed a
-> Timed b -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
maybeNextTimed Timed a
timedA Timed b
timedB AbsoluteTime
absT =
  let f :: Timed a -> Maybe AbsoluteTime
f = (Timed a -> AbsoluteTime -> Maybe AbsoluteTime)
-> AbsoluteTime -> Timed a -> Maybe AbsoluteTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip Timed a -> AbsoluteTime -> Maybe AbsoluteTime
forall a. Timed a -> AbsoluteTime -> Maybe AbsoluteTime
nextTime AbsoluteTime
absT
      g1 :: Timed a -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
g1 Timed a
timed AbsoluteTime
at = do -- two functions are needed for the different types.
        a
v <- Timed a -> AbsoluteTime -> Maybe a
forall a. Timed a -> AbsoluteTime -> Maybe a
diracDeltaValue Timed a
timed AbsoluteTime
at
        if AbsoluteTime -> Bool
isInfiniteAbsoluteTime AbsoluteTime
at
          then Maybe (AbsoluteTime, Either a b)
forall a. Maybe a
Nothing
          else (AbsoluteTime, Either a b) -> Maybe (AbsoluteTime, Either a b)
forall a. a -> Maybe a
Just (AbsoluteTime
at, a -> Either a b
forall a b. a -> Either a b
Left a
v)
      g2 :: Timed b -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
g2 Timed b
timed AbsoluteTime
at = do
        b
v <- Timed b -> AbsoluteTime -> Maybe b
forall a. Timed a -> AbsoluteTime -> Maybe a
diracDeltaValue Timed b
timed AbsoluteTime
at
        if AbsoluteTime -> Bool
isInfiniteAbsoluteTime AbsoluteTime
at
          then Maybe (AbsoluteTime, Either a b)
forall a. Maybe a
Nothing
          else (AbsoluteTime, Either a b) -> Maybe (AbsoluteTime, Either a b)
forall a. a -> Maybe a
Just (AbsoluteTime
at, b -> Either a b
forall a b. b -> Either a b
Right b
v)
   in case (Timed a -> Maybe AbsoluteTime
forall a. Timed a -> Maybe AbsoluteTime
f Timed a
timedA, Timed b -> Maybe AbsoluteTime
forall a. Timed a -> Maybe AbsoluteTime
f Timed b
timedB) of
        (Just AbsoluteTime
tA, Just AbsoluteTime
tB) ->
          if AbsoluteTime
tA AbsoluteTime -> AbsoluteTime -> Bool
forall a. Ord a => a -> a -> Bool
< AbsoluteTime
tB
            then Timed a -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
forall a b.
Timed a -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
g1 Timed a
timedA AbsoluteTime
tA
            else Timed b -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
forall b a.
Timed b -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
g2 Timed b
timedB AbsoluteTime
tB
        (Just AbsoluteTime
tA, Maybe AbsoluteTime
Nothing) -> Timed a -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
forall a b.
Timed a -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
g1 Timed a
timedA AbsoluteTime
tA
        (Maybe AbsoluteTime
Nothing, Just AbsoluteTime
tB) -> Timed b -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
forall b a.
Timed b -> AbsoluteTime -> Maybe (AbsoluteTime, Either a b)
g2 Timed b
timedB AbsoluteTime
tB
        (Maybe AbsoluteTime
Nothing, Maybe AbsoluteTime
Nothing) -> Maybe (AbsoluteTime, Either a b)
forall a. Maybe a
Nothing