on 50232af help sign in
471 lines 16 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE ScopedTypeVariables #-}
5#include "inline.hs"
7-- |
8-- Module : Streamly.Time.Units
9-- Copyright : (c) 2019 Harendra Kumar
10--
11-- License : BSD3
12-- Maintainer : harendra.kumar@gmail.com
13-- Stability : experimental
14-- Portability : GHC
16module Streamly.Time.Units
17 (
18 -- * Time Unit Conversions
19 TimeUnit()
20 -- , TimeUnitWide()
21 , TimeUnit64()
23 -- * Time Units
24 , TimeSpec(..)
25 , NanoSecond64(..)
26 , MicroSecond64(..)
27 , MilliSecond64(..)
28 , showNanoSecond64
30 -- * Absolute times (using TimeSpec)
31 , AbsTime(..)
32 , toAbsTime
33 , fromAbsTime
35 -- * Relative times (using TimeSpec)
36 , RelTime
37 , toRelTime
38 , fromRelTime
39 , diffAbsTime
40 , addToAbsTime
42 -- * Relative times (using NanoSecond64)
43 , RelTime64
44 , toRelTime64
45 , fromRelTime64
46 , diffAbsTime64
47 , addToAbsTime64
48 , showRelTime64
49 )
50where
52import Data.Int
53import Text.Printf (printf)
55-------------------------------------------------------------------------------
56-- Some constants
57-------------------------------------------------------------------------------
59{-# INLINE tenPower3 #-}
60tenPower3 :: Int64
61tenPower3 = 1000
63{-# INLINE tenPower6 #-}
64tenPower6 :: Int64
65tenPower6 = 1000000
67{-# INLINE tenPower9 #-}
68tenPower9 :: Int64
69tenPower9 = 1000000000
71-------------------------------------------------------------------------------
72-- Time Unit Representations
73-------------------------------------------------------------------------------
75-- XXX We should be able to use type families to use different represenations
76-- for a unit.
77--
78-- Second Rational
79-- Second Double
80-- Second Int64
81-- Second Integer
82-- NanoSecond Int64
83-- ...
85-- Double or Fixed would be a much better representation so that we do not lose
86-- information between conversions. However, for faster arithmetic operations
87-- we use an 'Int64' here. When we need convservation of values we can use a
88-- different system of units with a Fixed precision.
90-------------------------------------------------------------------------------
91-- Integral Units
92-------------------------------------------------------------------------------
94-- | An 'Int64' time representation with a nanosecond resolution. It can
95-- represent time up to ~292 years.
96newtype NanoSecond64 = NanoSecond64 Int64
97 deriving ( Eq
98 , Read
99 , Show
100 , Enum
101 , Bounded
102 , Num
103 , Real
104 , Integral
105 , Ord
106 )
108-- | An 'Int64' time representation with a microsecond resolution.
109-- It can represent time up to ~292,000 years.
110newtype MicroSecond64 = MicroSecond64 Int64
111 deriving ( Eq
112 , Read
113 , Show
114 , Enum
115 , Bounded
116 , Num
117 , Real
118 , Integral
119 , Ord
120 )
122-- | An 'Int64' time representation with a millisecond resolution.
123-- It can represent time up to ~292 million years.
124newtype MilliSecond64 = MilliSecond64 Int64
125 deriving ( Eq
126 , Read
127 , Show
128 , Enum
129 , Bounded
130 , Num
131 , Real
132 , Integral
133 , Ord
134 )
136-------------------------------------------------------------------------------
137-- Fractional Units
138-------------------------------------------------------------------------------
140-------------------------------------------------------------------------------
141-- TimeSpec representation
142-------------------------------------------------------------------------------
144-- A structure storing seconds and nanoseconds as 'Int64' is the simplest and
145-- fastest way to store practically large quantities of time with efficient
146-- arithmetic operations. If we store nanoseconds using 'Integer' it can store
147-- practically unbounded quantities but it may not be as efficient to
148-- manipulate in performance critical applications. XXX need to measure the
149-- performance.
150--
151-- | Data type to represent practically large quantities of time efficiently.
152-- It can represent time up to ~292 billion years at nanosecond resolution.
153data TimeSpec = TimeSpec
154 { sec :: {-# UNPACK #-} !Int64 -- ^ seconds
155 , nsec :: {-# UNPACK #-} !Int64 -- ^ nanoseconds
156 } deriving (Eq, Read, Show)
158-- We assume that nsec is always less than 10^9. When TimeSpec is negative then
159-- both sec and nsec are negative.
160instance Ord TimeSpec where
161 compare (TimeSpec s1 ns1) (TimeSpec s2 ns2) =
162 if s1 == s2
163 then compare ns1 ns2
164 else compare s1 s2
166-- make sure nsec is less than 10^9
167{-# INLINE addWithOverflow #-}
168addWithOverflow :: TimeSpec -> TimeSpec -> TimeSpec
169addWithOverflow (TimeSpec s1 ns1) (TimeSpec s2 ns2) =
170 let nsum = ns1 + ns2
171 (s', ns) = if (nsum > tenPower9 || nsum < negate tenPower9)
172 then nsum `divMod` tenPower9
173 else (0, nsum)
174 in TimeSpec (s1 + s2 + s') ns
176-- make sure both sec and nsec have the same sign
177{-# INLINE adjustSign #-}
178adjustSign :: TimeSpec -> TimeSpec
179adjustSign (t@(TimeSpec s ns)) =
180 if (s > 0 && ns < 0)
181 then TimeSpec (s - 1) (ns + tenPower9)
182 else if (s < 0 && ns > 0)
183 then TimeSpec (s + 1) (ns - tenPower9)
184 else t
186{-# INLINE timeSpecToInteger #-}
187timeSpecToInteger :: TimeSpec -> Integer
188timeSpecToInteger (TimeSpec s ns) = toInteger $ s * tenPower9 + ns
190instance Num TimeSpec where
191 {-# INLINE (+) #-}
192 t1 + t2 = adjustSign (addWithOverflow t1 t2)
194 -- XXX will this be more optimal if imlemented without "negate"?
195 {-# INLINE (-) #-}
196 t1 - t2 = t1 + (negate t2)
197 t1 * t2 = fromInteger $ timeSpecToInteger t1 * timeSpecToInteger t2
199 {-# INLINE negate #-}
200 negate (TimeSpec s ns) = TimeSpec (negate s) (negate ns)
201 {-# INLINE abs #-}
202 abs (TimeSpec s ns) = TimeSpec (abs s) (abs ns)
203 {-# INLINE signum #-}
204 signum (TimeSpec s ns) | s == 0 = TimeSpec (signum ns) 0
205 | otherwise = TimeSpec (signum s) 0
206 -- This is fromNanoSecond64 Integer
207 {-# INLINE fromInteger #-}
208 fromInteger nanosec = TimeSpec (fromInteger s) (fromInteger ns)
209 where (s, ns) = nanosec `divMod` toInteger tenPower9
211-------------------------------------------------------------------------------
212-- Time unit conversions
213-------------------------------------------------------------------------------
215-- TODO: compare whether using TimeSpec instead of Integer provides significant
216-- performance boost. If not then we can just use Integer nanoseconds and get
217-- rid of TimeUnitWide.
218--
219-- | A type class for converting between time units using 'Integer' as the
220-- intermediate and the widest representation with a nanosecond resolution.
221-- This system of units can represent arbitrarily large times but provides
222-- least efficient arithmetic operations due to 'Integer' arithmetic.
223--
224-- NOTE: Converting to and from units may truncate the value depending on the
225-- original value and the size and resolution of the destination unit.
226{-
227class TimeUnitWide a where
228 toTimeInteger :: a -> Integer
229 fromTimeInteger :: Integer -> a
230-}
232-- | A type class for converting between units of time using 'TimeSpec' as the
233-- intermediate representation. This system of units can represent up to ~292
234-- billion years at nanosecond resolution with reasonably efficient arithmetic
235-- operations.
236--
237-- NOTE: Converting to and from units may truncate the value depending on the
238-- original value and the size and resolution of the destination unit.
239class TimeUnit a where
240 toTimeSpec :: a -> TimeSpec
241 fromTimeSpec :: TimeSpec -> a
243-- XXX we can use a fromNanoSecond64 for conversion with overflow check and
244-- fromNanoSecond64Unsafe for conversion without overflow check.
245--
246-- | A type class for converting between units of time using 'Int64' as the
247-- intermediate representation with a nanosecond resolution. This system of
248-- units can represent up to ~292 years at nanosecond resolution with fast
249-- arithmetic operations.
250--
251-- NOTE: Converting to and from units may truncate the value depending on the
252-- original value and the size and resolution of the destination unit.
253class TimeUnit64 a where
254 toNanoSecond64 :: a -> NanoSecond64
255 fromNanoSecond64 :: NanoSecond64 -> a
257-------------------------------------------------------------------------------
258-- Time units
259-------------------------------------------------------------------------------
261instance TimeUnit TimeSpec where
262 toTimeSpec = id
263 fromTimeSpec = id
265instance TimeUnit NanoSecond64 where
266 {-# INLINE toTimeSpec #-}
267 toTimeSpec (NanoSecond64 t) = TimeSpec s ns
268 where (s, ns) = t `divMod` tenPower9
270 {-# INLINE fromTimeSpec #-}
271 fromTimeSpec (TimeSpec s ns) =
272 NanoSecond64 $ s * tenPower9 + ns
274instance TimeUnit64 NanoSecond64 where
275 {-# INLINE toNanoSecond64 #-}
276 toNanoSecond64 = id
278 {-# INLINE fromNanoSecond64 #-}
279 fromNanoSecond64 = id
281instance TimeUnit MicroSecond64 where
282 {-# INLINE toTimeSpec #-}
283 toTimeSpec (MicroSecond64 t) = TimeSpec s us
284 where (s, us) = t `divMod` tenPower6
286 {-# INLINE fromTimeSpec #-}
287 fromTimeSpec (TimeSpec s us) =
288 MicroSecond64 $ s * tenPower6 + us
290instance TimeUnit64 MicroSecond64 where
291 {-# INLINE toNanoSecond64 #-}
292 toNanoSecond64 (MicroSecond64 us) = NanoSecond64 $ us * tenPower3
294 {-# INLINE fromNanoSecond64 #-}
295 fromNanoSecond64 (NanoSecond64 ns) = MicroSecond64 $ ns `div` tenPower3
297instance TimeUnit MilliSecond64 where
298 {-# INLINE toTimeSpec #-}
299 toTimeSpec (MilliSecond64 t) = TimeSpec s us
300 where (s, us) = t `divMod` tenPower3
302 {-# INLINE fromTimeSpec #-}
303 fromTimeSpec (TimeSpec s us) =
304 MilliSecond64 $ s * tenPower3 + us
306instance TimeUnit64 MilliSecond64 where
307 {-# INLINE toNanoSecond64 #-}
308 toNanoSecond64 (MilliSecond64 us) = NanoSecond64 $ us * tenPower6
310 {-# INLINE fromNanoSecond64 #-}
311 fromNanoSecond64 (NanoSecond64 ns) = MilliSecond64 $ ns `div` tenPower6
313-------------------------------------------------------------------------------
314-- Absolute time
315-------------------------------------------------------------------------------
317-- | Absolute times are relative to a predefined epoch in time. 'AbsTime'
318-- represents times using 'TimeSpec' which can represent times up to ~292
319-- billion years at a nanosecond resolution.
320newtype AbsTime = AbsTime TimeSpec
321 deriving (Eq, Ord, Show)
323-- | Convert a 'TimeUnit' to an absolute time.
324{-# INLINE_NORMAL toAbsTime #-}
325toAbsTime :: TimeUnit a => a -> AbsTime
326toAbsTime = AbsTime . toTimeSpec
328-- | Convert absolute time to a 'TimeUnit'.
329{-# INLINE_NORMAL fromAbsTime #-}
330fromAbsTime :: TimeUnit a => AbsTime -> a
331fromAbsTime (AbsTime t) = fromTimeSpec t
333-- XXX We can also write rewrite rules to simplify divisions multiplications
334-- and additions when manipulating units. Though, that might get simplified at
335-- the assembly (llvm) level as well. Note to/from conversions may be lossy and
336-- therefore this equation may not hold, but that's ok.
337{-# RULES "fromAbsTime/toAbsTime" forall a. toAbsTime (fromAbsTime a) = a #-}
338{-# RULES "toAbsTime/fromAbsTime" forall a. fromAbsTime (toAbsTime a) = a #-}
340-------------------------------------------------------------------------------
341-- Relative time using NaonoSecond64 as the underlying representation
342-------------------------------------------------------------------------------
344-- We use a separate type to represent relative time for safety and speed.
345-- RelTime has a Num instance, absolute time doesn't. Relative times are
346-- usually shorter and for our purposes an Int64 nanoseconds can hold close to
347-- thousand year duration. It is also faster to manipulate. We do not check for
348-- overflows during manipulations so use it only when you know the time cannot
349-- be too big. If you need a bigger RelTime representation then use RelTimeBig.
351-- | Relative times are relative to some arbitrary point of time. Unlike
352-- 'AbsTime' they are not relative to a predefined epoch.
353newtype RelTime64 = RelTime64 NanoSecond64
354 deriving ( Eq
355 , Read
356 , Show
357 , Enum
358 , Bounded
359 , Num
360 , Real
361 , Integral
362 , Ord
363 )
365-- | Convert a 'TimeUnit' to a relative time.
366{-# INLINE_NORMAL toRelTime64 #-}
367toRelTime64 :: TimeUnit64 a => a -> RelTime64
368toRelTime64 = RelTime64 . toNanoSecond64
370-- | Convert relative time to a 'TimeUnit'.
371{-# INLINE_NORMAL fromRelTime64 #-}
372fromRelTime64 :: TimeUnit64 a => RelTime64 -> a
373fromRelTime64 (RelTime64 t) = fromNanoSecond64 t
375{-# RULES "fromRelTime64/toRelTime64" forall a .
376 toRelTime64 (fromRelTime64 a) = a #-}
378{-# RULES "toRelTime64/fromRelTime64" forall a .
379 fromRelTime64 (toRelTime64 a) = a #-}
381-- | Difference between two absolute points of time.
382{-# INLINE diffAbsTime64 #-}
383diffAbsTime64 :: AbsTime -> AbsTime -> RelTime64
384diffAbsTime64 (AbsTime (TimeSpec s1 ns1)) (AbsTime (TimeSpec s2 ns2)) =
385 RelTime64 $ NanoSecond64 $ ((s1 - s2) * tenPower9) + (ns1 - ns2)
387{-# INLINE addToAbsTime64 #-}
388addToAbsTime64 :: AbsTime -> RelTime64 -> AbsTime
389addToAbsTime64 (AbsTime (TimeSpec s1 ns1)) (RelTime64 (NanoSecond64 ns2)) =
390 AbsTime $ TimeSpec (s1 + s) ns
391 where (s, ns) = (ns1 + ns2) `divMod` tenPower9
393-------------------------------------------------------------------------------
394-- Relative time using TimeSpec as the underlying representation
395-------------------------------------------------------------------------------
397newtype RelTime = RelTime TimeSpec
398 deriving ( Eq
399 , Read
400 , Show
401 -- , Enum
402 -- , Bounded
403 , Num
404 -- , Real
405 -- , Integral
406 , Ord
407 )
409{-# INLINE_NORMAL toRelTime #-}
410toRelTime :: TimeUnit a => a -> RelTime
411toRelTime = RelTime . toTimeSpec
413{-# INLINE_NORMAL fromRelTime #-}
414fromRelTime :: TimeUnit a => RelTime -> a
415fromRelTime (RelTime t) = fromTimeSpec t
417{-# RULES "fromRelTime/toRelTime" forall a. toRelTime (fromRelTime a) = a #-}
418{-# RULES "toRelTime/fromRelTime" forall a. fromRelTime (toRelTime a) = a #-}
420-- XXX rename to diffAbsTimes?
421{-# INLINE diffAbsTime #-}
422diffAbsTime :: AbsTime -> AbsTime -> RelTime
423diffAbsTime (AbsTime t1) (AbsTime t2) = RelTime (t1 - t2)
425{-# INLINE addToAbsTime #-}
426addToAbsTime :: AbsTime -> RelTime -> AbsTime
427addToAbsTime (AbsTime t1) (RelTime t2) = AbsTime $ t1 + t2
429-------------------------------------------------------------------------------
430-- Formatting and printing
431-------------------------------------------------------------------------------
433-- | Convert nanoseconds to a string showing time in an appropriate unit.
434showNanoSecond64 :: NanoSecond64 -> String
435showNanoSecond64 time@(NanoSecond64 ns)
436 | time < 0 = '-' : showNanoSecond64 (-time)
437 | ns < 1000 = fromIntegral ns `with` "ns"
438#ifdef mingw32_HOST_OS
439 | ns < 1000000 = (fromIntegral ns / 1000) `with` "us"
440#else
441 | ns < 1000000 = (fromIntegral ns / 1000) `with` "μs"
442#endif
443 | ns < 1000000000 = (fromIntegral ns / 1000000) `with` "ms"
444 | ns < (60 * 1000000000) = (fromIntegral ns / 1000000000) `with` "s"
445 | ns < (60 * 60 * 1000000000) =
446 (fromIntegral ns / (60 * 1000000000)) `with` "min"
447 | ns < (24 * 60 * 60 * 1000000000) =
448 (fromIntegral ns / (60 * 60 * 1000000000)) `with` "hr"
449 | ns < (365 * 24 * 60 * 60 * 1000000000) =
450 (fromIntegral ns / (24 * 60 * 60 * 1000000000)) `with` "days"
451 | otherwise =
452 (fromIntegral ns / (365 * 24 * 60 * 60 * 1000000000)) `with` "years"
453 where with (t :: Double) (u :: String)
454 | t >= 1e9 = printf "%.4g %s" t u
455 | t >= 1e3 = printf "%.0f %s" t u
456 | t >= 1e2 = printf "%.1f %s" t u
457 | t >= 1e1 = printf "%.2f %s" t u
458 | otherwise = printf "%.3f %s" t u
460-- In general we should be able to show the time in a specified unit, if we
461-- omit the unit we can show it in an automatically chosen one.
462{-
463data UnitName =
464 Nano
465 | Micro
466 | Milli
467 | Sec
468-}
470showRelTime64 :: RelTime64 -> String
471showRelTime64 = showNanoSecond64 . fromRelTime64