{-# LANGUAGE DefaultSignatures  #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE NumericUnderscores #-}

module Control.Monad.Class.MonadTime.SI
  ( MonadTime (..)
  , MonadMonotonicTime (..)
    -- * 'DiffTime' and its action on 'Time'
  , Time (..)
  , diffTime
  , addTime
  , DiffTime
    -- * 'NominalTime' and its action on 'UTCTime'
  , UTCTime
  , diffUTCTime
  , addUTCTime
  , NominalDiffTime
  ) where

import           Control.Monad.Reader

import           Control.Monad.Class.MonadTime ( MonadMonotonicTimeNSec,
                     MonadTime (..), NominalDiffTime, UTCTime, diffUTCTime,
                     addUTCTime)
import qualified Control.Monad.Class.MonadTime as MonadTime

import           Data.Word (Word64)
import           Data.Time.Clock (DiffTime)
import qualified Data.Time.Clock as Time
import           GHC.Generics (Generic (..))


-- | A point in time in a monotonic clock.
--
-- The epoch for this clock is arbitrary and does not correspond to any wall
-- clock or calendar, and is /not guaranteed/ to be the same epoch across
-- program runs. It is represented as the 'DiffTime' from this arbitrary epoch.
--
newtype Time = Time DiffTime
  deriving (Time -> Time -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c== :: Time -> Time -> Bool
Eq, Eq 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
min :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmax :: Time -> Time -> Time
>= :: Time -> Time -> Bool
$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
compare :: Time -> Time -> Ordering
$ccompare :: Time -> Time -> Ordering
Ord, Int -> Time -> ShowS
[Time] -> ShowS
Time -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Time] -> ShowS
$cshowList :: [Time] -> ShowS
show :: Time -> String
$cshow :: Time -> String
showsPrec :: Int -> Time -> ShowS
$cshowsPrec :: Int -> Time -> ShowS
Show, forall x. Rep Time x -> Time
forall x. Time -> Rep Time x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Time x -> Time
$cfrom :: forall x. Time -> Rep Time x
Generic)

-- | The time duration between two points in time (positive or negative).
diffTime :: Time -> Time -> DiffTime
diffTime :: Time -> Time -> DiffTime
diffTime (Time DiffTime
t) (Time DiffTime
t') = DiffTime
t forall a. Num a => a -> a -> a
- DiffTime
t'

-- | Add a duration to a point in time, giving another time.
addTime :: DiffTime -> Time -> Time
addTime :: DiffTime -> Time -> Time
addTime DiffTime
d (Time DiffTime
t) = DiffTime -> Time
Time (DiffTime
d forall a. Num a => a -> a -> a
+ DiffTime
t)

infixr 9 `addTime`

class MonadMonotonicTimeNSec m => MonadMonotonicTime m where
  getMonotonicTime :: m Time

  default getMonotonicTime :: m Time
  getMonotonicTime =
        Word64 -> Time
conv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadMonotonicTimeNSec m => m Word64
MonadTime.getMonotonicTimeNSec
      where
        conv :: Word64 -> Time
        conv :: Word64 -> Time
conv = DiffTime -> Time
Time forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DiffTime
Time.picosecondsToDiffTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Integer
1_000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger

instance MonadMonotonicTime IO where

--
-- MTL instances
--

instance MonadMonotonicTime m => MonadMonotonicTime (ReaderT r m) where
  getMonotonicTime :: ReaderT r m Time
getMonotonicTime = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime