{-# LANGUAGE DeriveGeneric #-}

module Control.Monad.Class.MonadTime
  ( MonadTime (..)
  , MonadMonotonicTimeNSec (..)
    -- * 'NominalTime' and its action on 'UTCTime'
  , UTCTime
  , diffUTCTime
  , addUTCTime
  , NominalDiffTime
  ) where

import           Control.Monad.Reader

import           Data.Time.Clock (NominalDiffTime, UTCTime,
                     addUTCTime, diffUTCTime)
import qualified Data.Time.Clock as Time
import           Data.Word (Word64)
import qualified GHC.Clock as IO (getMonotonicTimeNSec)


class Monad m => MonadMonotonicTimeNSec m where
  -- | Time in a monotonic clock, with high precision. The epoch for this
  -- clock is arbitrary and does not correspond to any wall clock or calendar.
  --
  -- The time is measured in nano seconds as does `getMonotonicTimeNSec` from
  -- "base".
  --
  getMonotonicTimeNSec :: m Word64

class Monad m => MonadTime m where
  -- | Wall clock time.
  --
  getCurrentTime :: m UTCTime

--
-- Instances for IO
--

instance MonadMonotonicTimeNSec IO where
  getMonotonicTimeNSec :: IO Word64
getMonotonicTimeNSec = IO Word64
IO.getMonotonicTimeNSec

instance MonadTime IO where
  getCurrentTime :: IO UTCTime
getCurrentTime = IO UTCTime
Time.getCurrentTime

--
-- MTL instances
--

instance MonadMonotonicTimeNSec m => MonadMonotonicTimeNSec (ReaderT r m) where
  getMonotonicTimeNSec :: ReaderT r m Word64
getMonotonicTimeNSec = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadMonotonicTimeNSec m => m Word64
getMonotonicTimeNSec

instance MonadTime m => MonadTime (ReaderT r m) where
  getCurrentTime :: ReaderT r m UTCTime
getCurrentTime   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime