-- | This module provides an API for working with
-- 'Data.Time.Clock.System.SystemTime' values similar to that of
-- 'Data.Time.Clock.UTCTime'. @SystemTime@s are more efficient to
-- obtain than @UTCTime@s, which is important to avoid animation
-- tick thread delays associated with expensive clock reads. In
-- addition, the @UTCTime@-based API provides unpleasant @Float@-based
-- conversions. Since the @SystemTime@-based API doesn't provide some
-- of the operations we need, and since it is easier to work with at
-- millisecond granularity, it is extended here for internal use.
module Brick.Animation.Clock
  ( Time
  , getTime
  , addOffset
  , subtractTime

  , Offset
  , offsetFromMs
  , offsetToMs
  )
where

import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.Time.Clock.System as C

newtype Time = Time C.SystemTime
             deriving (Eq Time
Eq Time =>
(Time -> Time -> Ordering)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Time)
-> (Time -> Time -> Time)
-> Ord Time
Time -> Time -> Bool
Time -> Time -> Ordering
Time -> Time -> Time
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
$ccompare :: Time -> Time -> Ordering
compare :: Time -> Time -> Ordering
$c< :: Time -> Time -> Bool
< :: Time -> Time -> Bool
$c<= :: Time -> Time -> Bool
<= :: Time -> Time -> Bool
$c> :: Time -> Time -> Bool
> :: Time -> Time -> Bool
$c>= :: Time -> Time -> Bool
>= :: Time -> Time -> Bool
$cmax :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
min :: Time -> Time -> Time
Ord, Time -> Time -> Bool
(Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
/= :: Time -> Time -> Bool
Eq)

-- | Signed difference in milliseconds
newtype Offset = Offset Integer
               deriving (Eq Offset
Eq Offset =>
(Offset -> Offset -> Ordering)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Offset)
-> (Offset -> Offset -> Offset)
-> Ord Offset
Offset -> Offset -> Bool
Offset -> Offset -> Ordering
Offset -> Offset -> Offset
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
$ccompare :: Offset -> Offset -> Ordering
compare :: Offset -> Offset -> Ordering
$c< :: Offset -> Offset -> Bool
< :: Offset -> Offset -> Bool
$c<= :: Offset -> Offset -> Bool
<= :: Offset -> Offset -> Bool
$c> :: Offset -> Offset -> Bool
> :: Offset -> Offset -> Bool
$c>= :: Offset -> Offset -> Bool
>= :: Offset -> Offset -> Bool
$cmax :: Offset -> Offset -> Offset
max :: Offset -> Offset -> Offset
$cmin :: Offset -> Offset -> Offset
min :: Offset -> Offset -> Offset
Ord, Offset -> Offset -> Bool
(Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool) -> Eq Offset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Offset -> Offset -> Bool
== :: Offset -> Offset -> Bool
$c/= :: Offset -> Offset -> Bool
/= :: Offset -> Offset -> Bool
Eq)

offsetFromMs :: Integer -> Offset
offsetFromMs :: Integer -> Offset
offsetFromMs = Integer -> Offset
Offset

offsetToMs :: Offset -> Integer
offsetToMs :: Offset -> Integer
offsetToMs (Offset Integer
ms) = Integer
ms

getTime :: (MonadIO m) => m Time
getTime :: forall (m :: * -> *). MonadIO m => m Time
getTime = SystemTime -> Time
Time (SystemTime -> Time) -> m SystemTime -> m Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> m SystemTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
C.getSystemTime

addOffset :: Offset -> Time -> Time
addOffset :: Offset -> Time -> Time
addOffset (Offset Integer
ms) (Time (C.MkSystemTime Int64
s Word32
ns)) =
    SystemTime -> Time
Time (SystemTime -> Time) -> SystemTime -> Time
forall a b. (a -> b) -> a -> b
$ Int64 -> Word32 -> SystemTime
C.MkSystemTime (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
s') (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
ns')
    where
        -- Note that due to the behavior of divMod, this works even when
        -- the offset is negative: the number of seconds is decremented
        -- and the remainder of nanoseconds is correct.
        s' :: Integer
s' = Integer
newSec Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
s
        (Integer
newSec, Integer
ns') = (Integer
nsPerMs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
ms Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
ns)
                          Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` (Integer
msPerS Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
nsPerMs)

subtractTime :: Time -> Time -> Offset
subtractTime :: Time -> Time -> Offset
subtractTime Time
t1 Time
t2 = Integer -> Offset
Offset (Integer -> Offset) -> Integer -> Offset
forall a b. (a -> b) -> a -> b
$ Time -> Integer
timeToMs Time
t1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Time -> Integer
timeToMs Time
t2

timeToMs :: Time -> Integer
timeToMs :: Time -> Integer
timeToMs (Time (C.MkSystemTime Int64
s Word32
ns)) =
    (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
s) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
msPerS Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+
    (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
ns) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
nsPerMs

nsPerMs :: Integer
nsPerMs :: Integer
nsPerMs = Integer
1000000

msPerS :: Integer
msPerS :: Integer
msPerS = Integer
1000