{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NumericUnderscores #-}
module Control.Monad.Class.MonadTime.SI
( MonadTime (..)
, MonadMonotonicTime (..)
, Time (..)
, diffTime
, addTime
, DiffTime
, 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 (..))
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
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'
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
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