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

git.iko.soy/streamly

on 3feeec2 help sign in

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

410 lines 14 kB history raw

1{-# LANGUAGE TypeInType #-}

2{-# LANGUAGE UnboxedTuples #-}

4-- |

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

7--

8-- License : BSD3

9-- Maintainer : streamly@composewell.com

10-- Stability : experimental

11-- Portability : GHC

13module Streamly.Internal.Data.Time.Units

14 (

15 -- * Time Unit Conversions

16 TimeUnit()

17 -- , TimeUnitWide()

18 , TimeUnit64()

20 -- * Time Units

21 , TimeSpec(..)

22 , NanoSecond64(..)

23 , MicroSecond64(..)

24 , MilliSecond64(..)

25 , showNanoSecond64

27 -- * Absolute times (using TimeSpec)

28 , AbsTime(..)

29 , toAbsTime

30 , fromAbsTime

32 -- * Relative times (using TimeSpec)

33 , RelTime

34 , toRelTime

35 , fromRelTime

36 , diffAbsTime

37 , addToAbsTime

39 -- * Relative times (using NanoSecond64)

40 , RelTime64

41 , toRelTime64

42 , fromRelTime64

43 , diffAbsTime64

44 , addToAbsTime64

45 , showRelTime64

46 )

47where

49#include "inline.hs"

51import Text.Printf (printf)

53import Data.Int

54import Data.Primitive.Types (Prim(..))

55import Streamly.Internal.Data.Time.TimeSpec

57-------------------------------------------------------------------------------

58-- Some constants

59-------------------------------------------------------------------------------

61{-# INLINE tenPower3 #-}

62tenPower3 :: Int64

63tenPower3 = 1000

65{-# INLINE tenPower6 #-}

66tenPower6 :: Int64

67tenPower6 = 1000000

69{-# INLINE tenPower9 #-}

70tenPower9 :: Int64

71tenPower9 = 1000000000

74-------------------------------------------------------------------------------

75-- Time Unit Representations

76-------------------------------------------------------------------------------

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

79-- for a unit.

80--

81-- Second Rational

82-- Second Double

83-- Second Int64

84-- Second Integer

85-- NanoSecond Int64

86-- ...

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

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

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

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

93-------------------------------------------------------------------------------

94-- Integral Units

95-------------------------------------------------------------------------------

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

98-- represent time up to ~292 years.

99newtype NanoSecond64 = NanoSecond64 Int64

100 deriving ( Eq

101 , Read

102 , Show

103 , Enum

104 , Bounded

105 , Num

106 , Real

107 , Integral

108 , Ord

109 , Prim

110 )

111

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

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

114newtype MicroSecond64 = MicroSecond64 Int64

115 deriving ( Eq

116 , Read

117 , Show

118 , Enum

119 , Bounded

120 , Num

121 , Real

122 , Integral

123 , Ord

124 , Prim

125 )

126

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

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

129newtype MilliSecond64 = MilliSecond64 Int64

130 deriving ( Eq

131 , Read

132 , Show

133 , Enum

134 , Bounded

135 , Num

136 , Real

137 , Integral

138 , Ord

139 , Prim

140 )

141

142-------------------------------------------------------------------------------

143-- Fractional Units

144-------------------------------------------------------------------------------

145

146-------------------------------------------------------------------------------

147-- Time unit conversions

148-------------------------------------------------------------------------------

149

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

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

152-- rid of TimeUnitWide.

153--

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

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

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

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

158--

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

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

161{-

162class TimeUnitWide a where

163 toTimeInteger :: a -> Integer

164 fromTimeInteger :: Integer -> a

165-}

166

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

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

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

170-- operations.

171--

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

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

174class TimeUnit a where

175 toTimeSpec :: a -> TimeSpec

176 fromTimeSpec :: TimeSpec -> a

177

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

179-- fromNanoSecond64Unsafe for conversion without overflow check.

180--

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

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

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

184-- arithmetic operations.

185--

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

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

188class TimeUnit64 a where

189 toNanoSecond64 :: a -> NanoSecond64

190 fromNanoSecond64 :: NanoSecond64 -> a

191

192-------------------------------------------------------------------------------

193-- Time units

194-------------------------------------------------------------------------------

195

196instance TimeUnit TimeSpec where

197 toTimeSpec = id

198 fromTimeSpec = id

199

200instance TimeUnit NanoSecond64 where

201 {-# INLINE toTimeSpec #-}

202 toTimeSpec (NanoSecond64 t) = TimeSpec s ns

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

204

205 {-# INLINE fromTimeSpec #-}

206 fromTimeSpec (TimeSpec s ns) =

207 NanoSecond64 $ s * tenPower9 + ns

208

209instance TimeUnit64 NanoSecond64 where

210 {-# INLINE toNanoSecond64 #-}

211 toNanoSecond64 = id

212

213 {-# INLINE fromNanoSecond64 #-}

214 fromNanoSecond64 = id

215

216instance TimeUnit MicroSecond64 where

217 {-# INLINE toTimeSpec #-}

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

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

220

221 {-# INLINE fromTimeSpec #-}

222 fromTimeSpec (TimeSpec s ns) =

223 -- XXX round ns to nearest microsecond?

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

225

226instance TimeUnit64 MicroSecond64 where

227 {-# INLINE toNanoSecond64 #-}

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

229

230 {-# INLINE fromNanoSecond64 #-}

231 -- XXX round ns to nearest microsecond?

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

233

234instance TimeUnit MilliSecond64 where

235 {-# INLINE toTimeSpec #-}

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

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

238

239 {-# INLINE fromTimeSpec #-}

240 fromTimeSpec (TimeSpec s ns) =

241 -- XXX round ns to nearest millisecond?

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

243

244instance TimeUnit64 MilliSecond64 where

245 {-# INLINE toNanoSecond64 #-}

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

247

248 {-# INLINE fromNanoSecond64 #-}

249 -- XXX round ns to nearest millisecond?

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

251

252-------------------------------------------------------------------------------

253-- Absolute time

254-------------------------------------------------------------------------------

255

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

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

258-- billion years at a nanosecond resolution.

259newtype AbsTime = AbsTime TimeSpec

260 deriving (Eq, Ord, Show)

261

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

263{-# INLINE_NORMAL toAbsTime #-}

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

265toAbsTime = AbsTime . toTimeSpec

266

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

268{-# INLINE_NORMAL fromAbsTime #-}

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

270fromAbsTime (AbsTime t) = fromTimeSpec t

271

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

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

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

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

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

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

278

279-------------------------------------------------------------------------------

280-- Relative time using NaonoSecond64 as the underlying representation

281-------------------------------------------------------------------------------

282

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

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

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

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

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

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

289

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

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

292newtype RelTime64 = RelTime64 NanoSecond64

293 deriving ( Eq

294 , Read

295 , Show

296 , Enum

297 , Bounded

298 , Num

299 , Real

300 , Integral

301 , Ord

302 )

303

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

305{-# INLINE_NORMAL toRelTime64 #-}

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

307toRelTime64 = RelTime64 . toNanoSecond64

308

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

310{-# INLINE_NORMAL fromRelTime64 #-}

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

312fromRelTime64 (RelTime64 t) = fromNanoSecond64 t

313

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

315 toRelTime64 (fromRelTime64 a) = a #-}

316

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

318 fromRelTime64 (toRelTime64 a) = a #-}

319

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

321{-# INLINE diffAbsTime64 #-}

322diffAbsTime64 :: AbsTime -> AbsTime -> RelTime64

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

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

325

326{-# INLINE addToAbsTime64 #-}

327addToAbsTime64 :: AbsTime -> RelTime64 -> AbsTime

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

329 AbsTime $ TimeSpec (s1 + s) ns

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

331

332-------------------------------------------------------------------------------

333-- Relative time using TimeSpec as the underlying representation

334-------------------------------------------------------------------------------

335

336newtype RelTime = RelTime TimeSpec

337 deriving ( Eq

338 , Read

339 , Show

340 -- , Enum

341 -- , Bounded

342 , Num

343 -- , Real

344 -- , Integral

345 , Ord

346 )

347

348{-# INLINE_NORMAL toRelTime #-}

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

350toRelTime = RelTime . toTimeSpec

351

352{-# INLINE_NORMAL fromRelTime #-}

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

354fromRelTime (RelTime t) = fromTimeSpec t

355

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

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

358

359-- XXX rename to diffAbsTimes?

360{-# INLINE diffAbsTime #-}

361diffAbsTime :: AbsTime -> AbsTime -> RelTime

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

363

364{-# INLINE addToAbsTime #-}

365addToAbsTime :: AbsTime -> RelTime -> AbsTime

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

367

368-------------------------------------------------------------------------------

369-- Formatting and printing

370-------------------------------------------------------------------------------

371

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

373showNanoSecond64 :: NanoSecond64 -> String

374showNanoSecond64 time@(NanoSecond64 ns)

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

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

377#ifdef mingw32_HOST_OS

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

379#else

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

381#endif

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

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

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

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

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

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

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

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

390 | otherwise =

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

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

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

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

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

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

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

398

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

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

401{-

402data UnitName =

403 Nano

404 | Micro

405 | Milli

406 | Sec

407-}

408

409showRelTime64 :: RelTime64 -> String

410showRelTime64 = showNanoSecond64 . fromRelTime64