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

git.iko.soy/streamly

on da36a01 help sign in

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

414 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 : pre-release

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 Foreign.Storable (Storable)

55import Streamly.Internal.Data.Unboxed (Unbox)

56import Streamly.Internal.Data.Time.TimeSpec

58-------------------------------------------------------------------------------

59-- Some constants

60-------------------------------------------------------------------------------

62{-# INLINE tenPower3 #-}

63tenPower3 :: Int64

64tenPower3 = 1000

66{-# INLINE tenPower6 #-}

67tenPower6 :: Int64

68tenPower6 = 1000000

70{-# INLINE tenPower9 #-}

71tenPower9 :: Int64

72tenPower9 = 1000000000

75-------------------------------------------------------------------------------

76-- Time Unit Representations

77-------------------------------------------------------------------------------

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

80-- for a unit.

81--

82-- Second Rational

83-- Second Double

84-- Second Int64

85-- Second Integer

86-- NanoSecond Int64

87-- ...

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

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

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

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

94-------------------------------------------------------------------------------

95-- Integral Units

96-------------------------------------------------------------------------------

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

99-- represent time up to ~292 years.

100newtype NanoSecond64 = NanoSecond64 Int64

101 deriving ( Eq

102 , Read

103 , Show

104 , Enum

105 , Bounded

106 , Num

107 , Real

108 , Integral

109 , Ord

110 , Storable

111 , Unbox

112 )

113

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

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

116newtype MicroSecond64 = MicroSecond64 Int64

117 deriving ( Eq

118 , Read

119 , Show

120 , Enum

121 , Bounded

122 , Num

123 , Real

124 , Integral

125 , Ord

126 , Storable

127 , Unbox

128 )

129

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

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

132newtype MilliSecond64 = MilliSecond64 Int64

133 deriving ( Eq

134 , Read

135 , Show

136 , Enum

137 , Bounded

138 , Num

139 , Real

140 , Integral

141 , Ord

142 , Storable

143 , Unbox

144 )

145

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

147-- Fractional Units

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

149

150-------------------------------------------------------------------------------

151-- Time unit conversions

152-------------------------------------------------------------------------------

153

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

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

156-- rid of TimeUnitWide.

157--

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

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

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

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

162--

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

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

165{-

166class TimeUnitWide a where

167 toTimeInteger :: a -> Integer

168 fromTimeInteger :: Integer -> a

169-}

170

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

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

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

174-- operations.

175--

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

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

178class TimeUnit a where

179 toTimeSpec :: a -> TimeSpec

180 fromTimeSpec :: TimeSpec -> a

181

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

183-- fromNanoSecond64Unsafe for conversion without overflow check.

184--

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

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

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

188-- arithmetic operations.

189--

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

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

192class TimeUnit64 a where

193 toNanoSecond64 :: a -> NanoSecond64

194 fromNanoSecond64 :: NanoSecond64 -> a

195

196-------------------------------------------------------------------------------

197-- Time units

198-------------------------------------------------------------------------------

199

200instance TimeUnit TimeSpec where

201 toTimeSpec = id

202 fromTimeSpec = id

203

204instance TimeUnit NanoSecond64 where

205 {-# INLINE toTimeSpec #-}

206 toTimeSpec (NanoSecond64 t) = TimeSpec s ns

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

208

209 {-# INLINE fromTimeSpec #-}

210 fromTimeSpec (TimeSpec s ns) =

211 NanoSecond64 $ s * tenPower9 + ns

212

213instance TimeUnit64 NanoSecond64 where

214 {-# INLINE toNanoSecond64 #-}

215 toNanoSecond64 = id

216

217 {-# INLINE fromNanoSecond64 #-}

218 fromNanoSecond64 = id

219

220instance TimeUnit MicroSecond64 where

221 {-# INLINE toTimeSpec #-}

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

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

224

225 {-# INLINE fromTimeSpec #-}

226 fromTimeSpec (TimeSpec s ns) =

227 -- XXX round ns to nearest microsecond?

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

229

230instance TimeUnit64 MicroSecond64 where

231 {-# INLINE toNanoSecond64 #-}

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

233

234 {-# INLINE fromNanoSecond64 #-}

235 -- XXX round ns to nearest microsecond?

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

237

238instance TimeUnit MilliSecond64 where

239 {-# INLINE toTimeSpec #-}

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

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

242

243 {-# INLINE fromTimeSpec #-}

244 fromTimeSpec (TimeSpec s ns) =

245 -- XXX round ns to nearest millisecond?

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

247

248instance TimeUnit64 MilliSecond64 where

249 {-# INLINE toNanoSecond64 #-}

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

251

252 {-# INLINE fromNanoSecond64 #-}

253 -- XXX round ns to nearest millisecond?

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

255

256-------------------------------------------------------------------------------

257-- Absolute time

258-------------------------------------------------------------------------------

259

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

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

262-- billion years at a nanosecond resolution.

263newtype AbsTime = AbsTime TimeSpec

264 deriving (Eq, Ord, Show)

265

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

267{-# INLINE_NORMAL toAbsTime #-}

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

269toAbsTime = AbsTime . toTimeSpec

270

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

272{-# INLINE_NORMAL fromAbsTime #-}

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

274fromAbsTime (AbsTime t) = fromTimeSpec t

275

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

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

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

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

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

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

282

283-------------------------------------------------------------------------------

284-- Relative time using NaonoSecond64 as the underlying representation

285-------------------------------------------------------------------------------

286

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

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

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

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

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

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

293

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

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

296newtype RelTime64 = RelTime64 NanoSecond64

297 deriving ( Eq

298 , Read

299 , Show

300 , Enum

301 , Bounded

302 , Num

303 , Real

304 , Integral

305 , Ord

306 )

307

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

309{-# INLINE_NORMAL toRelTime64 #-}

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

311toRelTime64 = RelTime64 . toNanoSecond64

312

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

314{-# INLINE_NORMAL fromRelTime64 #-}

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

316fromRelTime64 (RelTime64 t) = fromNanoSecond64 t

317

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

319 toRelTime64 (fromRelTime64 a) = a #-}

320

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

322 fromRelTime64 (toRelTime64 a) = a #-}

323

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

325{-# INLINE diffAbsTime64 #-}

326diffAbsTime64 :: AbsTime -> AbsTime -> RelTime64

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

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

329

330{-# INLINE addToAbsTime64 #-}

331addToAbsTime64 :: AbsTime -> RelTime64 -> AbsTime

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

333 AbsTime $ TimeSpec (s1 + s) ns

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

335

336-------------------------------------------------------------------------------

337-- Relative time using TimeSpec as the underlying representation

338-------------------------------------------------------------------------------

339

340newtype RelTime = RelTime TimeSpec

341 deriving ( Eq

342 , Read

343 , Show

344 -- , Enum

345 -- , Bounded

346 , Num

347 -- , Real

348 -- , Integral

349 , Ord

350 )

351

352{-# INLINE_NORMAL toRelTime #-}

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

354toRelTime = RelTime . toTimeSpec

355

356{-# INLINE_NORMAL fromRelTime #-}

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

358fromRelTime (RelTime t) = fromTimeSpec t

359

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

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

362

363-- XXX rename to diffAbsTimes?

364{-# INLINE diffAbsTime #-}

365diffAbsTime :: AbsTime -> AbsTime -> RelTime

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

367

368{-# INLINE addToAbsTime #-}

369addToAbsTime :: AbsTime -> RelTime -> AbsTime

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

371

372-------------------------------------------------------------------------------

373-- Formatting and printing

374-------------------------------------------------------------------------------

375

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

377showNanoSecond64 :: NanoSecond64 -> String

378showNanoSecond64 time@(NanoSecond64 ns)

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

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

381#ifdef mingw32_HOST_OS

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

383#else

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

385#endif

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

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

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

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

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

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

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

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

394 | otherwise =

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

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

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

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

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

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

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

402

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

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

405{-

406data UnitName =

407 Nano

408 | Micro

409 | Milli

410 | Sec

411-}

412

413showRelTime64 :: RelTime64 -> String

414showRelTime64 = showNanoSecond64 . fromRelTime64