2021-04-16 09:55:04 +03:00
|
|
|
{-# LANGUAGE NumDecimals #-}
|
2019-09-11 11:21:12 +03:00
|
|
|
|
2020-05-13 15:33:16 +03:00
|
|
|
{-| Types for time intervals of various units. Each newtype wraps 'DiffTime',
|
|
|
|
but they have different 'Num' instances. The intent is to use the record
|
|
|
|
selectors to write literals with particular units, like this:
|
2019-09-11 11:21:12 +03:00
|
|
|
|
|
|
|
@
|
|
|
|
>>> 'milliseconds' 500
|
|
|
|
0.5s
|
|
|
|
>>> 'hours' 3
|
|
|
|
10800s
|
|
|
|
>>> 'minutes' 1.5 + 'seconds' 30
|
|
|
|
120s
|
|
|
|
@
|
|
|
|
|
|
|
|
You can also go the other way using the constructors rather than the selectors:
|
|
|
|
|
|
|
|
@
|
|
|
|
>>> 'toRational' '$' 'Minutes' ('seconds' 17)
|
|
|
|
17 % 60
|
|
|
|
>>> 'realToFrac' ('Days' ('hours' 12)) :: 'Double'
|
|
|
|
0.5
|
|
|
|
@
|
|
|
|
|
2020-05-13 15:33:16 +03:00
|
|
|
NOTE: the 'Real' and 'Fractional' instances just essentially add or strip the
|
|
|
|
unit label (as above), so you can't use 'realToFrac' to convert between the
|
|
|
|
units types here. Instead try 'convertDuration' which is less of a foot-gun.
|
2020-01-16 04:56:57 +03:00
|
|
|
|
2020-05-13 15:33:16 +03:00
|
|
|
The 'Read' instances for these types mirror the behavior of the 'RealFrac'
|
|
|
|
instance wrt numeric literals for convenient serialization (e.g. when working
|
|
|
|
with env vars):
|
2020-01-16 04:56:57 +03:00
|
|
|
|
|
|
|
@
|
2020-05-13 15:33:16 +03:00
|
|
|
>>> read "1.2" :: Milliseconds
|
2020-01-16 04:56:57 +03:00
|
|
|
Milliseconds {milliseconds = 0.0012s}
|
|
|
|
@
|
|
|
|
|
2020-05-13 15:33:16 +03:00
|
|
|
Generally, if you need to pass around a duration between functions you should
|
|
|
|
use 'DiffTime' directly. However if storing a duration in a type that will be
|
|
|
|
serialized, e.g. one having a 'ToJSON' instance, it is better to use one of
|
|
|
|
these explicit wrapper types so that it's obvious what units will be used. -}
|
2019-09-11 11:21:12 +03:00
|
|
|
module Data.Time.Clock.Units
|
|
|
|
( Days(..)
|
|
|
|
, Hours(..)
|
|
|
|
, Minutes(..)
|
2020-01-16 04:56:57 +03:00
|
|
|
, Seconds(..)
|
2019-09-11 11:21:12 +03:00
|
|
|
, Milliseconds(..)
|
|
|
|
, Microseconds(..)
|
|
|
|
, Nanoseconds(..)
|
2020-01-16 04:56:57 +03:00
|
|
|
-- * Converting between units
|
|
|
|
, Duration(..)
|
2020-05-13 15:33:16 +03:00
|
|
|
, convertDuration
|
2020-01-16 04:56:57 +03:00
|
|
|
-- * Reexports
|
|
|
|
-- | We use 'DiffTime' as the standard type for unit-agnostic duration in our
|
2020-05-13 15:33:16 +03:00
|
|
|
-- code. You'll need to convert to a 'NominalDiffTime' (with 'convertDuration') in
|
2020-01-16 04:56:57 +03:00
|
|
|
-- order to do anything useful with 'UTCTime' with these durations.
|
|
|
|
--
|
|
|
|
-- NOTE: some care must be taken especially when 'NominalDiffTime' interacts
|
|
|
|
-- with 'UTCTime':
|
|
|
|
--
|
2020-05-13 15:33:16 +03:00
|
|
|
-- - a 'DiffTime' or 'NominalDiffTime' may be negative
|
2020-01-16 04:56:57 +03:00
|
|
|
-- - 'addUTCTime' and 'diffUTCTime' do not attempt to handle leap seconds
|
|
|
|
, DiffTime
|
2021-05-31 16:54:08 +03:00
|
|
|
, diffTimeToMicroSeconds
|
2019-09-11 11:21:12 +03:00
|
|
|
) where
|
|
|
|
|
2019-08-28 15:19:21 +03:00
|
|
|
import Prelude
|
2019-09-11 11:21:12 +03:00
|
|
|
|
2021-03-31 13:39:01 +03:00
|
|
|
import Control.Applicative ((<|>))
|
|
|
|
import Control.Arrow (first)
|
2020-01-16 04:56:57 +03:00
|
|
|
import Data.Aeson
|
|
|
|
import Data.Hashable
|
2019-08-28 15:19:21 +03:00
|
|
|
import Data.Proxy
|
2021-03-31 13:39:01 +03:00
|
|
|
import Data.Text (unpack)
|
2019-08-28 15:19:21 +03:00
|
|
|
import Data.Time.Clock
|
|
|
|
import GHC.TypeLits
|
2021-03-31 13:39:01 +03:00
|
|
|
import Numeric (readFloat)
|
|
|
|
|
|
|
|
import qualified Text.Read as TR
|
2019-09-11 11:21:12 +03:00
|
|
|
|
2020-01-16 04:56:57 +03:00
|
|
|
newtype Seconds = Seconds { seconds :: DiffTime }
|
|
|
|
-- NOTE: we want Show to give a pastable data structure string, even
|
|
|
|
-- though Read is custom.
|
|
|
|
deriving (Duration, Show, Eq, Ord, ToJSON, FromJSON)
|
|
|
|
deriving (Read, Num, Fractional, Real, Hashable, RealFrac) via (TimeUnit (SecondsP 1))
|
2019-09-11 11:21:12 +03:00
|
|
|
|
2020-01-16 04:56:57 +03:00
|
|
|
-- TODO if needed: deriving (ToJSON, FromJSON) via (TimeUnit ..) making sure
|
|
|
|
-- to copy Aeson instances (with withBoundedScientific), and e.g.
|
|
|
|
-- toJSON (5 :: Minutes) == Number 5
|
2019-09-11 11:21:12 +03:00
|
|
|
newtype Days = Days { days :: DiffTime }
|
2020-01-16 04:56:57 +03:00
|
|
|
deriving (Duration, Show, Eq, Ord)
|
|
|
|
deriving (Read, Num, Fractional, Real, Hashable, RealFrac) via (TimeUnit (SecondsP 86400))
|
2019-09-11 11:21:12 +03:00
|
|
|
|
|
|
|
newtype Hours = Hours { hours :: DiffTime }
|
2020-01-16 04:56:57 +03:00
|
|
|
deriving (Duration, Show, Eq, Ord)
|
|
|
|
deriving (Read, Num, Fractional, Real, Hashable, RealFrac) via (TimeUnit (SecondsP 3600))
|
2019-09-11 11:21:12 +03:00
|
|
|
|
|
|
|
newtype Minutes = Minutes { minutes :: DiffTime }
|
2020-01-16 04:56:57 +03:00
|
|
|
deriving (Duration, Show, Eq, Ord)
|
|
|
|
deriving (Read, Num, Fractional, Real, Hashable, RealFrac) via (TimeUnit (SecondsP 60))
|
2019-09-11 11:21:12 +03:00
|
|
|
|
|
|
|
newtype Milliseconds = Milliseconds { milliseconds :: DiffTime }
|
2020-01-16 04:56:57 +03:00
|
|
|
deriving (Duration, Show, Eq, Ord)
|
|
|
|
deriving (Read, Num, Fractional, Real, Hashable, RealFrac) via (TimeUnit 1000000000)
|
2019-09-11 11:21:12 +03:00
|
|
|
|
2021-03-31 13:39:01 +03:00
|
|
|
-- TODO: Has an alternative string representation instead of a numberic one here
|
|
|
|
-- in order to clarify what's going on.
|
|
|
|
-- Rounding is also problematic, but should be ok for now...
|
|
|
|
instance ToJSON Milliseconds where
|
|
|
|
toJSON = toJSON . flip div 1e9 . diffTimeToPicoseconds . milliseconds
|
|
|
|
|
|
|
|
instance FromJSON Milliseconds where
|
|
|
|
parseJSON v
|
|
|
|
= withScientific "Milliseconds Number" (pure . Milliseconds . picosecondsToDiffTime . (* 1e9) . ceiling) v
|
|
|
|
<|> withText "Milliseconds String" (either (fail . show) pure . TR.readEither . unpack) v
|
|
|
|
|
|
|
|
|
2019-09-11 11:21:12 +03:00
|
|
|
newtype Microseconds = Microseconds { microseconds :: DiffTime }
|
2020-01-16 04:56:57 +03:00
|
|
|
deriving (Duration, Show, Eq, Ord)
|
|
|
|
deriving (Read, Num, Fractional, Real, Hashable, RealFrac) via (TimeUnit 1000000)
|
2019-09-11 11:21:12 +03:00
|
|
|
|
|
|
|
newtype Nanoseconds = Nanoseconds { nanoseconds :: DiffTime }
|
2020-01-16 04:56:57 +03:00
|
|
|
deriving (Duration, Show, Eq, Ord)
|
|
|
|
deriving (Read, Num, Fractional, Real, Hashable, RealFrac) via (TimeUnit 1000)
|
2019-09-11 11:21:12 +03:00
|
|
|
|
2020-01-16 04:56:57 +03:00
|
|
|
-- Internal for deriving via
|
2019-09-11 11:21:12 +03:00
|
|
|
newtype TimeUnit (picosPerUnit :: Nat) = TimeUnit DiffTime
|
|
|
|
deriving (Show, Eq, Ord)
|
|
|
|
|
|
|
|
type SecondsP n = n GHC.TypeLits.* 1000000000000
|
|
|
|
|
|
|
|
natNum :: forall n a. (KnownNat n, Num a) => a
|
|
|
|
natNum = fromInteger $ natVal (Proxy @n)
|
|
|
|
|
|
|
|
instance (KnownNat picosPerUnit) => Num (TimeUnit picosPerUnit) where
|
|
|
|
TimeUnit a + TimeUnit b = TimeUnit $ a + b
|
|
|
|
TimeUnit a - TimeUnit b = TimeUnit $ a - b
|
|
|
|
TimeUnit a * TimeUnit b = TimeUnit . picosecondsToDiffTime $
|
|
|
|
diffTimeToPicoseconds a * diffTimeToPicoseconds b `div` natNum @picosPerUnit
|
|
|
|
negate (TimeUnit a) = TimeUnit $ negate a
|
|
|
|
abs (TimeUnit a) = TimeUnit $ abs a
|
|
|
|
signum (TimeUnit a) = TimeUnit $ signum a
|
|
|
|
fromInteger a = TimeUnit . picosecondsToDiffTime $ a * natNum @picosPerUnit
|
|
|
|
|
2020-01-16 04:56:57 +03:00
|
|
|
instance (KnownNat picosPerUnit) => Read (TimeUnit picosPerUnit) where
|
|
|
|
readsPrec _ = map (first fromRational) . readFloat
|
|
|
|
|
2019-09-11 11:21:12 +03:00
|
|
|
instance (KnownNat picosPerUnit) => Fractional (TimeUnit picosPerUnit) where
|
|
|
|
TimeUnit a / TimeUnit b = TimeUnit . picosecondsToDiffTime $
|
|
|
|
diffTimeToPicoseconds a * natNum @picosPerUnit `div` diffTimeToPicoseconds b
|
|
|
|
fromRational a = TimeUnit . picosecondsToDiffTime $ round (a * natNum @picosPerUnit)
|
|
|
|
|
|
|
|
instance (KnownNat picosPerUnit) => Real (TimeUnit picosPerUnit) where
|
|
|
|
toRational (TimeUnit a) = toRational (diffTimeToPicoseconds a) / natNum @picosPerUnit
|
|
|
|
|
|
|
|
instance (KnownNat picosPerUnit) => RealFrac (TimeUnit picosPerUnit) where
|
|
|
|
properFraction a = (i, a - fromIntegral i)
|
|
|
|
where i = truncate a
|
|
|
|
truncate = truncate . toRational
|
|
|
|
round = round . toRational
|
|
|
|
ceiling = ceiling . toRational
|
|
|
|
floor = floor . toRational
|
2020-01-16 04:56:57 +03:00
|
|
|
|
|
|
|
-- we can ignore unit:
|
|
|
|
instance Hashable (TimeUnit a) where
|
2020-05-13 15:33:16 +03:00
|
|
|
hashWithSalt salt (TimeUnit dt) = hashWithSalt salt $
|
2020-01-16 04:56:57 +03:00
|
|
|
(realToFrac :: DiffTime -> Double) dt
|
|
|
|
|
|
|
|
|
2020-05-13 15:33:16 +03:00
|
|
|
-- | Duration types isomorphic to 'DiffTime', powering 'convertDuration'.
|
2020-01-16 04:56:57 +03:00
|
|
|
class Duration d where
|
|
|
|
fromDiffTime :: DiffTime -> d
|
|
|
|
toDiffTime :: d -> DiffTime
|
|
|
|
|
|
|
|
instance Duration DiffTime where
|
|
|
|
fromDiffTime = id
|
|
|
|
toDiffTime = id
|
|
|
|
|
|
|
|
instance Duration NominalDiffTime where
|
|
|
|
fromDiffTime = realToFrac
|
|
|
|
toDiffTime = realToFrac
|
|
|
|
|
|
|
|
-- | Safe conversion between duration units.
|
2020-05-13 15:33:16 +03:00
|
|
|
convertDuration :: (Duration x, Duration y) => x -> y
|
|
|
|
convertDuration = fromDiffTime . toDiffTime
|
2021-05-31 16:54:08 +03:00
|
|
|
|
|
|
|
diffTimeToMicroSeconds :: DiffTime -> Integer
|
|
|
|
diffTimeToMicroSeconds = (`div` 1000000) . diffTimeToPicoseconds
|