{-# LANGUAGE NumDecimals #-}

-- | 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:
--
-- @
-- >>> '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
-- @
--
-- 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.
--
-- 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):
--
-- @
-- >>> read "1.2" :: Milliseconds
-- Milliseconds {milliseconds = 0.0012s}
-- @
--
-- 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.
module Data.Time.Clock.Units
  ( Days (..),
    Hours (..),
    Minutes (..),
    Seconds (..),
    Milliseconds (..),
    Microseconds (..),
    Nanoseconds (..),

    -- * Converting between units
    Duration (..),
    convertDuration,

    -- * Reexports

    -- | We use 'DiffTime' as the standard type for unit-agnostic duration in our
    -- code. You'll need to convert to a 'NominalDiffTime'  (with 'convertDuration') in
    -- order to do anything useful with 'UTCTime' with these durations.
    --
    -- NOTE: some care must be taken especially when 'NominalDiffTime' interacts
    -- with 'UTCTime':
    --
    --  - a 'DiffTime' or 'NominalDiffTime' may be negative
    --  - 'addUTCTime' and 'diffUTCTime' do not attempt to handle leap seconds
    DiffTime,
    diffTimeToMicroSeconds,
  )
where

import Control.Applicative ((<|>))
import Control.Arrow (first)
import Data.Aeson
import Data.Hashable
import Data.Proxy
import Data.Text (unpack)
import Data.Time.Clock
import GHC.TypeLits
import Numeric (readFloat)
import Text.Read qualified as TR
import Prelude

newtype Seconds = Seconds {Seconds -> DiffTime
seconds :: DiffTime}
  -- NOTE: we want Show to give a pastable data structure string, even
  -- though Read is custom.
  deriving (DiffTime -> Seconds
Seconds -> DiffTime
(DiffTime -> Seconds) -> (Seconds -> DiffTime) -> Duration Seconds
forall d. (DiffTime -> d) -> (d -> DiffTime) -> Duration d
toDiffTime :: Seconds -> DiffTime
$ctoDiffTime :: Seconds -> DiffTime
fromDiffTime :: DiffTime -> Seconds
$cfromDiffTime :: DiffTime -> Seconds
Duration, Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
(Int -> Seconds -> ShowS)
-> (Seconds -> String) -> ([Seconds] -> ShowS) -> Show Seconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seconds] -> ShowS
$cshowList :: [Seconds] -> ShowS
show :: Seconds -> String
$cshow :: Seconds -> String
showsPrec :: Int -> Seconds -> ShowS
$cshowsPrec :: Int -> Seconds -> ShowS
Show, Seconds -> Seconds -> Bool
(Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool) -> Eq Seconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seconds -> Seconds -> Bool
$c/= :: Seconds -> Seconds -> Bool
== :: Seconds -> Seconds -> Bool
$c== :: Seconds -> Seconds -> Bool
Eq, Eq Seconds
Eq Seconds
-> (Seconds -> Seconds -> Ordering)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> Ord Seconds
Seconds -> Seconds -> Bool
Seconds -> Seconds -> Ordering
Seconds -> Seconds -> Seconds
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Seconds -> Seconds -> Seconds
$cmin :: Seconds -> Seconds -> Seconds
max :: Seconds -> Seconds -> Seconds
$cmax :: Seconds -> Seconds -> Seconds
>= :: Seconds -> Seconds -> Bool
$c>= :: Seconds -> Seconds -> Bool
> :: Seconds -> Seconds -> Bool
$c> :: Seconds -> Seconds -> Bool
<= :: Seconds -> Seconds -> Bool
$c<= :: Seconds -> Seconds -> Bool
< :: Seconds -> Seconds -> Bool
$c< :: Seconds -> Seconds -> Bool
compare :: Seconds -> Seconds -> Ordering
$ccompare :: Seconds -> Seconds -> Ordering
$cp1Ord :: Eq Seconds
Ord, [Seconds] -> Value
[Seconds] -> Encoding
Seconds -> Value
Seconds -> Encoding
(Seconds -> Value)
-> (Seconds -> Encoding)
-> ([Seconds] -> Value)
-> ([Seconds] -> Encoding)
-> ToJSON Seconds
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Seconds] -> Encoding
$ctoEncodingList :: [Seconds] -> Encoding
toJSONList :: [Seconds] -> Value
$ctoJSONList :: [Seconds] -> Value
toEncoding :: Seconds -> Encoding
$ctoEncoding :: Seconds -> Encoding
toJSON :: Seconds -> Value
$ctoJSON :: Seconds -> Value
ToJSON, Value -> Parser [Seconds]
Value -> Parser Seconds
(Value -> Parser Seconds)
-> (Value -> Parser [Seconds]) -> FromJSON Seconds
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Seconds]
$cparseJSONList :: Value -> Parser [Seconds]
parseJSON :: Value -> Parser Seconds
$cparseJSON :: Value -> Parser Seconds
FromJSON)
  deriving (ReadPrec [Seconds]
ReadPrec Seconds
Int -> ReadS Seconds
ReadS [Seconds]
(Int -> ReadS Seconds)
-> ReadS [Seconds]
-> ReadPrec Seconds
-> ReadPrec [Seconds]
-> Read Seconds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Seconds]
$creadListPrec :: ReadPrec [Seconds]
readPrec :: ReadPrec Seconds
$creadPrec :: ReadPrec Seconds
readList :: ReadS [Seconds]
$creadList :: ReadS [Seconds]
readsPrec :: Int -> ReadS Seconds
$creadsPrec :: Int -> ReadS Seconds
Read, Integer -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
(Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Integer -> Seconds)
-> Num Seconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Seconds
$cfromInteger :: Integer -> Seconds
signum :: Seconds -> Seconds
$csignum :: Seconds -> Seconds
abs :: Seconds -> Seconds
$cabs :: Seconds -> Seconds
negate :: Seconds -> Seconds
$cnegate :: Seconds -> Seconds
* :: Seconds -> Seconds -> Seconds
$c* :: Seconds -> Seconds -> Seconds
- :: Seconds -> Seconds -> Seconds
$c- :: Seconds -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c+ :: Seconds -> Seconds -> Seconds
Num, Num Seconds
Num Seconds
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Rational -> Seconds)
-> Fractional Seconds
Rational -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Seconds
$cfromRational :: Rational -> Seconds
recip :: Seconds -> Seconds
$crecip :: Seconds -> Seconds
/ :: Seconds -> Seconds -> Seconds
$c/ :: Seconds -> Seconds -> Seconds
$cp1Fractional :: Num Seconds
Fractional, Num Seconds
Ord Seconds
Num Seconds -> Ord Seconds -> (Seconds -> Rational) -> Real Seconds
Seconds -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Seconds -> Rational
$ctoRational :: Seconds -> Rational
$cp2Real :: Ord Seconds
$cp1Real :: Num Seconds
Real, Int -> Seconds -> Int
Seconds -> Int
(Int -> Seconds -> Int) -> (Seconds -> Int) -> Hashable Seconds
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Seconds -> Int
$chash :: Seconds -> Int
hashWithSalt :: Int -> Seconds -> Int
$chashWithSalt :: Int -> Seconds -> Int
Hashable, Fractional Seconds
Real Seconds
Real Seconds
-> Fractional Seconds
-> (forall b. Integral b => Seconds -> (b, Seconds))
-> (forall b. Integral b => Seconds -> b)
-> (forall b. Integral b => Seconds -> b)
-> (forall b. Integral b => Seconds -> b)
-> (forall b. Integral b => Seconds -> b)
-> RealFrac Seconds
Seconds -> b
Seconds -> b
Seconds -> b
Seconds -> b
Seconds -> (b, Seconds)
forall b. Integral b => Seconds -> b
forall b. Integral b => Seconds -> (b, Seconds)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Seconds -> b
$cfloor :: forall b. Integral b => Seconds -> b
ceiling :: Seconds -> b
$cceiling :: forall b. Integral b => Seconds -> b
round :: Seconds -> b
$cround :: forall b. Integral b => Seconds -> b
truncate :: Seconds -> b
$ctruncate :: forall b. Integral b => Seconds -> b
properFraction :: Seconds -> (b, Seconds)
$cproperFraction :: forall b. Integral b => Seconds -> (b, Seconds)
$cp2RealFrac :: Fractional Seconds
$cp1RealFrac :: Real Seconds
RealFrac) via (TimeUnit (SecondsP 1))

-- TODO if needed: deriving (ToJSON, FromJSON) via (TimeUnit ..) making sure
--      to copy Aeson instances (with withBoundedScientific), and e.g.
--         toJSON (5 :: Minutes) == Number 5
newtype Days = Days {Days -> DiffTime
days :: DiffTime}
  deriving (DiffTime -> Days
Days -> DiffTime
(DiffTime -> Days) -> (Days -> DiffTime) -> Duration Days
forall d. (DiffTime -> d) -> (d -> DiffTime) -> Duration d
toDiffTime :: Days -> DiffTime
$ctoDiffTime :: Days -> DiffTime
fromDiffTime :: DiffTime -> Days
$cfromDiffTime :: DiffTime -> Days
Duration, Int -> Days -> ShowS
[Days] -> ShowS
Days -> String
(Int -> Days -> ShowS)
-> (Days -> String) -> ([Days] -> ShowS) -> Show Days
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Days] -> ShowS
$cshowList :: [Days] -> ShowS
show :: Days -> String
$cshow :: Days -> String
showsPrec :: Int -> Days -> ShowS
$cshowsPrec :: Int -> Days -> ShowS
Show, Days -> Days -> Bool
(Days -> Days -> Bool) -> (Days -> Days -> Bool) -> Eq Days
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Days -> Days -> Bool
$c/= :: Days -> Days -> Bool
== :: Days -> Days -> Bool
$c== :: Days -> Days -> Bool
Eq, Eq Days
Eq Days
-> (Days -> Days -> Ordering)
-> (Days -> Days -> Bool)
-> (Days -> Days -> Bool)
-> (Days -> Days -> Bool)
-> (Days -> Days -> Bool)
-> (Days -> Days -> Days)
-> (Days -> Days -> Days)
-> Ord Days
Days -> Days -> Bool
Days -> Days -> Ordering
Days -> Days -> Days
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Days -> Days -> Days
$cmin :: Days -> Days -> Days
max :: Days -> Days -> Days
$cmax :: Days -> Days -> Days
>= :: Days -> Days -> Bool
$c>= :: Days -> Days -> Bool
> :: Days -> Days -> Bool
$c> :: Days -> Days -> Bool
<= :: Days -> Days -> Bool
$c<= :: Days -> Days -> Bool
< :: Days -> Days -> Bool
$c< :: Days -> Days -> Bool
compare :: Days -> Days -> Ordering
$ccompare :: Days -> Days -> Ordering
$cp1Ord :: Eq Days
Ord)
  deriving (ReadPrec [Days]
ReadPrec Days
Int -> ReadS Days
ReadS [Days]
(Int -> ReadS Days)
-> ReadS [Days] -> ReadPrec Days -> ReadPrec [Days] -> Read Days
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Days]
$creadListPrec :: ReadPrec [Days]
readPrec :: ReadPrec Days
$creadPrec :: ReadPrec Days
readList :: ReadS [Days]
$creadList :: ReadS [Days]
readsPrec :: Int -> ReadS Days
$creadsPrec :: Int -> ReadS Days
Read, Integer -> Days
Days -> Days
Days -> Days -> Days
(Days -> Days -> Days)
-> (Days -> Days -> Days)
-> (Days -> Days -> Days)
-> (Days -> Days)
-> (Days -> Days)
-> (Days -> Days)
-> (Integer -> Days)
-> Num Days
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Days
$cfromInteger :: Integer -> Days
signum :: Days -> Days
$csignum :: Days -> Days
abs :: Days -> Days
$cabs :: Days -> Days
negate :: Days -> Days
$cnegate :: Days -> Days
* :: Days -> Days -> Days
$c* :: Days -> Days -> Days
- :: Days -> Days -> Days
$c- :: Days -> Days -> Days
+ :: Days -> Days -> Days
$c+ :: Days -> Days -> Days
Num, Num Days
Num Days
-> (Days -> Days -> Days)
-> (Days -> Days)
-> (Rational -> Days)
-> Fractional Days
Rational -> Days
Days -> Days
Days -> Days -> Days
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Days
$cfromRational :: Rational -> Days
recip :: Days -> Days
$crecip :: Days -> Days
/ :: Days -> Days -> Days
$c/ :: Days -> Days -> Days
$cp1Fractional :: Num Days
Fractional, Num Days
Ord Days
Num Days -> Ord Days -> (Days -> Rational) -> Real Days
Days -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Days -> Rational
$ctoRational :: Days -> Rational
$cp2Real :: Ord Days
$cp1Real :: Num Days
Real, Int -> Days -> Int
Days -> Int
(Int -> Days -> Int) -> (Days -> Int) -> Hashable Days
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Days -> Int
$chash :: Days -> Int
hashWithSalt :: Int -> Days -> Int
$chashWithSalt :: Int -> Days -> Int
Hashable, Fractional Days
Real Days
Real Days
-> Fractional Days
-> (forall b. Integral b => Days -> (b, Days))
-> (forall b. Integral b => Days -> b)
-> (forall b. Integral b => Days -> b)
-> (forall b. Integral b => Days -> b)
-> (forall b. Integral b => Days -> b)
-> RealFrac Days
Days -> b
Days -> b
Days -> b
Days -> b
Days -> (b, Days)
forall b. Integral b => Days -> b
forall b. Integral b => Days -> (b, Days)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Days -> b
$cfloor :: forall b. Integral b => Days -> b
ceiling :: Days -> b
$cceiling :: forall b. Integral b => Days -> b
round :: Days -> b
$cround :: forall b. Integral b => Days -> b
truncate :: Days -> b
$ctruncate :: forall b. Integral b => Days -> b
properFraction :: Days -> (b, Days)
$cproperFraction :: forall b. Integral b => Days -> (b, Days)
$cp2RealFrac :: Fractional Days
$cp1RealFrac :: Real Days
RealFrac) via (TimeUnit (SecondsP 86400))

newtype Hours = Hours {Hours -> DiffTime
hours :: DiffTime}
  deriving (DiffTime -> Hours
Hours -> DiffTime
(DiffTime -> Hours) -> (Hours -> DiffTime) -> Duration Hours
forall d. (DiffTime -> d) -> (d -> DiffTime) -> Duration d
toDiffTime :: Hours -> DiffTime
$ctoDiffTime :: Hours -> DiffTime
fromDiffTime :: DiffTime -> Hours
$cfromDiffTime :: DiffTime -> Hours
Duration, Int -> Hours -> ShowS
[Hours] -> ShowS
Hours -> String
(Int -> Hours -> ShowS)
-> (Hours -> String) -> ([Hours] -> ShowS) -> Show Hours
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hours] -> ShowS
$cshowList :: [Hours] -> ShowS
show :: Hours -> String
$cshow :: Hours -> String
showsPrec :: Int -> Hours -> ShowS
$cshowsPrec :: Int -> Hours -> ShowS
Show, Hours -> Hours -> Bool
(Hours -> Hours -> Bool) -> (Hours -> Hours -> Bool) -> Eq Hours
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hours -> Hours -> Bool
$c/= :: Hours -> Hours -> Bool
== :: Hours -> Hours -> Bool
$c== :: Hours -> Hours -> Bool
Eq, Eq Hours
Eq Hours
-> (Hours -> Hours -> Ordering)
-> (Hours -> Hours -> Bool)
-> (Hours -> Hours -> Bool)
-> (Hours -> Hours -> Bool)
-> (Hours -> Hours -> Bool)
-> (Hours -> Hours -> Hours)
-> (Hours -> Hours -> Hours)
-> Ord Hours
Hours -> Hours -> Bool
Hours -> Hours -> Ordering
Hours -> Hours -> Hours
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hours -> Hours -> Hours
$cmin :: Hours -> Hours -> Hours
max :: Hours -> Hours -> Hours
$cmax :: Hours -> Hours -> Hours
>= :: Hours -> Hours -> Bool
$c>= :: Hours -> Hours -> Bool
> :: Hours -> Hours -> Bool
$c> :: Hours -> Hours -> Bool
<= :: Hours -> Hours -> Bool
$c<= :: Hours -> Hours -> Bool
< :: Hours -> Hours -> Bool
$c< :: Hours -> Hours -> Bool
compare :: Hours -> Hours -> Ordering
$ccompare :: Hours -> Hours -> Ordering
$cp1Ord :: Eq Hours
Ord)
  deriving (ReadPrec [Hours]
ReadPrec Hours
Int -> ReadS Hours
ReadS [Hours]
(Int -> ReadS Hours)
-> ReadS [Hours]
-> ReadPrec Hours
-> ReadPrec [Hours]
-> Read Hours
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Hours]
$creadListPrec :: ReadPrec [Hours]
readPrec :: ReadPrec Hours
$creadPrec :: ReadPrec Hours
readList :: ReadS [Hours]
$creadList :: ReadS [Hours]
readsPrec :: Int -> ReadS Hours
$creadsPrec :: Int -> ReadS Hours
Read, Integer -> Hours
Hours -> Hours
Hours -> Hours -> Hours
(Hours -> Hours -> Hours)
-> (Hours -> Hours -> Hours)
-> (Hours -> Hours -> Hours)
-> (Hours -> Hours)
-> (Hours -> Hours)
-> (Hours -> Hours)
-> (Integer -> Hours)
-> Num Hours
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Hours
$cfromInteger :: Integer -> Hours
signum :: Hours -> Hours
$csignum :: Hours -> Hours
abs :: Hours -> Hours
$cabs :: Hours -> Hours
negate :: Hours -> Hours
$cnegate :: Hours -> Hours
* :: Hours -> Hours -> Hours
$c* :: Hours -> Hours -> Hours
- :: Hours -> Hours -> Hours
$c- :: Hours -> Hours -> Hours
+ :: Hours -> Hours -> Hours
$c+ :: Hours -> Hours -> Hours
Num, Num Hours
Num Hours
-> (Hours -> Hours -> Hours)
-> (Hours -> Hours)
-> (Rational -> Hours)
-> Fractional Hours
Rational -> Hours
Hours -> Hours
Hours -> Hours -> Hours
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Hours
$cfromRational :: Rational -> Hours
recip :: Hours -> Hours
$crecip :: Hours -> Hours
/ :: Hours -> Hours -> Hours
$c/ :: Hours -> Hours -> Hours
$cp1Fractional :: Num Hours
Fractional, Num Hours
Ord Hours
Num Hours -> Ord Hours -> (Hours -> Rational) -> Real Hours
Hours -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Hours -> Rational
$ctoRational :: Hours -> Rational
$cp2Real :: Ord Hours
$cp1Real :: Num Hours
Real, Int -> Hours -> Int
Hours -> Int
(Int -> Hours -> Int) -> (Hours -> Int) -> Hashable Hours
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Hours -> Int
$chash :: Hours -> Int
hashWithSalt :: Int -> Hours -> Int
$chashWithSalt :: Int -> Hours -> Int
Hashable, Fractional Hours
Real Hours
Real Hours
-> Fractional Hours
-> (forall b. Integral b => Hours -> (b, Hours))
-> (forall b. Integral b => Hours -> b)
-> (forall b. Integral b => Hours -> b)
-> (forall b. Integral b => Hours -> b)
-> (forall b. Integral b => Hours -> b)
-> RealFrac Hours
Hours -> b
Hours -> b
Hours -> b
Hours -> b
Hours -> (b, Hours)
forall b. Integral b => Hours -> b
forall b. Integral b => Hours -> (b, Hours)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Hours -> b
$cfloor :: forall b. Integral b => Hours -> b
ceiling :: Hours -> b
$cceiling :: forall b. Integral b => Hours -> b
round :: Hours -> b
$cround :: forall b. Integral b => Hours -> b
truncate :: Hours -> b
$ctruncate :: forall b. Integral b => Hours -> b
properFraction :: Hours -> (b, Hours)
$cproperFraction :: forall b. Integral b => Hours -> (b, Hours)
$cp2RealFrac :: Fractional Hours
$cp1RealFrac :: Real Hours
RealFrac) via (TimeUnit (SecondsP 3600))

newtype Minutes = Minutes {Minutes -> DiffTime
minutes :: DiffTime}
  deriving (DiffTime -> Minutes
Minutes -> DiffTime
(DiffTime -> Minutes) -> (Minutes -> DiffTime) -> Duration Minutes
forall d. (DiffTime -> d) -> (d -> DiffTime) -> Duration d
toDiffTime :: Minutes -> DiffTime
$ctoDiffTime :: Minutes -> DiffTime
fromDiffTime :: DiffTime -> Minutes
$cfromDiffTime :: DiffTime -> Minutes
Duration, Int -> Minutes -> ShowS
[Minutes] -> ShowS
Minutes -> String
(Int -> Minutes -> ShowS)
-> (Minutes -> String) -> ([Minutes] -> ShowS) -> Show Minutes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Minutes] -> ShowS
$cshowList :: [Minutes] -> ShowS
show :: Minutes -> String
$cshow :: Minutes -> String
showsPrec :: Int -> Minutes -> ShowS
$cshowsPrec :: Int -> Minutes -> ShowS
Show, Minutes -> Minutes -> Bool
(Minutes -> Minutes -> Bool)
-> (Minutes -> Minutes -> Bool) -> Eq Minutes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Minutes -> Minutes -> Bool
$c/= :: Minutes -> Minutes -> Bool
== :: Minutes -> Minutes -> Bool
$c== :: Minutes -> Minutes -> Bool
Eq, Eq Minutes
Eq Minutes
-> (Minutes -> Minutes -> Ordering)
-> (Minutes -> Minutes -> Bool)
-> (Minutes -> Minutes -> Bool)
-> (Minutes -> Minutes -> Bool)
-> (Minutes -> Minutes -> Bool)
-> (Minutes -> Minutes -> Minutes)
-> (Minutes -> Minutes -> Minutes)
-> Ord Minutes
Minutes -> Minutes -> Bool
Minutes -> Minutes -> Ordering
Minutes -> Minutes -> Minutes
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Minutes -> Minutes -> Minutes
$cmin :: Minutes -> Minutes -> Minutes
max :: Minutes -> Minutes -> Minutes
$cmax :: Minutes -> Minutes -> Minutes
>= :: Minutes -> Minutes -> Bool
$c>= :: Minutes -> Minutes -> Bool
> :: Minutes -> Minutes -> Bool
$c> :: Minutes -> Minutes -> Bool
<= :: Minutes -> Minutes -> Bool
$c<= :: Minutes -> Minutes -> Bool
< :: Minutes -> Minutes -> Bool
$c< :: Minutes -> Minutes -> Bool
compare :: Minutes -> Minutes -> Ordering
$ccompare :: Minutes -> Minutes -> Ordering
$cp1Ord :: Eq Minutes
Ord)
  deriving (ReadPrec [Minutes]
ReadPrec Minutes
Int -> ReadS Minutes
ReadS [Minutes]
(Int -> ReadS Minutes)
-> ReadS [Minutes]
-> ReadPrec Minutes
-> ReadPrec [Minutes]
-> Read Minutes
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Minutes]
$creadListPrec :: ReadPrec [Minutes]
readPrec :: ReadPrec Minutes
$creadPrec :: ReadPrec Minutes
readList :: ReadS [Minutes]
$creadList :: ReadS [Minutes]
readsPrec :: Int -> ReadS Minutes
$creadsPrec :: Int -> ReadS Minutes
Read, Integer -> Minutes
Minutes -> Minutes
Minutes -> Minutes -> Minutes
(Minutes -> Minutes -> Minutes)
-> (Minutes -> Minutes -> Minutes)
-> (Minutes -> Minutes -> Minutes)
-> (Minutes -> Minutes)
-> (Minutes -> Minutes)
-> (Minutes -> Minutes)
-> (Integer -> Minutes)
-> Num Minutes
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Minutes
$cfromInteger :: Integer -> Minutes
signum :: Minutes -> Minutes
$csignum :: Minutes -> Minutes
abs :: Minutes -> Minutes
$cabs :: Minutes -> Minutes
negate :: Minutes -> Minutes
$cnegate :: Minutes -> Minutes
* :: Minutes -> Minutes -> Minutes
$c* :: Minutes -> Minutes -> Minutes
- :: Minutes -> Minutes -> Minutes
$c- :: Minutes -> Minutes -> Minutes
+ :: Minutes -> Minutes -> Minutes
$c+ :: Minutes -> Minutes -> Minutes
Num, Num Minutes
Num Minutes
-> (Minutes -> Minutes -> Minutes)
-> (Minutes -> Minutes)
-> (Rational -> Minutes)
-> Fractional Minutes
Rational -> Minutes
Minutes -> Minutes
Minutes -> Minutes -> Minutes
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Minutes
$cfromRational :: Rational -> Minutes
recip :: Minutes -> Minutes
$crecip :: Minutes -> Minutes
/ :: Minutes -> Minutes -> Minutes
$c/ :: Minutes -> Minutes -> Minutes
$cp1Fractional :: Num Minutes
Fractional, Num Minutes
Ord Minutes
Num Minutes -> Ord Minutes -> (Minutes -> Rational) -> Real Minutes
Minutes -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Minutes -> Rational
$ctoRational :: Minutes -> Rational
$cp2Real :: Ord Minutes
$cp1Real :: Num Minutes
Real, Int -> Minutes -> Int
Minutes -> Int
(Int -> Minutes -> Int) -> (Minutes -> Int) -> Hashable Minutes
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Minutes -> Int
$chash :: Minutes -> Int
hashWithSalt :: Int -> Minutes -> Int
$chashWithSalt :: Int -> Minutes -> Int
Hashable, Fractional Minutes
Real Minutes
Real Minutes
-> Fractional Minutes
-> (forall b. Integral b => Minutes -> (b, Minutes))
-> (forall b. Integral b => Minutes -> b)
-> (forall b. Integral b => Minutes -> b)
-> (forall b. Integral b => Minutes -> b)
-> (forall b. Integral b => Minutes -> b)
-> RealFrac Minutes
Minutes -> b
Minutes -> b
Minutes -> b
Minutes -> b
Minutes -> (b, Minutes)
forall b. Integral b => Minutes -> b
forall b. Integral b => Minutes -> (b, Minutes)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Minutes -> b
$cfloor :: forall b. Integral b => Minutes -> b
ceiling :: Minutes -> b
$cceiling :: forall b. Integral b => Minutes -> b
round :: Minutes -> b
$cround :: forall b. Integral b => Minutes -> b
truncate :: Minutes -> b
$ctruncate :: forall b. Integral b => Minutes -> b
properFraction :: Minutes -> (b, Minutes)
$cproperFraction :: forall b. Integral b => Minutes -> (b, Minutes)
$cp2RealFrac :: Fractional Minutes
$cp1RealFrac :: Real Minutes
RealFrac) via (TimeUnit (SecondsP 60))

newtype Milliseconds = Milliseconds {Milliseconds -> DiffTime
milliseconds :: DiffTime}
  deriving (DiffTime -> Milliseconds
Milliseconds -> DiffTime
(DiffTime -> Milliseconds)
-> (Milliseconds -> DiffTime) -> Duration Milliseconds
forall d. (DiffTime -> d) -> (d -> DiffTime) -> Duration d
toDiffTime :: Milliseconds -> DiffTime
$ctoDiffTime :: Milliseconds -> DiffTime
fromDiffTime :: DiffTime -> Milliseconds
$cfromDiffTime :: DiffTime -> Milliseconds
Duration, Int -> Milliseconds -> ShowS
[Milliseconds] -> ShowS
Milliseconds -> String
(Int -> Milliseconds -> ShowS)
-> (Milliseconds -> String)
-> ([Milliseconds] -> ShowS)
-> Show Milliseconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Milliseconds] -> ShowS
$cshowList :: [Milliseconds] -> ShowS
show :: Milliseconds -> String
$cshow :: Milliseconds -> String
showsPrec :: Int -> Milliseconds -> ShowS
$cshowsPrec :: Int -> Milliseconds -> ShowS
Show, Milliseconds -> Milliseconds -> Bool
(Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Bool) -> Eq Milliseconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Milliseconds -> Milliseconds -> Bool
$c/= :: Milliseconds -> Milliseconds -> Bool
== :: Milliseconds -> Milliseconds -> Bool
$c== :: Milliseconds -> Milliseconds -> Bool
Eq, Eq Milliseconds
Eq Milliseconds
-> (Milliseconds -> Milliseconds -> Ordering)
-> (Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> Ord Milliseconds
Milliseconds -> Milliseconds -> Bool
Milliseconds -> Milliseconds -> Ordering
Milliseconds -> Milliseconds -> Milliseconds
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Milliseconds -> Milliseconds -> Milliseconds
$cmin :: Milliseconds -> Milliseconds -> Milliseconds
max :: Milliseconds -> Milliseconds -> Milliseconds
$cmax :: Milliseconds -> Milliseconds -> Milliseconds
>= :: Milliseconds -> Milliseconds -> Bool
$c>= :: Milliseconds -> Milliseconds -> Bool
> :: Milliseconds -> Milliseconds -> Bool
$c> :: Milliseconds -> Milliseconds -> Bool
<= :: Milliseconds -> Milliseconds -> Bool
$c<= :: Milliseconds -> Milliseconds -> Bool
< :: Milliseconds -> Milliseconds -> Bool
$c< :: Milliseconds -> Milliseconds -> Bool
compare :: Milliseconds -> Milliseconds -> Ordering
$ccompare :: Milliseconds -> Milliseconds -> Ordering
$cp1Ord :: Eq Milliseconds
Ord)
  deriving (ReadPrec [Milliseconds]
ReadPrec Milliseconds
Int -> ReadS Milliseconds
ReadS [Milliseconds]
(Int -> ReadS Milliseconds)
-> ReadS [Milliseconds]
-> ReadPrec Milliseconds
-> ReadPrec [Milliseconds]
-> Read Milliseconds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Milliseconds]
$creadListPrec :: ReadPrec [Milliseconds]
readPrec :: ReadPrec Milliseconds
$creadPrec :: ReadPrec Milliseconds
readList :: ReadS [Milliseconds]
$creadList :: ReadS [Milliseconds]
readsPrec :: Int -> ReadS Milliseconds
$creadsPrec :: Int -> ReadS Milliseconds
Read, Integer -> Milliseconds
Milliseconds -> Milliseconds
Milliseconds -> Milliseconds -> Milliseconds
(Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Integer -> Milliseconds)
-> Num Milliseconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Milliseconds
$cfromInteger :: Integer -> Milliseconds
signum :: Milliseconds -> Milliseconds
$csignum :: Milliseconds -> Milliseconds
abs :: Milliseconds -> Milliseconds
$cabs :: Milliseconds -> Milliseconds
negate :: Milliseconds -> Milliseconds
$cnegate :: Milliseconds -> Milliseconds
* :: Milliseconds -> Milliseconds -> Milliseconds
$c* :: Milliseconds -> Milliseconds -> Milliseconds
- :: Milliseconds -> Milliseconds -> Milliseconds
$c- :: Milliseconds -> Milliseconds -> Milliseconds
+ :: Milliseconds -> Milliseconds -> Milliseconds
$c+ :: Milliseconds -> Milliseconds -> Milliseconds
Num, Num Milliseconds
Num Milliseconds
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Rational -> Milliseconds)
-> Fractional Milliseconds
Rational -> Milliseconds
Milliseconds -> Milliseconds
Milliseconds -> Milliseconds -> Milliseconds
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Milliseconds
$cfromRational :: Rational -> Milliseconds
recip :: Milliseconds -> Milliseconds
$crecip :: Milliseconds -> Milliseconds
/ :: Milliseconds -> Milliseconds -> Milliseconds
$c/ :: Milliseconds -> Milliseconds -> Milliseconds
$cp1Fractional :: Num Milliseconds
Fractional, Num Milliseconds
Ord Milliseconds
Num Milliseconds
-> Ord Milliseconds
-> (Milliseconds -> Rational)
-> Real Milliseconds
Milliseconds -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Milliseconds -> Rational
$ctoRational :: Milliseconds -> Rational
$cp2Real :: Ord Milliseconds
$cp1Real :: Num Milliseconds
Real, Int -> Milliseconds -> Int
Milliseconds -> Int
(Int -> Milliseconds -> Int)
-> (Milliseconds -> Int) -> Hashable Milliseconds
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Milliseconds -> Int
$chash :: Milliseconds -> Int
hashWithSalt :: Int -> Milliseconds -> Int
$chashWithSalt :: Int -> Milliseconds -> Int
Hashable, Fractional Milliseconds
Real Milliseconds
Real Milliseconds
-> Fractional Milliseconds
-> (forall b. Integral b => Milliseconds -> (b, Milliseconds))
-> (forall b. Integral b => Milliseconds -> b)
-> (forall b. Integral b => Milliseconds -> b)
-> (forall b. Integral b => Milliseconds -> b)
-> (forall b. Integral b => Milliseconds -> b)
-> RealFrac Milliseconds
Milliseconds -> b
Milliseconds -> b
Milliseconds -> b
Milliseconds -> b
Milliseconds -> (b, Milliseconds)
forall b. Integral b => Milliseconds -> b
forall b. Integral b => Milliseconds -> (b, Milliseconds)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Milliseconds -> b
$cfloor :: forall b. Integral b => Milliseconds -> b
ceiling :: Milliseconds -> b
$cceiling :: forall b. Integral b => Milliseconds -> b
round :: Milliseconds -> b
$cround :: forall b. Integral b => Milliseconds -> b
truncate :: Milliseconds -> b
$ctruncate :: forall b. Integral b => Milliseconds -> b
properFraction :: Milliseconds -> (b, Milliseconds)
$cproperFraction :: forall b. Integral b => Milliseconds -> (b, Milliseconds)
$cp2RealFrac :: Fractional Milliseconds
$cp1RealFrac :: Real Milliseconds
RealFrac) via (TimeUnit 1000000000)

-- 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 :: Milliseconds -> Value
toJSON = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value)
-> (Milliseconds -> Integer) -> Milliseconds -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
1e9 (Integer -> Integer)
-> (Milliseconds -> Integer) -> Milliseconds -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToPicoseconds (DiffTime -> Integer)
-> (Milliseconds -> DiffTime) -> Milliseconds -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Milliseconds -> DiffTime
milliseconds

instance FromJSON Milliseconds where
  parseJSON :: Value -> Parser Milliseconds
parseJSON Value
v =
    String
-> (Scientific -> Parser Milliseconds)
-> Value
-> Parser Milliseconds
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"Milliseconds Number" (Milliseconds -> Parser Milliseconds
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Milliseconds -> Parser Milliseconds)
-> (Scientific -> Milliseconds)
-> Scientific
-> Parser Milliseconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Milliseconds
Milliseconds (DiffTime -> Milliseconds)
-> (Scientific -> DiffTime) -> Scientific -> Milliseconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DiffTime
picosecondsToDiffTime (Integer -> DiffTime)
-> (Scientific -> Integer) -> Scientific -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1e9) (Integer -> Integer)
-> (Scientific -> Integer) -> Scientific -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling) Value
v
      Parser Milliseconds -> Parser Milliseconds -> Parser Milliseconds
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> (Text -> Parser Milliseconds) -> Value -> Parser Milliseconds
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Milliseconds String" ((String -> Parser Milliseconds)
-> (Milliseconds -> Parser Milliseconds)
-> Either String Milliseconds
-> Parser Milliseconds
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Milliseconds
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Milliseconds)
-> ShowS -> String -> Parser Milliseconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show) Milliseconds -> Parser Milliseconds
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Milliseconds -> Parser Milliseconds)
-> (Text -> Either String Milliseconds)
-> Text
-> Parser Milliseconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Milliseconds
forall a. Read a => String -> Either String a
TR.readEither (String -> Either String Milliseconds)
-> (Text -> String) -> Text -> Either String Milliseconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) Value
v

newtype Microseconds = Microseconds {Microseconds -> DiffTime
microseconds :: DiffTime}
  deriving (DiffTime -> Microseconds
Microseconds -> DiffTime
(DiffTime -> Microseconds)
-> (Microseconds -> DiffTime) -> Duration Microseconds
forall d. (DiffTime -> d) -> (d -> DiffTime) -> Duration d
toDiffTime :: Microseconds -> DiffTime
$ctoDiffTime :: Microseconds -> DiffTime
fromDiffTime :: DiffTime -> Microseconds
$cfromDiffTime :: DiffTime -> Microseconds
Duration, Int -> Microseconds -> ShowS
[Microseconds] -> ShowS
Microseconds -> String
(Int -> Microseconds -> ShowS)
-> (Microseconds -> String)
-> ([Microseconds] -> ShowS)
-> Show Microseconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Microseconds] -> ShowS
$cshowList :: [Microseconds] -> ShowS
show :: Microseconds -> String
$cshow :: Microseconds -> String
showsPrec :: Int -> Microseconds -> ShowS
$cshowsPrec :: Int -> Microseconds -> ShowS
Show, Microseconds -> Microseconds -> Bool
(Microseconds -> Microseconds -> Bool)
-> (Microseconds -> Microseconds -> Bool) -> Eq Microseconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Microseconds -> Microseconds -> Bool
$c/= :: Microseconds -> Microseconds -> Bool
== :: Microseconds -> Microseconds -> Bool
$c== :: Microseconds -> Microseconds -> Bool
Eq, Eq Microseconds
Eq Microseconds
-> (Microseconds -> Microseconds -> Ordering)
-> (Microseconds -> Microseconds -> Bool)
-> (Microseconds -> Microseconds -> Bool)
-> (Microseconds -> Microseconds -> Bool)
-> (Microseconds -> Microseconds -> Bool)
-> (Microseconds -> Microseconds -> Microseconds)
-> (Microseconds -> Microseconds -> Microseconds)
-> Ord Microseconds
Microseconds -> Microseconds -> Bool
Microseconds -> Microseconds -> Ordering
Microseconds -> Microseconds -> Microseconds
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Microseconds -> Microseconds -> Microseconds
$cmin :: Microseconds -> Microseconds -> Microseconds
max :: Microseconds -> Microseconds -> Microseconds
$cmax :: Microseconds -> Microseconds -> Microseconds
>= :: Microseconds -> Microseconds -> Bool
$c>= :: Microseconds -> Microseconds -> Bool
> :: Microseconds -> Microseconds -> Bool
$c> :: Microseconds -> Microseconds -> Bool
<= :: Microseconds -> Microseconds -> Bool
$c<= :: Microseconds -> Microseconds -> Bool
< :: Microseconds -> Microseconds -> Bool
$c< :: Microseconds -> Microseconds -> Bool
compare :: Microseconds -> Microseconds -> Ordering
$ccompare :: Microseconds -> Microseconds -> Ordering
$cp1Ord :: Eq Microseconds
Ord)
  deriving (ReadPrec [Microseconds]
ReadPrec Microseconds
Int -> ReadS Microseconds
ReadS [Microseconds]
(Int -> ReadS Microseconds)
-> ReadS [Microseconds]
-> ReadPrec Microseconds
-> ReadPrec [Microseconds]
-> Read Microseconds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Microseconds]
$creadListPrec :: ReadPrec [Microseconds]
readPrec :: ReadPrec Microseconds
$creadPrec :: ReadPrec Microseconds
readList :: ReadS [Microseconds]
$creadList :: ReadS [Microseconds]
readsPrec :: Int -> ReadS Microseconds
$creadsPrec :: Int -> ReadS Microseconds
Read, Integer -> Microseconds
Microseconds -> Microseconds
Microseconds -> Microseconds -> Microseconds
(Microseconds -> Microseconds -> Microseconds)
-> (Microseconds -> Microseconds -> Microseconds)
-> (Microseconds -> Microseconds -> Microseconds)
-> (Microseconds -> Microseconds)
-> (Microseconds -> Microseconds)
-> (Microseconds -> Microseconds)
-> (Integer -> Microseconds)
-> Num Microseconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Microseconds
$cfromInteger :: Integer -> Microseconds
signum :: Microseconds -> Microseconds
$csignum :: Microseconds -> Microseconds
abs :: Microseconds -> Microseconds
$cabs :: Microseconds -> Microseconds
negate :: Microseconds -> Microseconds
$cnegate :: Microseconds -> Microseconds
* :: Microseconds -> Microseconds -> Microseconds
$c* :: Microseconds -> Microseconds -> Microseconds
- :: Microseconds -> Microseconds -> Microseconds
$c- :: Microseconds -> Microseconds -> Microseconds
+ :: Microseconds -> Microseconds -> Microseconds
$c+ :: Microseconds -> Microseconds -> Microseconds
Num, Num Microseconds
Num Microseconds
-> (Microseconds -> Microseconds -> Microseconds)
-> (Microseconds -> Microseconds)
-> (Rational -> Microseconds)
-> Fractional Microseconds
Rational -> Microseconds
Microseconds -> Microseconds
Microseconds -> Microseconds -> Microseconds
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Microseconds
$cfromRational :: Rational -> Microseconds
recip :: Microseconds -> Microseconds
$crecip :: Microseconds -> Microseconds
/ :: Microseconds -> Microseconds -> Microseconds
$c/ :: Microseconds -> Microseconds -> Microseconds
$cp1Fractional :: Num Microseconds
Fractional, Num Microseconds
Ord Microseconds
Num Microseconds
-> Ord Microseconds
-> (Microseconds -> Rational)
-> Real Microseconds
Microseconds -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Microseconds -> Rational
$ctoRational :: Microseconds -> Rational
$cp2Real :: Ord Microseconds
$cp1Real :: Num Microseconds
Real, Int -> Microseconds -> Int
Microseconds -> Int
(Int -> Microseconds -> Int)
-> (Microseconds -> Int) -> Hashable Microseconds
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Microseconds -> Int
$chash :: Microseconds -> Int
hashWithSalt :: Int -> Microseconds -> Int
$chashWithSalt :: Int -> Microseconds -> Int
Hashable, Fractional Microseconds
Real Microseconds
Real Microseconds
-> Fractional Microseconds
-> (forall b. Integral b => Microseconds -> (b, Microseconds))
-> (forall b. Integral b => Microseconds -> b)
-> (forall b. Integral b => Microseconds -> b)
-> (forall b. Integral b => Microseconds -> b)
-> (forall b. Integral b => Microseconds -> b)
-> RealFrac Microseconds
Microseconds -> b
Microseconds -> b
Microseconds -> b
Microseconds -> b
Microseconds -> (b, Microseconds)
forall b. Integral b => Microseconds -> b
forall b. Integral b => Microseconds -> (b, Microseconds)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Microseconds -> b
$cfloor :: forall b. Integral b => Microseconds -> b
ceiling :: Microseconds -> b
$cceiling :: forall b. Integral b => Microseconds -> b
round :: Microseconds -> b
$cround :: forall b. Integral b => Microseconds -> b
truncate :: Microseconds -> b
$ctruncate :: forall b. Integral b => Microseconds -> b
properFraction :: Microseconds -> (b, Microseconds)
$cproperFraction :: forall b. Integral b => Microseconds -> (b, Microseconds)
$cp2RealFrac :: Fractional Microseconds
$cp1RealFrac :: Real Microseconds
RealFrac) via (TimeUnit 1000000)

newtype Nanoseconds = Nanoseconds {Nanoseconds -> DiffTime
nanoseconds :: DiffTime}
  deriving (DiffTime -> Nanoseconds
Nanoseconds -> DiffTime
(DiffTime -> Nanoseconds)
-> (Nanoseconds -> DiffTime) -> Duration Nanoseconds
forall d. (DiffTime -> d) -> (d -> DiffTime) -> Duration d
toDiffTime :: Nanoseconds -> DiffTime
$ctoDiffTime :: Nanoseconds -> DiffTime
fromDiffTime :: DiffTime -> Nanoseconds
$cfromDiffTime :: DiffTime -> Nanoseconds
Duration, Int -> Nanoseconds -> ShowS
[Nanoseconds] -> ShowS
Nanoseconds -> String
(Int -> Nanoseconds -> ShowS)
-> (Nanoseconds -> String)
-> ([Nanoseconds] -> ShowS)
-> Show Nanoseconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nanoseconds] -> ShowS
$cshowList :: [Nanoseconds] -> ShowS
show :: Nanoseconds -> String
$cshow :: Nanoseconds -> String
showsPrec :: Int -> Nanoseconds -> ShowS
$cshowsPrec :: Int -> Nanoseconds -> ShowS
Show, Nanoseconds -> Nanoseconds -> Bool
(Nanoseconds -> Nanoseconds -> Bool)
-> (Nanoseconds -> Nanoseconds -> Bool) -> Eq Nanoseconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nanoseconds -> Nanoseconds -> Bool
$c/= :: Nanoseconds -> Nanoseconds -> Bool
== :: Nanoseconds -> Nanoseconds -> Bool
$c== :: Nanoseconds -> Nanoseconds -> Bool
Eq, Eq Nanoseconds
Eq Nanoseconds
-> (Nanoseconds -> Nanoseconds -> Ordering)
-> (Nanoseconds -> Nanoseconds -> Bool)
-> (Nanoseconds -> Nanoseconds -> Bool)
-> (Nanoseconds -> Nanoseconds -> Bool)
-> (Nanoseconds -> Nanoseconds -> Bool)
-> (Nanoseconds -> Nanoseconds -> Nanoseconds)
-> (Nanoseconds -> Nanoseconds -> Nanoseconds)
-> Ord Nanoseconds
Nanoseconds -> Nanoseconds -> Bool
Nanoseconds -> Nanoseconds -> Ordering
Nanoseconds -> Nanoseconds -> Nanoseconds
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Nanoseconds -> Nanoseconds -> Nanoseconds
$cmin :: Nanoseconds -> Nanoseconds -> Nanoseconds
max :: Nanoseconds -> Nanoseconds -> Nanoseconds
$cmax :: Nanoseconds -> Nanoseconds -> Nanoseconds
>= :: Nanoseconds -> Nanoseconds -> Bool
$c>= :: Nanoseconds -> Nanoseconds -> Bool
> :: Nanoseconds -> Nanoseconds -> Bool
$c> :: Nanoseconds -> Nanoseconds -> Bool
<= :: Nanoseconds -> Nanoseconds -> Bool
$c<= :: Nanoseconds -> Nanoseconds -> Bool
< :: Nanoseconds -> Nanoseconds -> Bool
$c< :: Nanoseconds -> Nanoseconds -> Bool
compare :: Nanoseconds -> Nanoseconds -> Ordering
$ccompare :: Nanoseconds -> Nanoseconds -> Ordering
$cp1Ord :: Eq Nanoseconds
Ord)
  deriving (ReadPrec [Nanoseconds]
ReadPrec Nanoseconds
Int -> ReadS Nanoseconds
ReadS [Nanoseconds]
(Int -> ReadS Nanoseconds)
-> ReadS [Nanoseconds]
-> ReadPrec Nanoseconds
-> ReadPrec [Nanoseconds]
-> Read Nanoseconds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Nanoseconds]
$creadListPrec :: ReadPrec [Nanoseconds]
readPrec :: ReadPrec Nanoseconds
$creadPrec :: ReadPrec Nanoseconds
readList :: ReadS [Nanoseconds]
$creadList :: ReadS [Nanoseconds]
readsPrec :: Int -> ReadS Nanoseconds
$creadsPrec :: Int -> ReadS Nanoseconds
Read, Integer -> Nanoseconds
Nanoseconds -> Nanoseconds
Nanoseconds -> Nanoseconds -> Nanoseconds
(Nanoseconds -> Nanoseconds -> Nanoseconds)
-> (Nanoseconds -> Nanoseconds -> Nanoseconds)
-> (Nanoseconds -> Nanoseconds -> Nanoseconds)
-> (Nanoseconds -> Nanoseconds)
-> (Nanoseconds -> Nanoseconds)
-> (Nanoseconds -> Nanoseconds)
-> (Integer -> Nanoseconds)
-> Num Nanoseconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Nanoseconds
$cfromInteger :: Integer -> Nanoseconds
signum :: Nanoseconds -> Nanoseconds
$csignum :: Nanoseconds -> Nanoseconds
abs :: Nanoseconds -> Nanoseconds
$cabs :: Nanoseconds -> Nanoseconds
negate :: Nanoseconds -> Nanoseconds
$cnegate :: Nanoseconds -> Nanoseconds
* :: Nanoseconds -> Nanoseconds -> Nanoseconds
$c* :: Nanoseconds -> Nanoseconds -> Nanoseconds
- :: Nanoseconds -> Nanoseconds -> Nanoseconds
$c- :: Nanoseconds -> Nanoseconds -> Nanoseconds
+ :: Nanoseconds -> Nanoseconds -> Nanoseconds
$c+ :: Nanoseconds -> Nanoseconds -> Nanoseconds
Num, Num Nanoseconds
Num Nanoseconds
-> (Nanoseconds -> Nanoseconds -> Nanoseconds)
-> (Nanoseconds -> Nanoseconds)
-> (Rational -> Nanoseconds)
-> Fractional Nanoseconds
Rational -> Nanoseconds
Nanoseconds -> Nanoseconds
Nanoseconds -> Nanoseconds -> Nanoseconds
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Nanoseconds
$cfromRational :: Rational -> Nanoseconds
recip :: Nanoseconds -> Nanoseconds
$crecip :: Nanoseconds -> Nanoseconds
/ :: Nanoseconds -> Nanoseconds -> Nanoseconds
$c/ :: Nanoseconds -> Nanoseconds -> Nanoseconds
$cp1Fractional :: Num Nanoseconds
Fractional, Num Nanoseconds
Ord Nanoseconds
Num Nanoseconds
-> Ord Nanoseconds -> (Nanoseconds -> Rational) -> Real Nanoseconds
Nanoseconds -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Nanoseconds -> Rational
$ctoRational :: Nanoseconds -> Rational
$cp2Real :: Ord Nanoseconds
$cp1Real :: Num Nanoseconds
Real, Int -> Nanoseconds -> Int
Nanoseconds -> Int
(Int -> Nanoseconds -> Int)
-> (Nanoseconds -> Int) -> Hashable Nanoseconds
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Nanoseconds -> Int
$chash :: Nanoseconds -> Int
hashWithSalt :: Int -> Nanoseconds -> Int
$chashWithSalt :: Int -> Nanoseconds -> Int
Hashable, Fractional Nanoseconds
Real Nanoseconds
Real Nanoseconds
-> Fractional Nanoseconds
-> (forall b. Integral b => Nanoseconds -> (b, Nanoseconds))
-> (forall b. Integral b => Nanoseconds -> b)
-> (forall b. Integral b => Nanoseconds -> b)
-> (forall b. Integral b => Nanoseconds -> b)
-> (forall b. Integral b => Nanoseconds -> b)
-> RealFrac Nanoseconds
Nanoseconds -> b
Nanoseconds -> b
Nanoseconds -> b
Nanoseconds -> b
Nanoseconds -> (b, Nanoseconds)
forall b. Integral b => Nanoseconds -> b
forall b. Integral b => Nanoseconds -> (b, Nanoseconds)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Nanoseconds -> b
$cfloor :: forall b. Integral b => Nanoseconds -> b
ceiling :: Nanoseconds -> b
$cceiling :: forall b. Integral b => Nanoseconds -> b
round :: Nanoseconds -> b
$cround :: forall b. Integral b => Nanoseconds -> b
truncate :: Nanoseconds -> b
$ctruncate :: forall b. Integral b => Nanoseconds -> b
properFraction :: Nanoseconds -> (b, Nanoseconds)
$cproperFraction :: forall b. Integral b => Nanoseconds -> (b, Nanoseconds)
$cp2RealFrac :: Fractional Nanoseconds
$cp1RealFrac :: Real Nanoseconds
RealFrac) via (TimeUnit 1000)

-- Internal for deriving via
newtype TimeUnit (picosPerUnit :: Nat) = TimeUnit DiffTime
  deriving (Int -> TimeUnit picosPerUnit -> ShowS
[TimeUnit picosPerUnit] -> ShowS
TimeUnit picosPerUnit -> String
(Int -> TimeUnit picosPerUnit -> ShowS)
-> (TimeUnit picosPerUnit -> String)
-> ([TimeUnit picosPerUnit] -> ShowS)
-> Show (TimeUnit picosPerUnit)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (picosPerUnit :: Nat). Int -> TimeUnit picosPerUnit -> ShowS
forall (picosPerUnit :: Nat). [TimeUnit picosPerUnit] -> ShowS
forall (picosPerUnit :: Nat). TimeUnit picosPerUnit -> String
showList :: [TimeUnit picosPerUnit] -> ShowS
$cshowList :: forall (picosPerUnit :: Nat). [TimeUnit picosPerUnit] -> ShowS
show :: TimeUnit picosPerUnit -> String
$cshow :: forall (picosPerUnit :: Nat). TimeUnit picosPerUnit -> String
showsPrec :: Int -> TimeUnit picosPerUnit -> ShowS
$cshowsPrec :: forall (picosPerUnit :: Nat). Int -> TimeUnit picosPerUnit -> ShowS
Show, TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
(TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool)
-> (TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool)
-> Eq (TimeUnit picosPerUnit)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
/= :: TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
$c/= :: forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
== :: TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
$c== :: forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
Eq, Eq (TimeUnit picosPerUnit)
Eq (TimeUnit picosPerUnit)
-> (TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Ordering)
-> (TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool)
-> (TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool)
-> (TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool)
-> (TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool)
-> (TimeUnit picosPerUnit
    -> TimeUnit picosPerUnit -> TimeUnit picosPerUnit)
-> (TimeUnit picosPerUnit
    -> TimeUnit picosPerUnit -> TimeUnit picosPerUnit)
-> Ord (TimeUnit picosPerUnit)
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Ordering
TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (picosPerUnit :: Nat). Eq (TimeUnit picosPerUnit)
forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Ordering
forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
min :: TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
$cmin :: forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
max :: TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
$cmax :: forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
>= :: TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
$c>= :: forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
> :: TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
$c> :: forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
<= :: TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
$c<= :: forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
< :: TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
$c< :: forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Bool
compare :: TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Ordering
$ccompare :: forall (picosPerUnit :: Nat).
TimeUnit picosPerUnit -> TimeUnit picosPerUnit -> Ordering
$cp1Ord :: forall (picosPerUnit :: Nat). Eq (TimeUnit picosPerUnit)
Ord)

type SecondsP n = n GHC.TypeLits.* 1000000000000

natNum :: forall n a. (KnownNat n, Num a) => a
natNum :: a
natNum = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy @n)

instance (KnownNat picosPerUnit) => Num (TimeUnit picosPerUnit) where
  TimeUnit DiffTime
a + :: TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
+ TimeUnit DiffTime
b = DiffTime -> TimeUnit picosPerUnit
forall (picosPerUnit :: Nat). DiffTime -> TimeUnit picosPerUnit
TimeUnit (DiffTime -> TimeUnit picosPerUnit)
-> DiffTime -> TimeUnit picosPerUnit
forall a b. (a -> b) -> a -> b
$ DiffTime
a DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
b
  TimeUnit DiffTime
a - :: TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
- TimeUnit DiffTime
b = DiffTime -> TimeUnit picosPerUnit
forall (picosPerUnit :: Nat). DiffTime -> TimeUnit picosPerUnit
TimeUnit (DiffTime -> TimeUnit picosPerUnit)
-> DiffTime -> TimeUnit picosPerUnit
forall a b. (a -> b) -> a -> b
$ DiffTime
a DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
- DiffTime
b
  TimeUnit DiffTime
a * :: TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
* TimeUnit DiffTime
b =
    DiffTime -> TimeUnit picosPerUnit
forall (picosPerUnit :: Nat). DiffTime -> TimeUnit picosPerUnit
TimeUnit (DiffTime -> TimeUnit picosPerUnit)
-> (Integer -> DiffTime) -> Integer -> TimeUnit picosPerUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DiffTime
picosecondsToDiffTime (Integer -> TimeUnit picosPerUnit)
-> Integer -> TimeUnit picosPerUnit
forall a b. (a -> b) -> a -> b
$
      DiffTime -> Integer
diffTimeToPicoseconds DiffTime
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* DiffTime -> Integer
diffTimeToPicoseconds DiffTime
b Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` forall a. (KnownNat picosPerUnit, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
natNum @picosPerUnit
  negate :: TimeUnit picosPerUnit -> TimeUnit picosPerUnit
negate (TimeUnit DiffTime
a) = DiffTime -> TimeUnit picosPerUnit
forall (picosPerUnit :: Nat). DiffTime -> TimeUnit picosPerUnit
TimeUnit (DiffTime -> TimeUnit picosPerUnit)
-> DiffTime -> TimeUnit picosPerUnit
forall a b. (a -> b) -> a -> b
$ DiffTime -> DiffTime
forall a. Num a => a -> a
negate DiffTime
a
  abs :: TimeUnit picosPerUnit -> TimeUnit picosPerUnit
abs (TimeUnit DiffTime
a) = DiffTime -> TimeUnit picosPerUnit
forall (picosPerUnit :: Nat). DiffTime -> TimeUnit picosPerUnit
TimeUnit (DiffTime -> TimeUnit picosPerUnit)
-> DiffTime -> TimeUnit picosPerUnit
forall a b. (a -> b) -> a -> b
$ DiffTime -> DiffTime
forall a. Num a => a -> a
abs DiffTime
a
  signum :: TimeUnit picosPerUnit -> TimeUnit picosPerUnit
signum (TimeUnit DiffTime
a) = DiffTime -> TimeUnit picosPerUnit
forall (picosPerUnit :: Nat). DiffTime -> TimeUnit picosPerUnit
TimeUnit (DiffTime -> TimeUnit picosPerUnit)
-> DiffTime -> TimeUnit picosPerUnit
forall a b. (a -> b) -> a -> b
$ DiffTime -> DiffTime
forall a. Num a => a -> a
signum DiffTime
a
  fromInteger :: Integer -> TimeUnit picosPerUnit
fromInteger Integer
a = DiffTime -> TimeUnit picosPerUnit
forall (picosPerUnit :: Nat). DiffTime -> TimeUnit picosPerUnit
TimeUnit (DiffTime -> TimeUnit picosPerUnit)
-> (Integer -> DiffTime) -> Integer -> TimeUnit picosPerUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DiffTime
picosecondsToDiffTime (Integer -> TimeUnit picosPerUnit)
-> Integer -> TimeUnit picosPerUnit
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* forall a. (KnownNat picosPerUnit, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
natNum @picosPerUnit

instance (KnownNat picosPerUnit) => Read (TimeUnit picosPerUnit) where
  readsPrec :: Int -> ReadS (TimeUnit picosPerUnit)
readsPrec Int
_ = ((Rational, String) -> (TimeUnit picosPerUnit, String))
-> [(Rational, String)] -> [(TimeUnit picosPerUnit, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rational -> TimeUnit picosPerUnit)
-> (Rational, String) -> (TimeUnit picosPerUnit, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Rational -> TimeUnit picosPerUnit
forall a. Fractional a => Rational -> a
fromRational) ([(Rational, String)] -> [(TimeUnit picosPerUnit, String)])
-> (String -> [(Rational, String)])
-> ReadS (TimeUnit picosPerUnit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Rational, String)]
forall a. RealFrac a => ReadS a
readFloat

instance (KnownNat picosPerUnit) => Fractional (TimeUnit picosPerUnit) where
  TimeUnit DiffTime
a / :: TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
/ TimeUnit DiffTime
b =
    DiffTime -> TimeUnit picosPerUnit
forall (picosPerUnit :: Nat). DiffTime -> TimeUnit picosPerUnit
TimeUnit (DiffTime -> TimeUnit picosPerUnit)
-> (Integer -> DiffTime) -> Integer -> TimeUnit picosPerUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DiffTime
picosecondsToDiffTime (Integer -> TimeUnit picosPerUnit)
-> Integer -> TimeUnit picosPerUnit
forall a b. (a -> b) -> a -> b
$
      DiffTime -> Integer
diffTimeToPicoseconds DiffTime
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* forall a. (KnownNat picosPerUnit, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
natNum @picosPerUnit Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` DiffTime -> Integer
diffTimeToPicoseconds DiffTime
b
  fromRational :: Rational -> TimeUnit picosPerUnit
fromRational Rational
a = DiffTime -> TimeUnit picosPerUnit
forall (picosPerUnit :: Nat). DiffTime -> TimeUnit picosPerUnit
TimeUnit (DiffTime -> TimeUnit picosPerUnit)
-> (Integer -> DiffTime) -> Integer -> TimeUnit picosPerUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DiffTime
picosecondsToDiffTime (Integer -> TimeUnit picosPerUnit)
-> Integer -> TimeUnit picosPerUnit
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
a Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* forall a. (KnownNat picosPerUnit, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
natNum @picosPerUnit)

instance (KnownNat picosPerUnit) => Real (TimeUnit picosPerUnit) where
  toRational :: TimeUnit picosPerUnit -> Rational
toRational (TimeUnit DiffTime
a) = Integer -> Rational
forall a. Real a => a -> Rational
toRational (DiffTime -> Integer
diffTimeToPicoseconds DiffTime
a) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ forall a. (KnownNat picosPerUnit, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
natNum @picosPerUnit

instance (KnownNat picosPerUnit) => RealFrac (TimeUnit picosPerUnit) where
  properFraction :: TimeUnit picosPerUnit -> (b, TimeUnit picosPerUnit)
properFraction TimeUnit picosPerUnit
a = (b
i, TimeUnit picosPerUnit
a TimeUnit picosPerUnit
-> TimeUnit picosPerUnit -> TimeUnit picosPerUnit
forall a. Num a => a -> a -> a
- b -> TimeUnit picosPerUnit
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
i)
    where
      i :: b
i = TimeUnit picosPerUnit -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate TimeUnit picosPerUnit
a
  truncate :: TimeUnit picosPerUnit -> b
truncate = Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational -> b)
-> (TimeUnit picosPerUnit -> Rational)
-> TimeUnit picosPerUnit
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeUnit picosPerUnit -> Rational
forall a. Real a => a -> Rational
toRational
  round :: TimeUnit picosPerUnit -> b
round = Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> b)
-> (TimeUnit picosPerUnit -> Rational)
-> TimeUnit picosPerUnit
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeUnit picosPerUnit -> Rational
forall a. Real a => a -> Rational
toRational
  ceiling :: TimeUnit picosPerUnit -> b
ceiling = Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational -> b)
-> (TimeUnit picosPerUnit -> Rational)
-> TimeUnit picosPerUnit
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeUnit picosPerUnit -> Rational
forall a. Real a => a -> Rational
toRational
  floor :: TimeUnit picosPerUnit -> b
floor = Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> b)
-> (TimeUnit picosPerUnit -> Rational)
-> TimeUnit picosPerUnit
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeUnit picosPerUnit -> Rational
forall a. Real a => a -> Rational
toRational

-- we can ignore unit:
instance Hashable (TimeUnit a) where
  hashWithSalt :: Int -> TimeUnit a -> Int
hashWithSalt Int
salt (TimeUnit DiffTime
dt) =
    Int -> Double -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$
      (DiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: DiffTime -> Double) DiffTime
dt

-- | Duration types isomorphic to 'DiffTime', powering 'convertDuration'.
class Duration d where
  fromDiffTime :: DiffTime -> d
  toDiffTime :: d -> DiffTime

instance Duration DiffTime where
  fromDiffTime :: DiffTime -> DiffTime
fromDiffTime = DiffTime -> DiffTime
forall a. a -> a
id
  toDiffTime :: DiffTime -> DiffTime
toDiffTime = DiffTime -> DiffTime
forall a. a -> a
id

instance Duration NominalDiffTime where
  fromDiffTime :: DiffTime -> NominalDiffTime
fromDiffTime = DiffTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
  toDiffTime :: NominalDiffTime -> DiffTime
toDiffTime = NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Safe conversion between duration units.
convertDuration :: (Duration x, Duration y) => x -> y
convertDuration :: x -> y
convertDuration = DiffTime -> y
forall d. Duration d => DiffTime -> d
fromDiffTime (DiffTime -> y) -> (x -> DiffTime) -> x -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> DiffTime
forall d. Duration d => d -> DiffTime
toDiffTime

diffTimeToMicroSeconds :: DiffTime -> Integer
diffTimeToMicroSeconds :: DiffTime -> Integer
diffTimeToMicroSeconds = (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000000) (Integer -> Integer)
-> (DiffTime -> Integer) -> DiffTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToPicoseconds