module Control.Concurrent.AlarmClock.TimeScale where
import Data.Time (UTCTime, diffUTCTime, getCurrentTime)
import System.Clock (Clock (Monotonic), TimeSpec, diffTimeSpec,
getTime, toNanoSecs)
class Eq t => TimeScale t where
getAbsoluteTime :: IO t
microsecondsDiff :: t -> t -> Integer
earlierOf :: t -> t -> t
instance TimeScale UTCTime where
getAbsoluteTime :: IO UTCTime
getAbsoluteTime = IO UTCTime
getCurrentTime
earlierOf :: UTCTime -> UTCTime -> UTCTime
earlierOf = UTCTime -> UTCTime -> UTCTime
forall a. Ord a => a -> a -> a
min
microsecondsDiff :: UTCTime -> UTCTime -> Integer
microsecondsDiff UTCTime
t1 UTCTime
t2 = NominalDiffTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (NominalDiffTime -> Integer) -> NominalDiffTime -> Integer
forall a b. (a -> b) -> a -> b
$ (NominalDiffTime
1000000 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*) (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t1 UTCTime
t2
newtype MonotonicTime = MonotonicTime TimeSpec deriving (Int -> MonotonicTime -> ShowS
[MonotonicTime] -> ShowS
MonotonicTime -> String
(Int -> MonotonicTime -> ShowS)
-> (MonotonicTime -> String)
-> ([MonotonicTime] -> ShowS)
-> Show MonotonicTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MonotonicTime] -> ShowS
$cshowList :: [MonotonicTime] -> ShowS
show :: MonotonicTime -> String
$cshow :: MonotonicTime -> String
showsPrec :: Int -> MonotonicTime -> ShowS
$cshowsPrec :: Int -> MonotonicTime -> ShowS
Show, MonotonicTime -> MonotonicTime -> Bool
(MonotonicTime -> MonotonicTime -> Bool)
-> (MonotonicTime -> MonotonicTime -> Bool) -> Eq MonotonicTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonotonicTime -> MonotonicTime -> Bool
$c/= :: MonotonicTime -> MonotonicTime -> Bool
== :: MonotonicTime -> MonotonicTime -> Bool
$c== :: MonotonicTime -> MonotonicTime -> Bool
Eq, Eq MonotonicTime
Eq MonotonicTime
-> (MonotonicTime -> MonotonicTime -> Ordering)
-> (MonotonicTime -> MonotonicTime -> Bool)
-> (MonotonicTime -> MonotonicTime -> Bool)
-> (MonotonicTime -> MonotonicTime -> Bool)
-> (MonotonicTime -> MonotonicTime -> Bool)
-> (MonotonicTime -> MonotonicTime -> MonotonicTime)
-> (MonotonicTime -> MonotonicTime -> MonotonicTime)
-> Ord MonotonicTime
MonotonicTime -> MonotonicTime -> Bool
MonotonicTime -> MonotonicTime -> Ordering
MonotonicTime -> MonotonicTime -> MonotonicTime
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 :: MonotonicTime -> MonotonicTime -> MonotonicTime
$cmin :: MonotonicTime -> MonotonicTime -> MonotonicTime
max :: MonotonicTime -> MonotonicTime -> MonotonicTime
$cmax :: MonotonicTime -> MonotonicTime -> MonotonicTime
>= :: MonotonicTime -> MonotonicTime -> Bool
$c>= :: MonotonicTime -> MonotonicTime -> Bool
> :: MonotonicTime -> MonotonicTime -> Bool
$c> :: MonotonicTime -> MonotonicTime -> Bool
<= :: MonotonicTime -> MonotonicTime -> Bool
$c<= :: MonotonicTime -> MonotonicTime -> Bool
< :: MonotonicTime -> MonotonicTime -> Bool
$c< :: MonotonicTime -> MonotonicTime -> Bool
compare :: MonotonicTime -> MonotonicTime -> Ordering
$ccompare :: MonotonicTime -> MonotonicTime -> Ordering
$cp1Ord :: Eq MonotonicTime
Ord)
instance TimeScale MonotonicTime where
getAbsoluteTime :: IO MonotonicTime
getAbsoluteTime = TimeSpec -> MonotonicTime
MonotonicTime (TimeSpec -> MonotonicTime) -> IO TimeSpec -> IO MonotonicTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> IO TimeSpec
getTime Clock
Monotonic
earlierOf :: MonotonicTime -> MonotonicTime -> MonotonicTime
earlierOf = MonotonicTime -> MonotonicTime -> MonotonicTime
forall a. Ord a => a -> a -> a
min
microsecondsDiff :: MonotonicTime -> MonotonicTime -> Integer
microsecondsDiff (MonotonicTime TimeSpec
t1) (MonotonicTime TimeSpec
t2)
| TimeSpec
t1 TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
< TimeSpec
t2 = -MonotonicTime -> MonotonicTime -> Integer
forall t. TimeScale t => t -> t -> Integer
microsecondsDiff (TimeSpec -> MonotonicTime
MonotonicTime TimeSpec
t2) (TimeSpec -> MonotonicTime
MonotonicTime TimeSpec
t1)
| Bool
otherwise = (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000) (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Integer
toNanoSecs (TimeSpec -> Integer) -> TimeSpec -> Integer
forall a b. (a -> b) -> a -> b
$ TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
t1 TimeSpec
t2