src/Streamly/Internal/Data/Time/Units.hs · streamly

git.iko.soy/streamly

on c3dcabc help sign in

streamly/src/Streamly/Internal/Data/Time/Units.hs

403 lines 14 kB history raw

1#include "inline.hs"

3-- |

4-- Module : Streamly.Internal.Data.Time.Units

6--

7-- License : BSD3

8-- Maintainer : streamly@composewell.com

9-- Stability : experimental

10-- Portability : GHC

12module Streamly.Internal.Data.Time.Units

13 (

14 -- * Time Unit Conversions

15 TimeUnit()

16 -- , TimeUnitWide()

17 , TimeUnit64()

19 -- * Time Units

20 , TimeSpec(..)

21 , NanoSecond64(..)

22 , MicroSecond64(..)

23 , MilliSecond64(..)

24 , showNanoSecond64

26 -- * Absolute times (using TimeSpec)

27 , AbsTime(..)

28 , toAbsTime

29 , fromAbsTime

31 -- * Relative times (using TimeSpec)

32 , RelTime

33 , toRelTime

34 , fromRelTime

35 , diffAbsTime

36 , addToAbsTime

38 -- * Relative times (using NanoSecond64)

39 , RelTime64

40 , toRelTime64

41 , fromRelTime64

42 , diffAbsTime64

43 , addToAbsTime64

44 , showRelTime64

45 )

46where

48import Text.Printf (printf)

50import Data.Int

51import Streamly.Internal.Data.Time.TimeSpec

53-------------------------------------------------------------------------------

54-- Some constants

55-------------------------------------------------------------------------------

57{-# INLINE tenPower3 #-}

58tenPower3 :: Int64

59tenPower3 = 1000

61{-# INLINE tenPower6 #-}

62tenPower6 :: Int64

63tenPower6 = 1000000

65{-# INLINE tenPower9 #-}

66tenPower9 :: Int64

67tenPower9 = 1000000000

70-------------------------------------------------------------------------------

71-- Time Unit Representations

72-------------------------------------------------------------------------------

74-- XXX We should be able to use type families to use different represenations

75-- for a unit.

76--

77-- Second Rational

78-- Second Double

79-- Second Int64

80-- Second Integer

81-- NanoSecond Int64

82-- ...

84-- Double or Fixed would be a much better representation so that we do not lose

85-- information between conversions. However, for faster arithmetic operations

86-- we use an 'Int64' here. When we need convservation of values we can use a

87-- different system of units with a Fixed precision.

89-------------------------------------------------------------------------------

90-- Integral Units

91-------------------------------------------------------------------------------

93-- | An 'Int64' time representation with a nanosecond resolution. It can

94-- represent time up to ~292 years.

95newtype NanoSecond64 = NanoSecond64 Int64

96 deriving ( Eq

97 , Read

98 , Show

99 , Enum

100 , Bounded

101 , Num

102 , Real

103 , Integral

104 , Ord

105 )

106

107-- | An 'Int64' time representation with a microsecond resolution.

108-- It can represent time up to ~292,000 years.

109newtype MicroSecond64 = MicroSecond64 Int64

110 deriving ( Eq

111 , Read

112 , Show

113 , Enum

114 , Bounded

115 , Num

116 , Real

117 , Integral

118 , Ord

119 )

120

121-- | An 'Int64' time representation with a millisecond resolution.

122-- It can represent time up to ~292 million years.

123newtype MilliSecond64 = MilliSecond64 Int64

124 deriving ( Eq

125 , Read

126 , Show

127 , Enum

128 , Bounded

129 , Num

130 , Real

131 , Integral

132 , Ord

133 )

134

135-------------------------------------------------------------------------------

136-- Fractional Units

137-------------------------------------------------------------------------------

138

139-------------------------------------------------------------------------------

140-- Time unit conversions

141-------------------------------------------------------------------------------

142

143-- TODO: compare whether using TimeSpec instead of Integer provides significant

144-- performance boost. If not then we can just use Integer nanoseconds and get

145-- rid of TimeUnitWide.

146--

147-- | A type class for converting between time units using 'Integer' as the

148-- intermediate and the widest representation with a nanosecond resolution.

149-- This system of units can represent arbitrarily large times but provides

150-- least efficient arithmetic operations due to 'Integer' arithmetic.

151--

152-- NOTE: Converting to and from units may truncate the value depending on the

153-- original value and the size and resolution of the destination unit.

154{-

155class TimeUnitWide a where

156 toTimeInteger :: a -> Integer

157 fromTimeInteger :: Integer -> a

158-}

159

160-- | A type class for converting between units of time using 'TimeSpec' as the

161-- intermediate representation. This system of units can represent up to ~292

162-- billion years at nanosecond resolution with reasonably efficient arithmetic

163-- operations.

164--

165-- NOTE: Converting to and from units may truncate the value depending on the

166-- original value and the size and resolution of the destination unit.

167class TimeUnit a where

168 toTimeSpec :: a -> TimeSpec

169 fromTimeSpec :: TimeSpec -> a

170

171-- XXX we can use a fromNanoSecond64 for conversion with overflow check and

172-- fromNanoSecond64Unsafe for conversion without overflow check.

173--

174-- | A type class for converting between units of time using 'Int64' as the

175-- intermediate representation with a nanosecond resolution. This system of

176-- units can represent up to ~292 years at nanosecond resolution with fast

177-- arithmetic operations.

178--

179-- NOTE: Converting to and from units may truncate the value depending on the

180-- original value and the size and resolution of the destination unit.

181class TimeUnit64 a where

182 toNanoSecond64 :: a -> NanoSecond64

183 fromNanoSecond64 :: NanoSecond64 -> a

184

185-------------------------------------------------------------------------------

186-- Time units

187-------------------------------------------------------------------------------

188

189instance TimeUnit TimeSpec where

190 toTimeSpec = id

191 fromTimeSpec = id

192

193instance TimeUnit NanoSecond64 where

194 {-# INLINE toTimeSpec #-}

195 toTimeSpec (NanoSecond64 t) = TimeSpec s ns

196 where (s, ns) = t `divMod` tenPower9

197

198 {-# INLINE fromTimeSpec #-}

199 fromTimeSpec (TimeSpec s ns) =

200 NanoSecond64 $ s * tenPower9 + ns

201

202instance TimeUnit64 NanoSecond64 where

203 {-# INLINE toNanoSecond64 #-}

204 toNanoSecond64 = id

205

206 {-# INLINE fromNanoSecond64 #-}

207 fromNanoSecond64 = id

208

209instance TimeUnit MicroSecond64 where

210 {-# INLINE toTimeSpec #-}

211 toTimeSpec (MicroSecond64 t) = TimeSpec s (us * tenPower3)

212 where (s, us) = t `divMod` tenPower6

213

214 {-# INLINE fromTimeSpec #-}

215 fromTimeSpec (TimeSpec s ns) =

216 -- XXX round ns to nearest microsecond?

217 MicroSecond64 $ s * tenPower6 + (ns `div` tenPower3)

218

219instance TimeUnit64 MicroSecond64 where

220 {-# INLINE toNanoSecond64 #-}

221 toNanoSecond64 (MicroSecond64 us) = NanoSecond64 $ us * tenPower3

222

223 {-# INLINE fromNanoSecond64 #-}

224 -- XXX round ns to nearest microsecond?

225 fromNanoSecond64 (NanoSecond64 ns) = MicroSecond64 $ ns `div` tenPower3

226

227instance TimeUnit MilliSecond64 where

228 {-# INLINE toTimeSpec #-}

229 toTimeSpec (MilliSecond64 t) = TimeSpec s (ms * tenPower6)

230 where (s, ms) = t `divMod` tenPower3

231

232 {-# INLINE fromTimeSpec #-}

233 fromTimeSpec (TimeSpec s ns) =

234 -- XXX round ns to nearest millisecond?

235 MilliSecond64 $ s * tenPower3 + (ns `div` tenPower6)

236

237instance TimeUnit64 MilliSecond64 where

238 {-# INLINE toNanoSecond64 #-}

239 toNanoSecond64 (MilliSecond64 ms) = NanoSecond64 $ ms * tenPower6

240

241 {-# INLINE fromNanoSecond64 #-}

242 -- XXX round ns to nearest millisecond?

243 fromNanoSecond64 (NanoSecond64 ns) = MilliSecond64 $ ns `div` tenPower6

244

245-------------------------------------------------------------------------------

246-- Absolute time

247-------------------------------------------------------------------------------

248

249-- | Absolute times are relative to a predefined epoch in time. 'AbsTime'

250-- represents times using 'TimeSpec' which can represent times up to ~292

251-- billion years at a nanosecond resolution.

252newtype AbsTime = AbsTime TimeSpec

253 deriving (Eq, Ord, Show)

254

255-- | Convert a 'TimeUnit' to an absolute time.

256{-# INLINE_NORMAL toAbsTime #-}

257toAbsTime :: TimeUnit a => a -> AbsTime

258toAbsTime = AbsTime . toTimeSpec

259

260-- | Convert absolute time to a 'TimeUnit'.

261{-# INLINE_NORMAL fromAbsTime #-}

262fromAbsTime :: TimeUnit a => AbsTime -> a

263fromAbsTime (AbsTime t) = fromTimeSpec t

264

265-- XXX We can also write rewrite rules to simplify divisions multiplications

266-- and additions when manipulating units. Though, that might get simplified at

267-- the assembly (llvm) level as well. Note to/from conversions may be lossy and

268-- therefore this equation may not hold, but that's ok.

269{-# RULES "fromAbsTime/toAbsTime" forall a. toAbsTime (fromAbsTime a) = a #-}

270{-# RULES "toAbsTime/fromAbsTime" forall a. fromAbsTime (toAbsTime a) = a #-}

271

272-------------------------------------------------------------------------------

273-- Relative time using NaonoSecond64 as the underlying representation

274-------------------------------------------------------------------------------

275

276-- We use a separate type to represent relative time for safety and speed.

277-- RelTime has a Num instance, absolute time doesn't. Relative times are

278-- usually shorter and for our purposes an Int64 nanoseconds can hold close to

279-- thousand year duration. It is also faster to manipulate. We do not check for

280-- overflows during manipulations so use it only when you know the time cannot

281-- be too big. If you need a bigger RelTime representation then use RelTimeBig.

282

283-- | Relative times are relative to some arbitrary point of time. Unlike

284-- 'AbsTime' they are not relative to a predefined epoch.

285newtype RelTime64 = RelTime64 NanoSecond64

286 deriving ( Eq

287 , Read

288 , Show

289 , Enum

290 , Bounded

291 , Num

292 , Real

293 , Integral

294 , Ord

295 )

296

297-- | Convert a 'TimeUnit' to a relative time.

298{-# INLINE_NORMAL toRelTime64 #-}

299toRelTime64 :: TimeUnit64 a => a -> RelTime64

300toRelTime64 = RelTime64 . toNanoSecond64

301

302-- | Convert relative time to a 'TimeUnit'.

303{-# INLINE_NORMAL fromRelTime64 #-}

304fromRelTime64 :: TimeUnit64 a => RelTime64 -> a

305fromRelTime64 (RelTime64 t) = fromNanoSecond64 t

306

307{-# RULES "fromRelTime64/toRelTime64" forall a .

308 toRelTime64 (fromRelTime64 a) = a #-}

309

310{-# RULES "toRelTime64/fromRelTime64" forall a .

311 fromRelTime64 (toRelTime64 a) = a #-}

312

313-- | Difference between two absolute points of time.

314{-# INLINE diffAbsTime64 #-}

315diffAbsTime64 :: AbsTime -> AbsTime -> RelTime64

316diffAbsTime64 (AbsTime (TimeSpec s1 ns1)) (AbsTime (TimeSpec s2 ns2)) =

317 RelTime64 $ NanoSecond64 $ ((s1 - s2) * tenPower9) + (ns1 - ns2)

318

319{-# INLINE addToAbsTime64 #-}

320addToAbsTime64 :: AbsTime -> RelTime64 -> AbsTime

321addToAbsTime64 (AbsTime (TimeSpec s1 ns1)) (RelTime64 (NanoSecond64 ns2)) =

322 AbsTime $ TimeSpec (s1 + s) ns

323 where (s, ns) = (ns1 + ns2) `divMod` tenPower9

324

325-------------------------------------------------------------------------------

326-- Relative time using TimeSpec as the underlying representation

327-------------------------------------------------------------------------------

328

329newtype RelTime = RelTime TimeSpec

330 deriving ( Eq

331 , Read

332 , Show

333 -- , Enum

334 -- , Bounded

335 , Num

336 -- , Real

337 -- , Integral

338 , Ord

339 )

340

341{-# INLINE_NORMAL toRelTime #-}

342toRelTime :: TimeUnit a => a -> RelTime

343toRelTime = RelTime . toTimeSpec

344

345{-# INLINE_NORMAL fromRelTime #-}

346fromRelTime :: TimeUnit a => RelTime -> a

347fromRelTime (RelTime t) = fromTimeSpec t

348

349{-# RULES "fromRelTime/toRelTime" forall a. toRelTime (fromRelTime a) = a #-}

350{-# RULES "toRelTime/fromRelTime" forall a. fromRelTime (toRelTime a) = a #-}

351

352-- XXX rename to diffAbsTimes?

353{-# INLINE diffAbsTime #-}

354diffAbsTime :: AbsTime -> AbsTime -> RelTime

355diffAbsTime (AbsTime t1) (AbsTime t2) = RelTime (t1 - t2)

356

357{-# INLINE addToAbsTime #-}

358addToAbsTime :: AbsTime -> RelTime -> AbsTime

359addToAbsTime (AbsTime t1) (RelTime t2) = AbsTime $ t1 + t2

360

361-------------------------------------------------------------------------------

362-- Formatting and printing

363-------------------------------------------------------------------------------

364

365-- | Convert nanoseconds to a string showing time in an appropriate unit.

366showNanoSecond64 :: NanoSecond64 -> String

367showNanoSecond64 time@(NanoSecond64 ns)

368 | time < 0 = '-' : showNanoSecond64 (-time)

369 | ns < 1000 = fromIntegral ns `with` "ns"

370#ifdef mingw32_HOST_OS

371 | ns < 1000000 = (fromIntegral ns / 1000) `with` "us"

372#else

373 | ns < 1000000 = (fromIntegral ns / 1000) `with` "μs"

374#endif

375 | ns < 1000000000 = (fromIntegral ns / 1000000) `with` "ms"

376 | ns < (60 * 1000000000) = (fromIntegral ns / 1000000000) `with` "s"

377 | ns < (60 * 60 * 1000000000) =

378 (fromIntegral ns / (60 * 1000000000)) `with` "min"

379 | ns < (24 * 60 * 60 * 1000000000) =

380 (fromIntegral ns / (60 * 60 * 1000000000)) `with` "hr"

381 | ns < (365 * 24 * 60 * 60 * 1000000000) =

382 (fromIntegral ns / (24 * 60 * 60 * 1000000000)) `with` "days"

383 | otherwise =

384 (fromIntegral ns / (365 * 24 * 60 * 60 * 1000000000)) `with` "years"

385 where with (t :: Double) (u :: String)

386 | t >= 1e9 = printf "%.4g %s" t u

387 | t >= 1e3 = printf "%.0f %s" t u

388 | t >= 1e2 = printf "%.1f %s" t u

389 | t >= 1e1 = printf "%.2f %s" t u

390 | otherwise = printf "%.3f %s" t u

391

392-- In general we should be able to show the time in a specified unit, if we

393-- omit the unit we can show it in an automatically chosen one.

394{-

395data UnitName =

396 Nano

397 | Micro

398 | Milli

399 | Sec

400-}

401

402showRelTime64 :: RelTime64 -> String

403showRelTime64 = showNanoSecond64 . fromRelTime64