1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module System.Clock.Seconds
( Clock(..)
, Seconds(..)
, getTime
, getRes
, fromNanoSecs
, toNanoSecs
, diffTimeSpec
) where
import Data.Coerce
import Data.Ratio
import Data.Typeable (Typeable)
import Foreign.Storable
import GHC.Generics (Generic)
import System.Clock(TimeSpec(..), Clock, s2ns, normalize)
import qualified System.Clock as C
newtype Seconds = Seconds { toTimeSpec :: TimeSpec }
deriving (Generic, Read, Show, Typeable, Eq, Ord, Storable, Bounded)
instance Num Seconds where
fromInteger n = Seconds $ TimeSpec (fromInteger n) 0
Seconds (TimeSpec xs xn) * Seconds (TimeSpec ys yn) =
Seconds $ normalize $! TimeSpec (xs*ys) (xs*yn+xn*ys+((xn*yn) `div` s2ns))
(+) = coerce ((+) :: TimeSpec -> TimeSpec -> TimeSpec)
(-) = coerce ((-) :: TimeSpec -> TimeSpec -> TimeSpec)
negate = coerce (negate :: TimeSpec -> TimeSpec)
abs = coerce (abs :: TimeSpec -> TimeSpec)
signum (Seconds a) = case signum a of
1 -> 1
(-1) -> (-1)
_ -> 0
instance Enum Seconds where
succ x = x + 1
pred x = x - 1
toEnum x = Seconds $ TimeSpec (fromIntegral x) 0
fromEnum (Seconds (TimeSpec s _)) = fromEnum s
instance Real Seconds where
toRational (Seconds x) = toInteger x % s2ns
instance Fractional Seconds where
fromRational x = Seconds . fromInteger $ floor (x * s2ns)
Seconds a / Seconds b = Seconds $ a * s2ns `div` b
recip (Seconds a) = Seconds $ s2ns * s2ns `div` a
instance RealFrac Seconds where
properFraction (Seconds (TimeSpec s ns))
| s >= 0 = (fromIntegral s, Seconds $ TimeSpec 0 ns)
| otherwise = (fromIntegral (s+1), Seconds $ TimeSpec (-1) ns)
-- | The 'getTime' function shall return the current value for the
-- specified clock.
getTime :: Clock -> IO Seconds
getTime = coerce C.getTime
-- | The 'getRes' function shall return the resolution of any clock.
-- Clock resolutions are implementation-defined and cannot be set
-- by a process.
getRes :: Clock -> IO Seconds
getRes = coerce C.getRes
-- | Seconds from nano seconds.
fromNanoSecs :: Integer -> Seconds
fromNanoSecs = coerce C.fromNanoSecs
-- | Seconds to nano seconds.
toNanoSecs :: Seconds -> Integer
toNanoSecs = coerce C.toNanoSecs
-- | Compute the absolute difference.
diffTimeSpec :: Seconds -> Seconds -> Seconds
diffTimeSpec = coerce C.diffTimeSpec
|
