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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.UnixTime.Diff (
diffUnixTime,
addUnixDiffTime,
secondsToUnixDiffTime,
microSecondsToUnixDiffTime,
) where
import Data.Int
import Data.UnixTime.Types
import Foreign.C.Types
-- $setup
-- >>> :set -XOverloadedStrings
----------------------------------------------------------------
calc :: CTime -> Int32 -> UnixDiffTime
calc sec usec = uncurry UnixDiffTime . adjust sec $ usec
calc' :: CTime -> Int32 -> UnixDiffTime
calc' sec usec = uncurry UnixDiffTime . slowAdjust sec $ usec
calcU :: CTime -> Int32 -> UnixTime
calcU sec usec = uncurry UnixTime . adjust sec $ usec
-- | Arithmetic operations where (1::UnixDiffTime) means 1 second.
--
-- >>> (3 :: UnixDiffTime) + 2
-- UnixDiffTime {udtSeconds = 5, udtMicroSeconds = 0}
-- >>> (2 :: UnixDiffTime) - 5
-- UnixDiffTime {udtSeconds = -3, udtMicroSeconds = 0}
-- >>> (3 :: UnixDiffTime) * 2
-- UnixDiffTime {udtSeconds = 6, udtMicroSeconds = 0}
instance Num UnixDiffTime where
UnixDiffTime s1 u1 + UnixDiffTime s2 u2 = calc (s1 + s2) (u1 + u2)
UnixDiffTime s1 u1 - UnixDiffTime s2 u2 = calc (s1 - s2) (u1 - u2)
UnixDiffTime s1 u1 * UnixDiffTime s2 u2 = calc' (s1 * s2) (u1 * u2)
negate (UnixDiffTime s u) = UnixDiffTime (-s) (-u)
abs (UnixDiffTime s u) = UnixDiffTime (abs s) (abs u)
signum (UnixDiffTime s u)
| s == 0 && u == 0 = 0
| s > 0 = 1
| otherwise = -1
fromInteger i = UnixDiffTime (fromInteger i) 0
{-# RULES "Integral->UnixDiffTime" fromIntegral = secondsToUnixDiffTime #-}
instance Real UnixDiffTime where
toRational = toFractional
{-# RULES "UnixDiffTime->Fractional" realToFrac = toFractional #-}
----------------------------------------------------------------
-- | Calculating difference between two 'UnixTime'.
--
-- >>> UnixTime 100 2000 `diffUnixTime` UnixTime 98 2100
-- UnixDiffTime {udtSeconds = 1, udtMicroSeconds = 999900}
diffUnixTime :: UnixTime -> UnixTime -> UnixDiffTime
diffUnixTime (UnixTime s1 u1) (UnixTime s2 u2) = calc (s1 - s2) (u1 - u2)
-- | Adding difference to 'UnixTime'.
--
-- >>> UnixTime 100 2000 `addUnixDiffTime` microSecondsToUnixDiffTime ((-1003000) :: Int)
-- UnixTime {utSeconds = 98, utMicroSeconds = 999000}
addUnixDiffTime :: UnixTime -> UnixDiffTime -> UnixTime
addUnixDiffTime (UnixTime s1 u1) (UnixDiffTime s2 u2) = calcU (s1 + s2) (u1 + u2)
-- | Creating difference from seconds.
--
-- >>> secondsToUnixDiffTime (100 :: Int)
-- UnixDiffTime {udtSeconds = 100, udtMicroSeconds = 0}
secondsToUnixDiffTime :: Integral a => a -> UnixDiffTime
secondsToUnixDiffTime sec = UnixDiffTime (fromIntegral sec) 0
{-# INLINE secondsToUnixDiffTime #-}
-- | Creating difference from micro seconds.
--
-- >>> microSecondsToUnixDiffTime (12345678 :: Int)
-- UnixDiffTime {udtSeconds = 12, udtMicroSeconds = 345678}
--
-- >>> microSecondsToUnixDiffTime ((-12345678) :: Int)
-- UnixDiffTime {udtSeconds = -12, udtMicroSeconds = -345678}
microSecondsToUnixDiffTime :: Integral a => a -> UnixDiffTime
microSecondsToUnixDiffTime usec = calc (fromIntegral s) (fromIntegral u)
where
(s, u) = secondMicro usec
{-# INLINE microSecondsToUnixDiffTime #-}
----------------------------------------------------------------
adjust :: CTime -> Int32 -> (CTime, Int32)
adjust sec usec
| sec >= 0 = ajp
| otherwise = ajm
where
micro = 1000000
mmicro = -micro
ajp
| usec >= micro = (sec + 1, usec - micro)
| usec >= 0 = (sec, usec)
| otherwise = (sec - 1, usec + micro)
ajm
| usec <= mmicro = (sec - 1, usec + micro)
| usec <= 0 = (sec, usec)
| otherwise = (sec + 1, usec - micro)
slowAdjust :: CTime -> Int32 -> (CTime, Int32)
slowAdjust sec usec = (sec + fromIntegral s, usec - u)
where
(s, u) = secondMicro usec
secondMicro :: Integral a => a -> (a, a)
secondMicro usec = usec `quotRem` 1000000
toFractional :: Fractional a => UnixDiffTime -> a
toFractional (UnixDiffTime s u) = realToFrac s + realToFrac u / 1000000
{-# SPECIALIZE toFractional :: UnixDiffTime -> Double #-}
|
