{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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.DeepSeq (NFData (..))
import Control.Monad.Reader

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

import NoThunks.Class (NoThunks (..))

import Data.Time.Clock (DiffTime)
import Data.Time.Clock qualified as Time
import Data.Word (Word64)
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 stock    (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, 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, Int -> Time -> ShowS
[Time] -> ShowS
Time -> String
(Int -> Time -> ShowS)
-> (Time -> String) -> ([Time] -> ShowS) -> Show Time
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Time -> ShowS
showsPrec :: Int -> Time -> ShowS
$cshow :: Time -> String
show :: Time -> String
$cshowList :: [Time] -> ShowS
showList :: [Time] -> ShowS
Show, (forall x. Time -> Rep Time x)
-> (forall x. Rep Time x -> Time) -> Generic Time
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
$cfrom :: forall x. Time -> Rep Time x
from :: forall x. Time -> Rep Time x
$cto :: forall x. Rep Time x -> Time
to :: forall x. Rep Time x -> Time
Generic)
  deriving newtype  Time -> ()
(Time -> ()) -> NFData Time
forall a. (a -> ()) -> NFData a
$crnf :: Time -> ()
rnf :: Time -> ()
NFData
  deriving anyclass Context -> Time -> IO (Maybe ThunkInfo)
Proxy Time -> String
(Context -> Time -> IO (Maybe ThunkInfo))
-> (Context -> Time -> IO (Maybe ThunkInfo))
-> (Proxy Time -> String)
-> NoThunks Time
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Time -> IO (Maybe ThunkInfo)
noThunks :: Context -> Time -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Time -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Time -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Time -> String
showTypeOf :: Proxy Time -> String
NoThunks

-- | 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 DiffTime -> DiffTime -> DiffTime
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 DiffTime -> DiffTime -> DiffTime
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 (Word64 -> Time) -> m Word64 -> m Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadMonotonicTimeNSec m => m Word64
MonadTime.getMonotonicTimeNSec
      where
        conv :: Word64 -> Time
        conv :: Word64 -> Time
conv = DiffTime -> Time
Time (DiffTime -> Time) -> (Word64 -> DiffTime) -> Word64 -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DiffTime
Time.picosecondsToDiffTime (Integer -> DiffTime) -> (Word64 -> Integer) -> Word64 -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1_000) (Integer -> Integer) -> (Word64 -> Integer) -> Word64 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
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 = m Time -> ReaderT r m Time
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime